durchsuchen von dyn. Array of Record mit Textfeldern

[BitRausch]

hallo zusammen,

ich suche Rat bei folgendem Vorhaben.
Ich habe ein dyn. Array of Records welches aus reinen String-Feldern besteht.
Es sind ca.1000 Records vorhanden. Diese werden aus einer CSV Datei eingelesen. (Momentan wird die Liste in Excel vorher sortiert).
Diese Liste dient als Lookup für eine andere, größere, Liste.

Aktuell suche ich linear (for i=0 to high(myArray)...) in der Liste.

Habe mir auch binäres Suchen angeschaut aber ich habe kein Beispiel gefunden wie das mit String Feldern funktioniert.
Leider bin ich nicht sehr Vertraut mit den Möglichkeiten die es gibt...
Gibt es bessere Alternativen bzw. welche alternative Vorgehensweise würdet Ihr vorschlagen?

Für ein Schubs in die richtige Richtung wäre ich sehr Dankbar.

Der Aufbau sieht so aus:
type
s_rec = record
KeyArt : String[3];
Key : String[15];
Beschreibung : String[65];
end;

TSArray = array of s_rec;

var
myArray : TSArray;

Beispiel für Werte:

AAA XXXXXXXXXX
AAA YYYYYYYYYY
BBB UUUUUUUUU
BBB VVVVVVVVVV
...

Gesucht wird erst im Feld SchlüsselArt und anschließend in Schlüssel.

[mse]

MSEgui hat findarrayitem() zur binären Suche in dynamischen Arrays:
https://gitlab.com/mseide-msegui/mseide ... yutils.pas
Zum Sortieren von dynamischen Arrays gibt es in der gleichen unit die Procedure sortarray().
Zum lookup könnte auch eine Hashliste dienen, Beispiele sind hier:
https://gitlab.com/mseide-msegui/mseide ... sehash.pas
Für lookups sind Hashlisten meistens schneller.
Vielleicht ist auch die Verwendung einer SQlite3 Datenbank sinnvoll, das kommt auf die weiteren Daten und die benötigten Operationen in der Anwendung an.

[Mathias]

Suchst du etwas in dieser Art ?

Code: Alles auswählen

type
  s_rec = record
    KeyArt: string[3];
    Key: string[15];
    Beschreibung: string[65];
  end;
 
  TSArray = array of s_rec;
 
var
  myArray: TSArray;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
const
  key = 'abc';
begin
  for i := 0 to Length(myArray) - 1 do begin
    if pos(key, myArray[i].KeyArt) > 0 then begin
      Caption := 'gefunden';
    end;
  end;
end;   

[BitRausch]

super. Vielen Dank an Euch beiden!
@MSE Ich werde mir mal die Units anschauen.
Mal schauen ob ich es verstehe

[theo]

Für die schnelle Sucherei ist vielleicht ist auch TAvgLvlTree von Interesse:
http://wiki.freepascal.org/AVL_Tree

[wp_xyz]

Zum Einstieg sind diese optimierten Container wahrscheinlich gewöhnungsbedürftig. Die AVLTrees sind aber wahnsinnig schnell und die Mühe der Einarbeitung wert. Hier ein kleines Beispiel mit einem TIndexedAvlTree, auf den man fast auch wie auf ein Array zugreifen kann (benötigt Package LazUtils):

Code: Alles auswählen

program Project1;
 
{$mode objfpc}{$H+}
 
uses
  Classes, SysUtils, strUtils, Laz_AVL_Tree, avglvltree;
 
const
//  N = 10000000;   // Um den Unterschied beim Suchen zu sehen. Achtung: Das Füllen des "Arrays" dauert...
  N = 1000;
 
type
  s_rec = record
    KeyArt : String[3];
    Key : String[15];
    Beschreibung: String[65];
  end;
  Ps_rec = ^s_rec;
 
var
  myArray: TIndexedAvlTree;
 
// Vergleichsfunktion für s_rec Einträge
function SRecCompare(Item1, Item2: Pointer): Integer;
var
  p1, p2: ps_rec;
begin
  p1 := Ps_rec(Item1);
  p2 := Ps_rec(Item2);
  Result := CompareText(p1^.KeyArt, p2^.KeyArt);
  if Result = 0 then Result := CompareText(p1^.Key, p2^.Key);
end;
 
function NewItem(AKeyArt, AKey, ABeschreibung: String): Ps_rec;
begin
  New(Result);
  Result^.KeyArt := copy(AKeyArt, 1, 3);
  Result^.Key := Copy(AKey, 1, 15);
  Result^.Beschreibung := Copy(ABeschreibung, 1, 65);
end;
 
function RandomStr(AMaxLen: Integer): String;
var
  i: Integer;
begin
  SetLength(Result, Random(AMaxLen-1) + 1);
  for i:=1 to Length(Result) do
    Result[i] := char(Random(26) + ord('A'))
end;
 
function Suche(AKeyArt, AKey: String): Ps_rec;
var
  item: s_rec;
  node: TAVLTreeNode;
begin
  item.KeyArt := AKeyArt;
  item.Key := AKey;
  node := myArray.Find(@item);
  if node = nil then
    Result := nil else
    Result := Ps_rec(node.Data);
end;
 
function SucheNode(AKeyArt, AKey: String): TAVLTreeNode;
var
  item: s_rec;
begin
  item.KeyArt := AKeyArt;
  item.Key := AKey;
  Result := myArray.Find(@item);
end;
 
procedure EraseData(ANode: TAVLTreeNode);
begin
  Dispose(ps_rec(ANode.Data));
end;
 
var
  p: Ps_rec;
  i: Integer;
  keyart: String;
  key: String;
  t: TDateTime;
  node: TAVLTreeNode;
 
begin
  myArray := TIndexedAvlTree.Create(@SRecCompare);
  // SRecCompare ist die Sortier-Funktion, die immer zwei Items vergleicht.
  // Der Baum ist immer nach diesen Vorgaben sortiert.
 
  // Zufällige Items erzeugen und in den Baum einfügen. Sie werden automatisch einsortiert.
  WriteLn('Erzeuge ', N, ' Items...');
  for i:=1 to N do
    myArray.Add(NewItem(RandomStr(3), RandomStr(5), RandomStr(65)));
 
  WriteLn('Anzahl: ', myArray.Count);
  WriteLn;
 
  // Auf den Baum wie auf ein Array zugreifen
  WriteLn('Ausgabe der ersten 5:');
  for i:=0 to 4 do
    WriteLn(
      'Index: ', i,
      ' KeyArt: ', Ps_rec(myArray[i])^.KeyArt,
      ' Key: ', Ps_rec(myArray[i])^.Key,
      ' Beschreibung: ', Ps_rec(myArray[i])^.Beschreibung
    );
  WriteLn;
 
  // Demonstration der Suchfunktionen, Um den Unterschied zwischen der sequentiellen (Array-ähnlichen)
  // Suche und der optimierten Suche infolge der Baumstruktur zu sehen, muss N groß genug gewählt sein.
  i := Random(myArray.Count);
  key := Ps_rec(myArray[i])^.Key;
  keyart := Ps_rec(myArray[i])^.KeyArt;
  WriteLn('Ausgabe von Index ', i);
  WriteLn(
    'Index: ', i,
    ' KeyArt: ', Ps_rec(myArray[i])^.KeyArt,
    ' Key: ', Ps_rec(myArray[i])^.Key,
    ' Beschreibung: ', Ps_rec(myArray[i])^.Beschreibung
  );
  WriteLn;
 
  WriteLn('Suche KeyArt = "', keyart, '", Key = "', key, '"...');
  Write('  Sequentielles Suchen: ');
  t := Now;
  for i:=0 to myArray.Count-1 do
    if (Ps_rec(myArray[i])^.KeyArt = keyArt) and (Ps_rec(myArray[i])^.Key = key) then begin
      t := Now - t;
      p := Ps_rec(myArray[i]);
      WriteLn('Gefunden nach ', FormatDateTime('s.zzz" sec"', t));
      WriteLn('    KeyArt=', p^.KeyArt, ', Key=', p^.Key, ', Beschreibung: ', p^.Beschreibung);
      break;
    end;
 
  Write('  Optimiertes Suchen: ');
  t := Now;
  p := Suche(keyart, key);
  t := Now-t;
  if p = nil then
    WriteLn('Nicht gefunden nach ', FormatDateTime('s.zzz" sec"', t))
  else begin
    WriteLn('Gefunden nach ', FormatDateTime('s.zzz" sec"', t));
    WriteLn('    KeyArt=', p^.KeyArt, ', Key=', p^.Key, ', Beschreibung: ', p^.Beschreibung);
  end;
  WriteLn;
 
  // Löschen eines Eintrags
  WriteLn('Entferne diesen Eintrag: KeyArt = ', keyart, ' Key = ', key);
  node := SucheNode(keyart, key);
  if node <> nil then begin
    Dispose(ps_rec(node.Data));
    myArray.Delete(node);
  end;
  Write('Suche nochmals nach KeyArt = ', keyart, ', Key = ', key, ': ');
  p := Suche(keyart, key);
  if p = nil then
    WriteLn('Nicht gefunden')
  else
    WriteLn('Gefunden (Dieser Fall sollte nicht eintreten!)');
  WriteLn;
 
  // Aufräumen
  for node in myArray do
    EraseData(node);
  myArray.Free;
 
  WriteLn('ENTER, um zu beenden...');
  ReadLn;
end.

[BitRausch]

Lese den Thread erst jetzt...
Mensch super. Vielen Dank an Euch!!! Besonders an Dich wp_xyz
Werde mich da mal reinknien und gleich mal ausprobieren

Habe mir auch msegui angeschaut ...aber ich muss gestehen das ich es (noch) nicht ganz verstanden habe...

In einer neuen Version meines Programmes versuche ich Stück für Stück von den dynamischen Arrays und Records auf Klassen und Objektlisten zu switchen...Insbesondere mit TObjectList probiere ich gerade viel rum.
Auch mit fgl beschäftige ich mich gerade sehr intensiv...leider ist mir noch nicht alles ganz klar...

Es werden wohl noch einige Fragen kommen...echt steile Lernkurve

[BitRausch]

@wp_xyz

Ich wollte gerade Dein Beispiel ausprobieren.
Leider meckert die IDE das Laz_AVL_Tree nicht gefunden werden kann...
Das LazUtil Paket ist aber installiert...
Ich habe auch das Paket mal neu kompiliert aber leider ohne Erfolg...

[wp_xyz]

Bei dem AVLTree ist vor einiger Zeit manches umgestellt worden. Wenn ich mich erinnere, ist Laz_AVL_Tree eine aktualisierte Version von AVL_Tree. Falls es mit dieser Änderung (Laz_AVL_Tree --> AVL_Tree) immer noch Probleme gibt, solltest du deine Lazarus/FPC_Version posten, sowie die Fehlermeldung.

[BitRausch]

Danke wp_xyz.

AVL_Tree statt Laz_AVL_Tree hat geklapt.
Beim kompilieren gab es mehrere dieser Meldungen:

Error: (4001) Incompatible types: got "TAvgLvlTreeNode" expected "TAVLTreeNode"

hab die Typen entsprechend geändert und damit kompiliert des Programm sauber durch.
Ich nutze die Lazarus IDE 1.6.4 mit FPC 3.02 x64 mit Stand vom Februar.

[wp_xyz]

Ja, das war auch noch. Ich war kein Freund dieser Änderungen, aber dadurch werden einige Containertypen aus den CodeTools allgemein verfügbar (wenn ich mich recht erinnere), und das ist ja auch nicht schlecht. Auf jeden Fall, falls du dein Problem mit einem AvlTree lösen willst, musst du diese Änderung im Hinterkopf behalten, denn irgendwann wirst du auf einen neueren Lazarus umrüsten, und dann hast du dasselbe Problem wieder. Am besten schreibst du ein "{$IF" in deinen Code, dann compiliert's immer:

Code: Alles auswählen

uses
  LCLVersion, {$IF LCL_FullVersion >= 1080000}Laz_ALV_Tree{$ELSE}AVL_Tree{$ENDIF}, ...
 
var
 {$IF LCL_FullVersion >= 1080000}
  node: TAvlLvlTreeNode;
 {$ELSE}
  node: TAvlTreeNode;
 {$ENDIF} 

[BitRausch]

Der Umstieg auf 1.8 kommt bestimmt!.
Super - vielen Dank!! Werde ich so machen.

[mse]

Habe mir auch msegui angeschaut ...aber ich muss gestehen das ich es (noch) nicht ganz verstanden habe...

Hier ein Beispiel mit binärer suche im dynamischen Array und ein Beispiel mit Hash-Tabelle:

Code: Alles auswählen

 
program search;
{$ifdef FPC}{$mode objfpc}{$h+}{$endif}
{$ifdef mswindows}{$apptype console}{$endif}
uses
 {$ifdef unix}cthreads,{$endif}
 msearrayutils,msehash,sysutils,msedate;
 
type
 keyty = record
  keyart: string;
  key: string;
 end;
 
 s_rec = record
  key: keyty; //first!
  Beschreibung: string;
  test: int32;
 end;
 ps_rec = ^s_rec;
 
 s_rechashty = record
  header: hashheaderty;
  data: s_rec;
 end;
 ps_rechashty = ^s_rechashty;
 
 thashlist = class(thashdatalist)
  protected
   function hashkey(const akey): hashvaluety override;
   function checkkey(const akey;
                  const aitem: phashdataty): boolean override;
   function getrecordsize(): int32 override;
   procedure inititem(const aitem: phashdataty) override;
   procedure finalizeitem(const aitem: phashdataty) override;
  public
   constructor create();
   procedure add(const aitem: s_rec);
   function find(const akey: keyty; out aitem: ps_rec): boolean;
                              //true if found
 end;
 
 
function comparesort(const l,r): int32;
begin
 result:= comparestr(s_rec(l).key.keyart,s_rec(r).key.keyart);
 if result = 0 then begin
  result:= comparestr(s_rec(l).key.key,s_rec(r).key.key);
 end;
end;
 
function comparefind(const l,r): int32;
begin
 result:= comparestr(keyty(l).keyart,s_rec(r).key.keyart);
 if result = 0 then begin
  result:= comparestr(keyty(l).key,s_rec(r).key.key);
 end;
end;
 
 
{ thashlist }
 
constructor thashlist.create();
begin
 fstate:= [hls_needsinit,hls_needsfinalize]; 
                        //because of dynamic strings in data record
 inherited;
end;
 
function thashlist.getrecordsize(): int32;
begin
 result:= sizeof(s_rechashty);
end;
 
procedure thashlist.inititem(const aitem: phashdataty);
begin
 initialize(ps_rechashty(aitem)^.data);
end;
 
procedure thashlist.finalizeitem(const aitem: phashdataty);
begin
 finalize(ps_rechashty(aitem)^.data);
end;
 
procedure thashlist.add(const aitem: s_rec);
begin
 ps_rechashty(internaladd(aitem))^.data:= aitem;
end;
 
function thashlist.find(const akey: keyty; out aitem: ps_rec): boolean;
begin
 aitem:= pointer(internalfind(akey)); //returns phashdataty
 result:= aitem <> nil;
 if result then begin
  aitem:= @ps_rechashty(aitem)^.data; //get s_rec address
 end;
end;
 
function thashlist.hashkey(const akey): hashvaluety;
begin
 with keyty(akey) do begin
  result:= stringhash(keyart) + stringhash(key);
 end;
end;
 
function thashlist.checkkey(const akey; const aitem: phashdataty): boolean;
begin
 with keyty(akey) do begin
  result:= (keyart = ps_rechashty(aitem)^.data.key.keyart) and
                                  (key = ps_rechashty(aitem)^.data.key.key);
 end;
end;
 
const
 itemcount = 1000;
 loopcount = 100;
 ms = 24*60*60*1000;
var
 inputdata,binsearchdata: array of s_rec;
 i1,i2,i3: int32;
 t1: tdatetime;
 hashlist: thashlist;
 key: s_rec;
 p1: ps_rec;
 
begin
 setlength(inputdata,itemcount);
 for i1:= 0 to high(inputdata) do begin
  with inputdata[i1] do begin
   key.keyart:= inttostr(random(1000));
   key.key:= inttostr(random(100000000000))+'_'+inttostr(i1);
   test:= i1; //for correct item check
  end;
 end;
 setlength(binsearchdata,length(inputdata));
 for i1:= 0 to high(binsearchdata) do begin
  binsearchdata[i1]:= inputdata[i1]; //deep data copy
 end;
 t1:= nowutc();
 for i1:= 0 to loopcount-1 do begin
  sortarray(binsearchdata,sizeof(s_rec),@comparesort);
 end;
 t1:= nowutc() - t1;
 writeln('Binary search ',itemcount,' items');
 writeln('Sort time: ',floattostrf((t1/loopcount)*ms,fffixed,0,3),'ms');
 t1:= nowutc();
 for i1:= 0 to loopcount-1 do begin
  for i2:= 0 to high(inputdata) do begin
   if not findarrayitem(inputdata[i2].key,binsearchdata,sizeof(s_rec),
                                                  @comparefind,i3) then begin
    writeln('*** Item not found');
    exit;
   end;
   if binsearchdata[i3].test <> i2 then begin
    writeln('*** Wrong item found');
    exit;
   end;
  end;
 end;
 t1:= nowutc() - t1;
 writeln('Find time: ',floattostrf((t1/loopcount)*ms,fffixed,0,3),'ms');
 
 hashlist:= thashlist.create();
 try
  writeln();
  writeln('Hash search ',itemcount,' items');
  hashlist.capacity:= itemcount;
  t1:= nowutc();
  for i1:= 0 to high(inputdata) do begin
   hashlist.add(inputdata[i1]);
  end;
  t1:= nowutc() - t1;
  writeln('Load time: ',floattostrf((t1)*ms,fffixed,0,3),'ms');
  t1:= nowutc();
  for i1:= 0 to loopcount-1 do begin
   for i2:= 0 to high(inputdata) do begin
    if not hashlist.find(inputdata[i2].key,p1) then begin
     writeln('*** Item not found');
     exit;
    end;
    if p1^.test <> i2 then begin
     writeln('*** Wrong item found');
     exit;
    end;
   end;
  end;
  t1:= nowutc() - t1;
  writeln('Find time: ',floattostrf((t1/loopcount)*ms,fffixed,0,3),'ms');
 finally
  hashlist.destroy();
 end;
 
end.
 

Die Hashtabelle ist deutlich schneller, binäres Suchen ist vermutlich für 1000 Einträge ebenfalls schnell genug.

Code: Alles auswählen

Binary search 1000 items
Sort time: 0.130ms
Find time: 0.333ms
 
Hash search 1000 items
Load time: 0.132ms
Find time: 0.092ms
 

Mit 1'000'000 und 10'000'000 Einträgen werden die Unterschiede grösser:

Code: Alles auswählen

 
Binary search 1000000 items
Sort time: 1435.990ms
Find time: 1853.230ms
 
Hash search 1000000 items
Load time: 161.932ms
Find time: 153.521ms
 
Binary search 10000000 items
Sort time: 22386.407ms
Find time: 29833.597ms
 
Hash search 10000000 items
Load time: 2044.402ms
Find time: 1860.718ms
 
 

Das Projekt ist hier:
https://gitlab.com/mseide-msegui/mseuni ... earch_hash

[BitRausch]

Mensch mse - super - vielen Dank für Dein Beispiel!!
Ich werde erst am WE dazu kommen das ganze mal zu testen!!

Ehrlich Leute - die Unterstützung im Forum ist wirklich für mich als (Wieder) Einsteiger ein Segen und eine sehr große Hilfe!!

[mse]

Edit: Habe den Code angepasst um die Vergleichbarkeit zu verbessern.

Zum Vergleich noch AVL-Tree:

Code: Alles auswählen

 AVLtree Erzeuge 1000 Items...
Anzahl: 1000
Load time: 0.509ms
Find time: 0.335ms
 
AVLtree Erzeuge 1000000 Items...
Anzahl: 1000000
Load time: 2258.292ms
Find time: 1845.921ms
 
AVLtree Erzeuge 10000000 Items...
Anzahl: 10000000
Load time: 34824.884ms
Find time: 30436.560ms
 
 

Code: Alles auswählen

program fpcavltree;
{$ifdef FPC}{$mode objfpc}{$h+}{$endif}
{$ifdef mswindows}{$apptype console}{$endif}
uses
 {$ifdef FPC}{$ifdef unix}cthreads,{$endif}{$endif}
 sysutils, laz_avl_tree,avglvltree,msedate;
 
const
  N = 1000;
  loopcount = 10;
 
type
 keyty = record
  keyart: string;
  key: string;
 end;
 
 s_rec = record
  key: keyty; //first!
  Beschreibung: string;
  test: int32;
 end;
 ps_rec = ^s_rec;
 
var
  myArray: TIndexedAvlTree;
 
// Vergleichsfunktion für s_rec Einträge
function SRecCompare(Item1, Item2: Pointer): Integer;
begin
  Result := Comparestr(Ps_rec(Item1)^.key.KeyArt, Ps_rec(Item2)^.key.KeyArt);
  if Result = 0 then Result := Comparestr(Ps_rec(Item1)^.key.Key,
                                                    Ps_rec(Item2)^.key.Key);
end;
 
function NewItem(const aitem: s_rec): Ps_rec;
begin
  New(Result);
  Result^:= aitem;
end;
 
function Suche(const AKey: keyty): Ps_rec;
var
  item: s_rec;
  node: TAVLTreeNode;
begin
  item.Key:= AKey;
  node := myArray.Find(@item);
  if node = nil then
    Result := nil else
    Result := Ps_rec(node.Data);
end;
 
procedure EraseData(ANode: TAVLTreeNode);
begin
  Dispose(ps_rec(ANode.Data));
end;
 
const
 ms = 24*60*60*1000;
 
var
  p: Ps_rec;
  i1,i2: Integer;
  keyart: String;
  key: String;
  t1: TDateTime;
  node: TAVLTreeNode;
  inputdata: array of s_rec;
begin
  myArray := TIndexedAvlTree.Create(@SRecCompare);
  // SRecCompare ist die Sortier-Funktion, die immer zwei Items vergleicht.
  // Der Baum ist immer nach diesen Vorgaben sortiert.
 
  // Zufällige Items erzeugen und in den Baum einfügen. Sie werden automatisch einsortiert.
  WriteLn('AVLtree Erzeuge ', N, ' Items...');
  setlength(inputdata,N);
  for i1:= 0 to high(inputdata) do begin
   with inputdata[i1] do begin
    key.keyart:= inttostr(random(1000));
    key.key:= inttostr(random(100000000000))+'_'+inttostr(i1);
    test:= i1; //for correct item check
   end;
  end;
  t1:= nowutc();
  for i1:= 0 to high(inputdata) do begin
   myArray.Add(NewItem(inputdata[i1]));
  end;
  t1:= nowutc()-t1;
  WriteLn('Anzahl: ', myArray.Count);
  writeln('Load time: ',floattostrf((t1)*ms,fffixed,0,3),'ms');
  t1:= nowutc();  
  for i2:= 0 to loopcount - 1 do begin
   for i1:= 0 to high(inputdata) do begin
    with inputdata[i1] do begin
     p:= Suche(key);
     if p = nil then begin
      writeln('**** Item not found');
      exit;
     end;
     if p^.test <> i1 then begin
      writeln('**** Wrong item found');
      exit;
     end;
    end;   
   end;
  end;
  t1:= nowutc()-t1;
  writeln('Find time: ',floattostrf((t1/loopcount)*ms,fffixed,0,3),'ms');
  // Aufräumen
  for node in myArray do
    EraseData(node);
  myArray.Free;
end.