Программе не хватает памяти

#delphi #generics #delphi-10.2-tokyo #tlist

#delphi #общие сведения #delphi-10.2-Токио #tlist

Вопрос:

Я создаю ObjectDictionary:

 SeismicObjectDictList := TObjectDictionary<integer, TSynt_CatalogList>.Create([doOwnsValues]);
  

Но:

 FreeAndNil(SeismicObjectDictList); 
  

не освобождает память, и поэтому программе не хватает памяти.

Я пытался:

 SeismicObjectDictList := TObjectDictionary<integer, TSynt_CatalogList>.Create();
  

и затем безуспешно:

    if _Synt_CatalogList <> nil then
   begin
     for j := 0 to Synt_CatalogList.Count-1 do       
       TObject(Synt_CatalogList[j]).Free;
     FreeAndNil(Synt_CatalogList);
   end;
   FreeAndNil(SeismicObjectDictList);
  

Программа реального мира должна выполнять параллельную обработку (с использованием новой библиотеки PPL) около 15 миллиардов сейсмических записей из пространственной базы данных (PostgreSQL / PostGIS), и поэтому мне приходится обрабатывать пакетами, не переполняя память.

Упрощенная программа для демонстрации проблемы:

 unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Math,
  System.generics.defaults, System.Generics.Collections, Types;

type
  TSynt_Catalog = class
    private
      FCatalog_id: integer;
      FCoordType_id: integer;
      FMining_Region: boolean;
      FYear: integer;
      FBuilding_Class_id: integer;
      FCatalog_Latitude: double;
      FCatalog_Longitude: double;
      FEpicentral_distance: double;
      FMw: double;
    public
      constructor Create(const aCatalog_id, aCoordType_id, aYear, aBuilding_Class_id: integer; const aMining_Region: boolean; const aCatalog_Latitude, aCatalog_Longitude, aEpicentral_distance, aMw: double);
      property Catalog_id: integer read FCatalog_id write FCatalog_id;
      property CoordType_id: integer read FCoordType_id write FCoordType_id;
      property Mining_Region: boolean read FMining_Region write FMining_Region;
      property Year: integer read FYear write FYear;
      property Building_Class_id: integer read FBuilding_Class_id write FBuilding_Class_id;
      property Catalog_Latitude: double read FCatalog_Latitude write FCatalog_Latitude;
      property Catalog_Longitude: double read FCatalog_Longitude write FCatalog_Longitude;
      property Epicentral_distance: double read FEpicentral_distance write FEpicentral_distance;
      property Mw: double read FMw write FMw;
  end;
type
  TSynt_CatalogList = TList<TSynt_Catalog>;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    btnRun: TButton;
    procedure btnRunClick(Sender: TObject);
  private
    { Private declarations }
    Catalog_id, CoordType_id, Catalog_Year, Building_Class_id, Building_id: integer;

    Mining_region: boolean;

    Catalog_Latitude, Catalog_Longitude, Distance, Epicentral_distance, Mw: double;
    Synt_CatalogList: TSynt_CatalogList;

    procedure ProcessBatch(SeismicObjectDictList: TObjectDictionary<integer, TSynt_CatalogList>);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

constructor TSynt_Catalog.Create(const aCatalog_id, aCoordType_id, aYear, aBuilding_Class_id: Integer; const aMining_Region: Boolean; const aCatalog_Latitude, aCatalog_Longitude, aEpicentral_distance, aMw: Double);
begin
  FCatalog_id := aCatalog_id;
  FCoordType_id := aCoordType_id;
  FYear := aYear;
  FBuilding_Class_id := aBuilding_Class_id;
  FMining_Region := aMining_Region;
  FCatalog_Latitude := aCatalog_Latitude;
  FCatalog_Longitude := aCatalog_Longitude;
  FEpicentral_distance := aEpicentral_distance;
  FMw := aMw;
end;


procedure TForm1.btnRunClick(Sender: TObject);
var
  i, j, iCount, Building_id, Building_Count, Limit_count, Batch_count, Data_count: integer;
  SeismicObjectDictList: TObjectDictionary<integer, TSynt_CatalogList>;
  APair: TPair<integer, TSynt_CatalogList>;
begin
   screen.Cursor := crHourGlass;
   Memo1.clear;

   try
     Limit_count := 100;
     SeismicObjectDictList := TObjectDictionary<integer, TSynt_CatalogList>.Create([doOwnsValues]);

     Building_Count := 22000;

     i := 0;
     Building_id := 1;
     Batch_count := 0;

     repeat
       if SeismicObjectDictList = nil then
         SeismicObjectDictList := TObjectDictionary<integer, TSynt_CatalogList>.Create([doOwnsValues]);

       Data_Count := RandomRange(1, 300000);

       Synt_CatalogList := TSynt_CatalogList.Create;

       for j := 0 to Data_Count do
       begin
         Catalog_id := RandomRange(1, 324981);
         CoordType_id := 3;
         Catalog_Year := RandomRange(1, 50000);
         Building_class_id := RandomRange(1, 12);
         Mining_Region := false;
         Catalog_Latitude  := -1.0 *(RandomRange(24000, 25000)/1000);
         Catalog_Longitude := (RandomRange(24000, 25000)/1000);
         Epicentral_distance := RandomRange(1, 450000);
         Mw := RandomRange(4, 12);

         Synt_CatalogList.Add(TSynt_Catalog.Create(Catalog_id, CoordType_id, Catalog_Year, Building_class_id, Mining_Region, Catalog_Latitude, Catalog_Longitude, Epicentral_distance, Mw));
       end;

       Synt_CatalogList.TrimExcess;
       SeismicObjectDictList.Add(Building_id, Synt_CatalogList);

       Memo1.Lines.Add('Building '   Batch_count.ToString);
       inc(Batch_count);

       if Batch_count = Limit_count then
       begin
         SeismicObjectDictList.TrimExcess;

         ProcessBatch(SeismicObjectDictList);
         Memo1.Lines.Add('---- Batch of '   Batch_count.ToString   ' processed ------');

         sleep(1000);
         FreeAndNil(SeismicObjectDictList);
         Batch_count := 0;
       end;

       inc(Building_id);
       inc(i);
     until (i = Building_Count);

   finally
     screen.Cursor := crDefau<
   end;
end;

procedure TForm1.ProcessBatch(SeismicObjectDictList: TObjectDictionary<integer, TSynt_CatalogList>);
var
  i, j, akey, Key: integer;
  APair: TPair<integer, TSynt_CatalogList>;
begin
  for APair in SeismicObjectDictList do
  begin
    aKey := APair.Key;

    for j := 0 to APair.Value.Count-1 do
    begin
      Catalog_id := APair.Value.Items[j].Catalog_id;
      CoordType_id := APair.Value.Items[j].CoordType_id;
      Catalog_Year := APair.Value.Items[j].Year;
      Building_class_id := APair.Value.Items[j].Building_class_id;
      Mining_Region := APair.Value.Items[j].Mining_Region;
      Catalog_Latitude  := APair.Value.Items[j].Catalog_Latitude;
      Catalog_Longitude := APair.Value.Items[j].Catalog_Longitude;
      Epicentral_distance := APair.Value.Items[j].Epicentral_distance;
      Mw := APair.Value.Items[aKey].Mw;
    end;
  end;
end;


end.
  

Я ожидаю, что программа должна освобождать память, используемую объектом TObjectDictionary после каждой партии, для использования следующей партией.

Комментарии:

1. Измените TSynt_CatalogList с TList<T> на TObjectList<T> и установите для его OwnsObjects свойства значение true.

2. Спасибо, это решило мою проблему.