AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Prozedur zu langsam, Optimierung nötig

Ein Thema von carknue · begonnen am 8. Mär 2007 · letzter Beitrag vom 18. Mär 2007
Antwort Antwort
Seite 3 von 3     123   
Hawkeye219

Registriert seit: 18. Feb 2006
Ort: Stolberg
2.227 Beiträge
 
Delphi 2010 Professional
 
#21

Re: Prozedur zu langsam, Optimierung nötig

  Alt 17. Mär 2007, 18:23
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
  Mit Zitat antworten Zitat
carknue

Registriert seit: 26. Mai 2005
37 Beiträge
 
Turbo Delphi für Win32
 
#22

Re: Prozedur zu langsam, Optimierung nötig

  Alt 17. Mär 2007, 20:55
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;
  Mit Zitat antworten Zitat
grenzgaenger
(Gast)

n/a Beiträge
 
#23

Re: Prozedur zu langsam, Optimierung nötig

  Alt 18. Mär 2007, 13:12
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>
  Mit Zitat antworten Zitat
grenzgaenger
(Gast)

n/a Beiträge
 
#24

Re: Prozedur zu langsam, Optimierung nötig

  Alt 18. Mär 2007, 15:14
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...
Angehängte Dateien
Dateityp: pas test_124.pas (3,1 KB, 2x aufgerufen)
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 3 von 3     123   


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 04:52 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz