Prozedur zu langsam, Optimierung nötig

[grenzgaenger]

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...