Generic List, große Liste, große Datenstruktur, Geschwindigkeit

[Alex_ITA01]

Hallo zusammen,
ich habe mal meinen originalen Quelltext angepasst um folgendes Beispiel zu posten (deswegen bitte über Variablennamen und Sinnlosigkeit des Quelltextes nicht äußern, mir geht es um das eigentliche Problem):

Delphi-Quellcode:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

type
  TMyNextData8 = packed record
  const
    Ident = 'TMyNextData8';
  public
    a : String[18];
    b : Word;
    c : Word;
  end;

  TMyNextData7 = packed record
  private
  public
    ItemCount: Integer;
    Items    : Array[00..09] of TMyNextData8;
  end;

type
  TMyNextData6 = packed record
  const
    Ident = 'TMyNextData6';
  public
    a : LongWord;
    b : String[18];
    c : String[40];
    d : Double;
    e : String[03];
    f : String[04];
    g : String[01];
    h : String[10];
    i : String[01];

    j : LongWord;
    k : String[12];
    l : String[08];
  end;

  TMyNextData5 = packed record
  private
  public
    ItemCount: Integer;
    Items    : Array[0..09] of TMyNextData6;
  end;

type
  TMyNextData4 = packed record
  const
    Ident = 'TMyNextData4';
  public
    a: Word;
    b : LongWord;
    c : String[12];
    d : String[12];
    e : String[12];
    f : String[08];
    g : String[10];
    h : LongWord;
  end;

type
  TMyNextData3 = packed record
  const
    MaxAnz = 10;
  private
  public
    ItemCount: Integer;
    Items    : Array[00..MaxAnz-1] of TMyNextData4;
  end;

type
  TMyNextData = packed record
  const
    MyStr = 'TMyNextData';
  public
    a  : String[16];

    b  : TDate;
    c  : TTime;
    d  : LongWord;

    e  : LongWord;
    f  : String[12];
    g  : String[12];
    h  : String[12];
    i  : TMyNextData3;

    j  : String[06];
    k  : String[18];
    l  : String[40];
    m  : Double;
    n  : String[03];
    o  : String[04];
    p  : String[10];
    q  : TMyNextData5;

    r  : LongWord;
    s  : String[12];

    t  : String[08];
    u  : String[08];

    v  : String[04];
    w  : TDate;
    x  : String[10];

    y  : String[10];
    z  : String[01];
    aa : String[01];
    bb : String[10];

    cc : TMyNextData7;

    dd : Array[0..49] of Byte;
  end;

type
  TMyData = packed record
  const
    MyStr = 'TMyData';
  public
    ID     : LongWord;
    ID2    : LongWord;
    ID3    : LongWord;
    First  : Boolean;
    Second : Boolean;
    Third  : Boolean;


    a   : LongWord;
    b   : LongWord;
    c   : Byte;
    d   : Byte;
    e   : Word;
    f   : TMyNextData;

    g   : Word;
    h   : LongWord;
    i   : String[10];
    j   : String[18];
    k   : Byte;
    l   : String[1];
    m   : String[10];
    n   : LongWord;
    o   : TDateTime;

    p,
    q,
    r,
    s,
    t,
    u,
    v,
    w,
    x   : Word;

    y   : String[10];
    z   : String[4];

    aa,
    bb  : Byte;

    cc  : String[8];

    dd  : String[01];
    ee  : Word;
    ff  : Boolean;

    gg,
    hh  : Byte;


    ii  : Byte;
    jj  : LongWord;

    kk  : Word;
    ll  : Word;
    mm  : Word;
    nn  : Array[0..93] of Byte;
    oo  : TDateTime;


    pp  : TDateTime;
    qq  : TDateTime;

    procedure Clear;
  end;

type
  TMyListe = class(TList<TMyData>)
  private
  public
    function GetFirstItems(var aFirstList: TMyListe): Integer;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  AllDataList  : TMyListe;
  FirstList    : TMyListe;
  i            : Integer;
  aData        : TMyData;
  aMes1,
  aMes2        : TStopWatch;
begin
  AllDataList := TMyListe.Create;
  FirstList   := TMyListe.Create;

  aMes1.Create;
  aMes1.Reset;
  aMes1.Start;

  try
    //5000 Einträge erstellen (First=True)
    for i := 1 to 5000 do
    begin
      aData.Clear;
      aData.ID := i;
      aData.First := True;

      AllDataList.Add(aData);
    end;

    //5000 Einträge erstellen (First=False)
    for i := 1 to 5000 do
    begin
      aData.Clear;
      aData.ID2 := i;
      aData.First := False;

      AllDataList.Add(aData);
    end;

    //Schritt1: Rootliste füllen
    aMes2.Create;
    aMes2.Reset;
    aMes2.Start;
    AllDataList.GetFirstItems(FirstList);
    aMes2.Stop;

  finally
    if Assigned(FirstList) then
    begin
      FirstList.Clear;
      FreeAndNil(FirstList);
    end;

    if Assigned(AllDataList) then
    begin
      AllDataList.Clear;
      FreeAndNil(AllDataList);
    end;
  end;

  aMes1.Stop;
  ShowMessage('Zeitmessung 1 (s): ' +
               IntToStr(Round(aMes1.ElapsedMilliseconds/1000)));

  ShowMessage('Zeitmessung 2 (s): ' +
               IntToStr(Round(aMes2.ElapsedMilliseconds/1000)));
end;

{ TMyListe }

function TMyListe.GetFirstItems(var aFirstList: TMyListe): Integer;
var
  i: Integer;
  tmpData: TMyData;
begin
  if Assigned(aFirstList) then
  begin
    aFirstList.Clear;
    i := 0;
    while i < Self.Count do
    begin
      if (Self.Items[i].First) then
      begin
        tmpData := Self.Items[i];
        Self.Delete(i);
        aFirstList.Add(tmpData);
      end
      else begin
        inc(i);
      end;
    end;
  end;
  Result := aFirstList.Count;
end;

{ TMyData }

procedure TMyData.Clear;
begin
  FillChar(Self, SizeOf(Self), 0);
end;

end.

Ein einfaches Formular, ein Button drauf und die Routine aufrufen.
Die SizeOf meiner "TMyData" Struktur beträgt 2732 Bytes.

Wenn ich jetzt in der AllDataList meine Testeinträge hinzugefügt habe und möchte dann mit der Funktion "GetFirstItems" nur eine bestimmte Anzahl von diesen Einträgen in einer anderen Liste zurück haben, dann dauert es 11Sekunden auf meinen Rechner, bis die Funktion "GetFirstItems" abgearbeitet wurde. Diese Funktion löscht aus der Originalen Liste und added die Einträge in eine separate Liste.

Könnt ihr mir sagen, was man hier anders machen könnte, damit es schneller geht?
Ich denke eine Liste mit 10000 Einträgen, die dann 5000 davon in eine andere Liste hinzufügt und diese 5000 bei sich löscht, kann doch keine 11 Sekunden dauern oder doch?

Viele Grüße

Benutze Win 8.1 mit XE7

[Sir Rufo]

Doch, das kann so lange dauern.

Schliesslich wird hier 2 x 5000 x 2732 Bytes Speicher angefordert und auch wieder freigegeben. Das dauert eben seine Zeit.

Das var in der GetFirstItems ist natürlich Unfug, weil du in der Methode keine neue Liste erzeugst und somit dem Parameter auch keinen Wert zuweist.

Und if Assigned( aFirstList ) kannst du dir auch schenken, denn die Methode wird so trotz allem eine Exception werfen. (s. letzte Zeile der Methode)

[Alex_ITA01]

Stimmt, bei den beiden Anpassungen hast du natürlich Recht.

Gibt es denn eine Möglichkeit, soetwas schneller zu machen?

Viele Grüße

[Sir Rufo]

Ja, kleine Veränderung

Delphi-Quellcode:

unit Types.MyTypes;

interface

uses
  System.Generics.Collections;

type
  TMyNextData8 = packed record
  const
    Ident = 'TMyNextData8';
  public
    a: string[ 18 ];
    b: Word;
    c: Word;
  end;

  TMyNextData7 = packed record
  private
  public
    ItemCount: Integer;
    Items    : array [ 00 .. 09 ] of TMyNextData8;
  end;

type
  TMyNextData6 = packed record
  const
    Ident = 'TMyNextData6';
  public
    a: LongWord;
    b: string[ 18 ];
    c: string[ 40 ];
    d: Double;
    e: string[ 03 ];
    f: string[ 04 ];
    g: string[ 01 ];
    h: string[ 10 ];
    i: string[ 01 ];

    j: LongWord;
    k: string[ 12 ];
    l: string[ 08 ];
  end;

  TMyNextData5 = packed record
  private
  public
    ItemCount: Integer;
    Items    : array [ 0 .. 09 ] of TMyNextData6;
  end;

type
  TMyNextData4 = packed record
  const
    Ident = 'TMyNextData4';
  public
    a: Word;
    b: LongWord;
    c: string[ 12 ];
    d: string[ 12 ];
    e: string[ 12 ];
    f: string[ 08 ];
    g: string[ 10 ];
    h: LongWord;
  end;

type
  TMyNextData3 = packed record
  const
    MaxAnz = 10;
  private
  public
    ItemCount: Integer;
    Items    : array [ 00 .. MaxAnz - 1 ] of TMyNextData4;
  end;

type
  TMyNextData = packed record
  const
    MyStr = 'TMyNextData';
  public
    a: string[ 16 ];

    b: TDate;
    c: TTime;
    d: LongWord;

    e: LongWord;
    f: string[ 12 ];
    g: string[ 12 ];
    h: string[ 12 ];
    i: TMyNextData3;

    j: string[ 06 ];
    k: string[ 18 ];
    l: string[ 40 ];
    m: Double;
    n: string[ 03 ];
    o: string[ 04 ];
    p: string[ 10 ];
    q: TMyNextData5;

    r: LongWord;
    s: string[ 12 ];

    t: string[ 08 ];
    u: string[ 08 ];

    v: string[ 04 ];
    w: TDate;
    x: string[ 10 ];

    y : string[ 10 ];
    z : string[ 01 ];
    aa: string[ 01 ];
    bb: string[ 10 ];

    cc: TMyNextData7;

    dd: array [ 0 .. 49 ] of Byte;
  end;

type
  TMyData = packed record
  const
    MyStr = 'TMyData';
  public
    ID    : LongWord;
    ID2   : LongWord;
    ID3   : LongWord;
    First : Boolean;
    Second: Boolean;
    Third : Boolean;

    a: LongWord;
    b: LongWord;
    c: Byte;
    d: Byte;
    e: Word;
    f: TMyNextData;

    g: Word;
    h: LongWord;
    i: string[ 10 ];
    j: string[ 18 ];
    k: Byte;
    l: string[ 1 ];
    m: string[ 10 ];
    n: LongWord;
    o: TDateTime;

    p, q, r, s, t, u, v, w, x: Word;

    y: string[ 10 ];
    z: string[ 4 ];

    aa, bb: Byte;

    cc: string[ 8 ];

    dd: string[ 01 ];
    ee: Word;
    ff: Boolean;

    gg, hh: Byte;

    ii: Byte;
    jj: LongWord;

    kk: Word;
    ll: Word;
    mm: Word;
    nn: array [ 0 .. 93 ] of Byte;
    oo: TDateTime;

    pp: TDateTime;
    qq: TDateTime;

    procedure Clear;
  end;

type
  TMyListe = class( TList<TMyData> )
  private
  public
    function GetFirstItems( var aFirstList: TMyListe ): Integer;
  end;

implementation

{ TMyListe }

function TMyListe.GetFirstItems( var aFirstList: TMyListe ): Integer;
var
  i      : Integer;
  tmpData: TMyData;
begin
  if Assigned( aFirstList )
  then
    begin
      aFirstList.Clear;
      i := 0;
      while i < Self.Count do
        begin
          if ( Self.Items[ i ].First )
          then
            begin
              tmpData := Self.Items[ i ];
              Self.Delete( i );
              aFirstList.Add( tmpData );
            end
          else
            begin
              inc( i );
            end;
        end;
    end;
  Result := aFirstList.Count;
end;

{ TMyData }

procedure TMyData.Clear;
begin
  FillChar( Self, SizeOf( Self ), 0 );
end;

end.

Delphi-Quellcode:

unit Types.MyClassTypes;

interface

uses
  System.Generics.Collections,
  System.SysUtils,
  Types.MyTypes;

type
  TMyDataObj = class
  const
    MyStr = 'TMyDataObj';
  public
    ID    : LongWord;
    ID2   : LongWord;
    ID3   : LongWord;
    First : Boolean;
    Second: Boolean;
    Third : Boolean;

    a: LongWord;
    b: LongWord;
    c: Byte;
    d: Byte;
    e: Word;
    f: TMyNextData;

    g: Word;
    h: LongWord;
    i: string[ 10 ];
    j: string[ 18 ];
    k: Byte;
    l: string[ 1 ];
    m: string[ 10 ];
    n: LongWord;
    o: TDateTime;

    p, q, r, s, t, u, v, w, x: Word;

    y: string[ 10 ];
    z: string[ 4 ];

    aa, bb: Byte;

    cc: string[ 8 ];

    dd: string[ 01 ];
    ee: Word;
    ff: Boolean;

    gg, hh: Byte;

    ii: Byte;
    jj: LongWord;

    kk: Word;
    ll: Word;
    mm: Word;
    nn: array [ 0 .. 93 ] of Byte;
    oo: TDateTime;

    pp: TDateTime;
    qq: TDateTime;

  end;

type
  TMyObjListe = class( TObjectList<TMyDataObj> )
  private
  public
    function GetFirstItems( const aFirstList: TMyObjListe ): Integer;
  end;

implementation

{ TMyObjListe }

function TMyObjListe.GetFirstItems( const aFirstList: TMyObjListe ): Integer;
var
  i      : Integer;
  tmpData: TMyDataObj;
begin
  if not Assigned( aFirstList )
  then
    raise EArgumentNilException.Create( 'aFirstList' );

  aFirstList.Clear;
  i := 0;
  while i < Self.Count do
    begin
      if ( Self.Items[ i ].First )
      then
        begin
          tmpData := Self.Items[ i ];
          aFirstList.Add( Self.Extract( tmpData ) );
        end
      else
        begin
          inc( i );
        end;
    end;
  Result := aFirstList.Count;
end;

end.

Und nun

Delphi-Quellcode:

unit Forms.MainForm;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class( TForm )
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click( Sender: TObject );
    procedure Button2Click( Sender: TObject );
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  System.Diagnostics,
  Types.MyTypes, Types.MyClassTypes;

procedure TForm1.Button1Click( Sender: TObject );
var
  AllDataList : TMyListe;
  FirstList   : TMyListe;
  i           : Integer;
  aData       : TMyData;
  aMes1, aMes2: TStopWatch;
begin
  AllDataList := TMyListe.Create;
  FirstList   := TMyListe.Create;

  aMes1.Create;
  aMes1.Reset;
  aMes1.Start;

  try
    // 5000 Einträge erstellen (First=True)
    for i := 1 to 5000 do
      begin
        aData.Clear;
        aData.ID    := i;
        aData.First := True;

        AllDataList.Add( aData );
      end;

    // 5000 Einträge erstellen (First=False)
    for i := 1 to 5000 do
      begin
        aData.Clear;
        aData.ID2   := i;
        aData.First := False;

        AllDataList.Add( aData );
      end;

    // Schritt1: Rootliste füllen
    aMes2.Create;
    aMes2.Reset;
    aMes2.Start;
    AllDataList.GetFirstItems( FirstList );
    aMes2.Stop;

  finally
    if Assigned( FirstList )
    then
      begin
        FirstList.Clear;
        FreeAndNil( FirstList );
      end;

    if Assigned( AllDataList )
    then
      begin
        AllDataList.Clear;
        FreeAndNil( AllDataList );
      end;
  end;

  aMes1.Stop;
  ShowMessage( 'Zeitmessung 1 (s): ' + IntToStr( Round( aMes1.ElapsedMilliseconds / 1000 ) ) );

  ShowMessage( 'Zeitmessung 2 (s): ' + IntToStr( Round( aMes2.ElapsedMilliseconds / 1000 ) ) );
end;

procedure TForm1.Button2Click( Sender: TObject );
var
  AllDataList : TMyObjListe;
  FirstList   : TMyObjListe;
  i           : Integer;
  aData       : TMyDataObj;
  aMes1, aMes2: TStopWatch;
begin
  AllDataList := TMyObjListe.Create( True );
  FirstList   := TMyObjListe.Create( True );

  aMes1.Create;
  aMes1.Reset;
  aMes1.Start;

  try
    // 5000 Einträge erstellen (First=True)
    for i := 1 to 5000 do
      begin
        aData       := TMyDataObj.Create;
        aData.ID    := i;
        aData.First := True;

        AllDataList.Add( aData );
      end;

    // 5000 Einträge erstellen (First=False)
    for i := 1 to 5000 do
      begin
        aData       := TMyDataObj.Create;
        aData.ID2   := i;
        aData.First := False;

        AllDataList.Add( aData );
      end;

    // Schritt1: Rootliste füllen
    aMes2.Create;
    aMes2.Reset;
    aMes2.Start;
    AllDataList.GetFirstItems( FirstList );
    aMes2.Stop;

  finally
    FreeAndNil( FirstList );
    FreeAndNil( AllDataList );
  end;

  aMes1.Stop;
  ShowMessage( 'Zeitmessung 1 (s): ' + IntToStr( Round( aMes1.ElapsedMilliseconds / 1000 ) ) );

  ShowMessage( 'Zeitmessung 2 (s): ' + IntToStr( Round( aMes2.ElapsedMilliseconds / 1000 ) ) );
end;

end.

dauert das nur noch 0 Sekunden

[TiGü]

Schneller gehts nicht, aber ich sehe es schon:
"Ich muss aber bei packed records bleiben!"

[Alex_ITA01]

Stimmt
Sorry für meine unprofessionelle konkretisierte Fragestellung

Ich benötige ein packed record.

Also ich würde mich freuen, wenn ihr eine schnellere Variante mit packed records hättet bzw. mir vorschlagen könntet

Viele Grüße

[jbg]

Generic-Listen mit großen Records sind sehr ungünstig, da sie eigentlich nur mit Kopieren der Records beschäftigt sind.

Delphi-Quellcode:

if (Self.Items[i].First) then // 1x Kopieren in vom Compiler eingefügte lokale Record-Variable um auf First zuzugreifen
begin
  tmpData := Self.Items[i];    // 1x Kopieren in lokale Record-Variable
  Self.Delete(i);              // Kopieren aller nachfolgenden Records im Array der Liste um eins nach vorne.
  aFirstList.Add(tmpData);     // 1x Kopieren in das Array der Liste.
end

Das ganze wäre um einiges schneller, wenn du statt dem Record einen Zeiger auf den Record nutzt. Dann besteht das Kopieren nur aus 4 Bytes statt aus den 2732 Bytes mit Managed Datentypen (String). Um das Anlegen und die Freigabe der Items musst du dich dann natürlich selbst kümmern.


Das würde dann so aussehen: (mit automatischer Freigabe wenn Delete/Clear aufgerufen wird.

Delphi-Quellcode:

type
  PMyData = ^TMyData;
  TMyData = record ... end;

  TMyListe = class(TList<PMyData>)
  protected
    procedure Notify(const Item: PMyData; Action: TCollectionNotification); override;
    function GetFirstItems(aFirstList: TMyListe): Integer;
  end;

{ TMyDataList }

procedure TMyListe.Notify(const Item: PMyData; Action: TCollectionNotification);
begin
  inherited Notify(Item, Action);
  if Action = cnRemoved then
    Dispose(Item);
end;

function TMyListe.GetFirstItems(aFirstList: TMyListe): Integer;
var
  i: Integer;
  tmpData: PMyData;
begin
  if Assigned(aFirstList) then
  begin
    aFirstList.Clear;
    i := 0;
    while i < Self.Count do
    begin
      if (Self.Items[i].First) then
      begin
        tmpData := Self.Extract(Self.Items[i]);
        aFirstList.Add(tmpData);
      end
      else begin
        inc(i);
      end;
    end;
  end;
  Result := aFirstList.Count; // was wenn aFirstList=nil ist?
end;


...
var
  aData: PMyData;
begin
  ...
    for i := 1 to 5000 do
    begin
      //New(aData); // Neuen Record im Speicher anlegen
      //aData.Clear;
      aData := AllocMem(SizeOf(TMyData)); // etwas schneller als New+FillChar, da New zusätzlich noch die Managed-Typen auf nil/Leerstring setzt, was FillChar dann gleich nochmal macht.

      aData.ID := i;
      aData.First := True;

      AllDataList.Add(aData); // Owner ist nun AllDataList
    end;

[Zoot]

Zitat von TiGü:

Schneller gehts nicht, aber ich sehe es schon:
"Ich muss aber bei packed records bleiben!"

Jepp.

[Sir Rufo]

Wenn TMyData keine Klasse werden darf, dann geht das wohl nicht ...

oder etwa doch?

Delphi-Quellcode:

TMyDataContainer = class
private
  FMyData : TMyData;
public
  constructor Create( MyData: TMyData );
  property MyData : TMyData read FMyData;
end;

Den Rest kann man sich ja nun denken ... gelle

[jfheins]

Wie wäre es mit zwei Schleifendurchgängen?

Im ersten nur zählen, wie viele records das "First" Flag haben. Nennen wir das FirstCount
Dann zwei neue Listen erzeugen, jeweils mit Capacity vorbelegt. Einmal mit FirstCount und einmal mit n-FirstCount.
Im zweiten Durchgang dann jeden record in die passende Liste kopieren/Adden. Da die Capacity stimmt, sollten die Listen sich nicht vergrößern müssen.
Anschließend sollten in der ersten Liste alle records drinstehen, die das Flag haben. Dann die große Liste freigeben und durch die zweite Liste ersetzen.