Delphi-PRAXiS
Seite 3 von 3     123   

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   Delphi Prozedur zu langsam, Optimierung nötig (https://www.delphipraxis.net/88009-prozedur-zu-langsam-optimierung-noetig.html)

Hawkeye219 17. Mär 2007 18:23

Re: Prozedur zu langsam, Optimierung nötig
 
Im Prinzip wird mit den Stringlisten eine zweidimensionale Matrix simuliert. Die Stringliste FLines enthält die y-Koordinaten (als String) und im Objects[]-Feld für jedes Element eine weitere Stringliste, welche die Daten aller (x,y)-Paare aufnimmt, die zur jeweiligen y-Koordinate gehören. Jedes Matrix-Element vom Typ TItem enthält den Wert RXL und den Zeilenrest tail, der nicht weiter ausgwertet werden muß.

Beim Einlesen der Originaldatei wird jede Zeile zunächst zerlegt (x, y, RXL, Zeilenrest). Mit den Koordinaten x und y wird dann in der Methode GetItem das zugehörige Matrixelement bestimmt. Dazu wird die y-Koordinate als String formatiert, der dann in der Liste FLines gesucht wird. Ist der String nicht vorhanden, wird ein neues Listenelement (= neue Matrixzeile) angelegt. In der Eigenschaft Objects[] des gefundenen bzw. neu angelegten Elements finden wir die Stringliste mit allen Elementen dieser Matrixzeile. Diese Liste durchsuchen wir mit der formatierten x-Koordinate und erzeugen, falls wir nichts finden, ein neues Element. Am Ende dieser zweistufigen Operation haben wir einen Zeiger auf ein Matrixelement (TIem) und können dessen Eigenschaft RXL prüfen und ggg. aktualisieren. Die Matrix speichert also jedes vorkommende (x,y)-Paar nur ein einziges Mal, es wird aber nicht für jedes mögliche Paar ein Speicherplatz angelegt. Alle Listen sind sortiert, es kann also jeweils eine schnelle binäre Suche durchgeführt werden.

Man könnte das sicher auch mit einer einfachen Liste lösen, indem man die Paare (x,y) als Index verwendet. Vielleicht ergeben sich ähnliche Laufzeiten - ich habe es nicht getestet.

Gruß Hawkeye

carknue 17. Mär 2007 20:55

Re: Prozedur zu langsam, Optimierung nötig
 
Nun habe ich die stringliste mal einfach mit liste1.sort sortiert. Die Suche kann nun sofort beendet werden, wenn es keine Übereinstimmung der Koordinaten gibt. Das gefundene wird ebenfalls sofort gelöscht. Nun dauert es nur noch 10 Sekunden auf dem E6600. Allerdings habe ich nun ein anderes Problem. Die liste.sort Funktion scheint den String irgendwie zu verändern. Im Editor sehen die beiden Ausgangs Dateien zwar gleich aus, MapInfo erkennt aber beim Einlesen die Werte alle nur noch als Zeichen. Ohne sort erkennt es die Koordinaten als Float und RXL als Integer. Kann man zwar hinterher wieder ändern, ist aber mehr Aufwand. Allerdings geht das Zeichnen dafür bei der sortierten Liste deutlich schneller. Was verändert sort am Format?

Delphi-Quellcode:
procedure TForm1.Button8Click(Sender: TObject);
var
  rxl: string;
  suchkoor: string;
  Koor: Array[0..1000] of string[35];
  i,l,k,j,maxi,cl: Integer;
  maxrxl: Integer;
  Liste1: Tstringlist;
  Liste2: Tstringlist;

begin
 Screen.Cursor:=crHourglass;
 DecimalSeparator:='.';
 liste1:=Tstringlist.Create;
 liste1.LoadFromFile(OpenDialog1.FileName);
 // Jetzt wird sortiert
 liste1.sort;
 l:=liste1.Count;
 progressbar1.Min:=-l;
 progressbar1.Max:=0;
 liste2:=Tstringlist.Create;
 liste2.add('lon'+chr(9)+'lat'+chr(9)+'RXL'+chr(9)+'CID'+chr(9)+'BCCH');
 repeat
  suchkoor:=copy(Liste1[1],1,GetPosNumX(chr(9),Liste1[1],2)-1);
  k:=0;
  i:=1;
  repeat
      if (pos(suchkoor,liste1[i])>0) then
      begin
        koor[k]:=liste1[i];
        k:=k+1;
        liste1.Delete(i);
        i:=i-1;
      end
     //neuer else zweig zum Abbruch der Suche
      else i:=liste1.Count-1;
      i:=i+1;
      cl:=Liste1.Count;
  until i=cl;
  maxrxl:=-200;
  maxi:=0;
  progressbar1.position:=-cl;
  if k=1 then
  begin
    liste2.Add(koor[0]);
  end
  else if k>1 then
   begin
     for j := 0 to k - 1 do
     begin
       rxl:=copy(koor[j],GetPosNumX(chr(9),koor[j],2)+1,GetPosNumX(chr(9),koor[j],3)-GetPosNumX(chr(9),koor[j],2)-1);
       if strtoint(rxl)>maxrxl then
       begin
        maxrxl:=strtoint(rxl);
        maxi:=j;
       end;
     end;
     liste2.Add(koor[maxi]);
   end;
 until liste1.Count=1;
 liste2.SaveToFile(extractfilepath(OpenDialog1.FileName)+'Best_sorted.txt');
 liste1.Destroy;
 liste2.Destroy;
 Screen.Cursor:=crDefault;
end;

grenzgaenger 18. Mär 2007 13:12

Re: Prozedur zu langsam, Optimierung nötig
 
zeig doch mal her, wie sortierst du die tlist?

persönlich hab ich keine ahnung was du mit den vielen dateien oder tlist alles machst und im speicher braucht man das ja auch nicht behalten. du brauchst ja nur einmal deine datei durchzugehen, dir die jeweils besten werte merken und das ergebnis ausgeben... das sollt recht schnell gehen. im pseudocode sieht das in etwa so aus

Code:
öffne quelldatei;
while not eof(quelldatei) do
begin
 lese datensatz(quelldatei) und positioniere auf nächsten satz;
 bereite datensatz auf;
 prüfe ob datensatz im buffer
 wenn ja dann
  prüfe ob datensatz besser als der im buffer
  wenn nicht dann
   nimm neue daten in buffer auf;
 wenn nicht im buffer dann
  nehme datensatz in den buffer auf;//an der richtigen stelle
end;
schliesse quelldatei;
der buffer muss natürlich sortiert sein, am besten baust du dir dafür einen binary tree auf, wo du sehr schnell auf die einzelnen elemente zugeifen kannst. alternativ, gings auch mit 'ner TList ist aber nicht optimal. hier musst gehirnschmalz investieren, damit tlist beim einfügen an einer bestimmten stelle nicht jedesmal den speicher umschichtet und du die sanduhr zu sehen bekommst.

<HTH>

grenzgaenger 18. Mär 2007 15:14

Re: Prozedur zu langsam, Optimierung nötig
 
Liste der Anhänge anzeigen (Anzahl: 1)
hier 'n bislerl code, auf der basis von objekten, weiss nicht, ob ich deine anforderungen getroffen hab...

Delphi-Quellcode:
program test;
{$APPTYPE CONSOLE}
uses
  sysutils,
  contnrs;

type
 tRec = class(tobject)
  keystr: string;
  ion, lat: real;
  rxl, cid, bcch: integer;
  procedure copystr(s: string);
  procedure assign(const r: tRec);
 end;

 trList = class(tobjectlist)
  procedure update(const ORec: tRec);
  procedure print;
 end;

procedure tRec.assign(const r: tRec);
begin
 keystr := r.keystr;
 ion   := r.ion;
 lat   := r.lat;
 rxl   := r.rxl;
 cid   := r.cid;
 bcch  := r.bcch;
end;

procedure tRec.copystr(s: string);
var
 i: integer;
begin
 i := pos(#9,s);
 ion := strtofloat(copy(s,1,i-1));
 delete(s,1,i);
 i := pos(#9,s);
 lat := strtofloat(copy(s,1,i-1));
 delete(s,1,i);
 i := pos(#9,s);
 rxl := strtoint(copy(s,1,i-1));
 delete(s,1,i);
 i := pos(#9,s);
 cid := strtoint(copy(s,1,i-1));
 delete(s,1,i);
 bcch := strtoint(s);
 keystr := format('%3.6f|%3.6f',[ion, lat]); //ggf. anpassen
end;

{ trList }
function compare(Item1, Item2: Pointer): Integer;
begin
 if tRec(item1).keystr = tRec(item2).keystr then
  result := 0
 else
  if tRec(item1).keystr < tRec(item2).keystr then
   result := -1
  else
   result := 1;
end;

procedure trList.update(const ORec: tRec);
 procedure search(l,r: integer; var found: boolean; var aktuell, direction: integer);
 var
  c,i: integer;
 begin
  if not found and (l<r) then
  begin
   i := (l+r) shr 1;
   c := compare(orec, items[i]);
   direction := c;
   if c = 0 then
   begin
    found := true;
    aktuell := i;
   end
   else
    if c>0 then
    begin
     aktuell := i;
     search(i+1,r,found,aktuell,direction);
    end
    else
    begin
     aktuell := i;
     search(l,i-1,found,aktuell,direction);
    end;
  end;
 end;

var
 r: tRec;
 i,c: integer;
 found: boolean;
begin
 found := false;
 i := -1;
 if count > 0 then
  search(0,count,found,i,c);

 if found then
 begin
  if oRec.rxl > tRec(items[i]).rxl then //gff. anpassen
  begin
   tRec(items[i]).rxl := orec.rxl;
   tRec(items[i]).cid := oRec.cid;
   tRec(items[i]).bcch:= orec.bcch;
  end;
 end
 else
 begin
  r := tRec.Create;
  r.assign(oRec);

  if i < 0 then i := 0;

  if (c>0) and (i=count-1) then i := count;
  if (c>0) and (i<count) then inc(i);
  if (i>0) and (compare(orec, items[i-1])<0) then dec(i);

  insert(i,r);
 end;
end;

procedure trList.print;
var
 i: integer;
begin
 for i := 0 to count - 1 do
  writeln('>',i:3,#9,
          trec(items[i]).ion:3:4, #9,
          trec(items[i]).lat:3:4, #9,
          trec(items[i]).rxl, #9,
          trec(items[i]).cid, #9,
          trec(items[i]).bcch);
end;

var
 f       : text;
 s       : string;
 tl      : TRList;
 tmpRec  : tRec;
 firstline: boolean;
begin
 DecimalSeparator:='.';
 firstline := true;
 tmpRec:= tRec.create;
 tl   := TRList.Create;
 AssignFile(f, 'c:\prj\test\test.txt');
 Reset(f);

 while not eof(f) do
 begin
  readln(f,s);
  if not firstline then
  begin
   tmpRec.copystr(trim(s));
   tl.update(tmpRec);
  end
  else
   firstline := false;
 end;
 tl.print;

 close(f);
 tmpRec.free;
 tl.Free;


 readln;
end.
Edit: aktualisierte version, da beim sort noch ein paar unstimmigkeiten vorhanden waren.

ps: hier wird die meiste zeit, ca. 2,3, 4 sekunden für die ausgabe der berechneten werde (120'0000) benötigt. die verarbeitung erfolgt binnen 1, 2 senkunden...


Alle Zeitangaben in WEZ +1. Es ist jetzt 22:18 Uhr.
Seite 3 von 3     123   

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz