TStringlist mit 60000 Einträgen zu langsam

[himitsu]

Zitat von friedemann2009:

Zitat von David Martens:

Die Sortierung ist, glaube ich, schon wichtig. Mit .sorted := true; geht die verloren.

So isses.

abgesehn davon suchst du auch nicht in den StringListen (nur in den einzelnen Teil-Strings), sondern greifst direkt via Index zu, wofür ein Sortierung keine Verbesserung bringt.


Ich hab jetzt einfach mal als Beispiel deinen Code aus Beitrag #15 genommem.
vor alles kommt jetzt der Teil davon:

Delphi-Quellcode:

var XXX: Array[0..40] of Int64;

procedure XStart(i: Integer);
var X: Int64;
begin
  QueryPerformanceCounter(X);
  XXX[i] := XXX[i] - X;
end;

procedure XStop(i: Integer);
var X: Int64;
begin
  QueryPerformanceCounter(X);
  XXX[i] := XXX[i] + X;
end;

procedure XShow;
var X: Int64;
  i: Integer;
  S: String;
begin
  S := '';
  QueryPerformanceFrequency(X);
  for i := 0 to High(XXX) do
    if (XXX[i] > 0) and (XXX[i] < $40000000000000 div x) then
      S := Format('%s  %d:%dms', [S, i, (XXX[i] * 1000 + 500) div X])
    else if XXX[i] <> 0 then
      S := Format('%s  %d:error', [S, i]);
end;

Und dann wird einfach für jeden "interessanten" Abschnitt die Zeit gemessen.
Vor den Abschnitt XStart(num) und danach XStop(num).
Aufpassen muß man aber bei Exit, Break, Continue, sowie bei Exceptions.


Jetzt siehst du paktisch, wo wieviel Zeit (in Millisekunden) verloren geht.

Delphi-Quellcode:

ZeroMemory(@XXX, SizeOf(XXX));  ///////// initialisieren /////////////////////////////

// Einzelne Texte zusammensetzen
    begin
XStart(0);
      quelle:= tstringlist.create;
      ziel:= tstringlist.create;

      try
XStart(1);
        //Previewdatei laden
        quelle.LoadFromFile(extractfilepath(application.exename) + 'preview2.dat');
XStop(1);

XStart(2);
        //Ersetzen von zwei Zeichen, da sich ansonsten im weiteren Analyseverlauf nicht korrekt verarbeitet werden; umständlich, aber anders weiß ichs nich..
        quelle.Text:=stringreplace2(quelle.text, '"', 'ANFUEEEE');
        quelle.Text:=stringreplace2(quelle.text, #39, 'EINFANFUEEEE');
XStop(2);

XStart(3);
        for ii:=0 to quelle.Count-1 do
          begin
XStart(4);
          wortarttemp:= gibmirwortart(quelle.strings[ii], #9);
XStop(4);

XStart(5);
          //Token zusammennehmen
          if pos('#' + wortarttemp + '#', tok)<>0 then  //Bedingung; braucht keine Zeit, da der zu durchsuchende String tok nur ~40 Zeichen groß ist
            ziel.text:= ziel.text + gibmirtoken(quelle.strings[ii], #9);
XStop(5);

XStart(6);
          //Lemma zusammennehmen
          if pos('#' + wortarttemp + '#', lem)<>0 then //s.o.
            begin
XStart(7);
              lemmareal:= gibmirlemma(quelle.strings[ii], #9);
              schon:= 0;
XStop(7);

XStart(8);
              if (lemmareal= '<UNKNOWN>') and (checkbox2.checked) then  //weitere Bedingungen
                begin
                ziel.text:= ziel.text + gibmirtoken(quelle.strings[ii], #9);
                schon:= 1;
                end;
XStop(8);

XStart(9);
              if (lemmareal= '@card@') and (checkbox4.checked) then
                begin
                ziel.text:= ziel.text + gibmirtoken(quelle.strings[ii], #9);
                schon:= 1;
                end;
XStop(9);

XStart(10);
              if (lemmareal= 'CARD') and (checkbox4.checked) then
                begin
                ziel.text:= ziel.text + gibmirtoken(quelle.strings[ii], #9);
                schon:= 1;
                end;
XStop(10);

XStart(11);
              if (lemmareal= '@ord@') and (checkbox4.checked) then
                begin
                ziel.text:= ziel.text + gibmirtoken(quelle.strings[ii], #9);
                schon:= 1;
                end;
XStop(11);

XStart(12);
              if schon=0 then ziel.text:= ziel.text + lemmareal;
XStop(12);
            end;
XStop(6);

XStart(13);
          //Wortart zusammennehmen
          if pos('#' + wortarttemp + '#', poss)<>0 then //s.o.
            ziel.Text:= ziel.text + gibmirwortart(quelle.strings[ii], #9);
XStop(13);

         end;
XStop(3);

XStart(14);
        //Wenn die Stringlist quelle durchgearbeitet ist und aller relevanten Strings in ziel, dann sollen die Strings in ziel zu einem fortlaufenden Text (-> zielende: string;) zusammengesetzt werden
        for x:=0 to ziel.Count-1 do
          zielende:= zielende + ' ' + ziel.Strings[x];
XStop(14);

XStart(15);
        //Vorherige Ersetzungen rückgängig machen
        zielende:= stringreplace2(zielende, 'ANFUEEEE', '"');
        zielende:= stringreplace2(zielende, 'EINFANFUEEEE', #39);
XStop(15);

XStart(16);
        //Ergebnis (Preview) in Memo ausgeben
        memo2.text:= zielende;
XStop(16);

      finally
        quelle.free;
        ziel.Free;
      end;
XStop(0);

XShow;  ///////// Ergebnis ausgeben /////////////////////////////

################################################################################

//Funktion für die Ersetzung; ist schneller als die alte stringreplace
function stringreplace2(aString, FromStr, ToStr: AnsiString): AnsiString;
var
   I: Integer;
begin
XStart(31);
  // check whether string are equal
   if FromStr = ToStr then
   begin
      Result := aString;
XStop(31);
      Exit;
   end;
   Result := '';
  // find fromstr
   I := Pos(FromStr, aString);
   while I > 0 do
   begin
    // copy all characters prior fromstr
      if I > 1 then
         Result := Result + Copy(aString, 1, I - 1);
    // append tostr
      Result := Result + ToStr;
    // delete all until after fromstr
      Delete(aString, 1, I + Length(FromStr) - 1);
    // find next fromstr
      I := Pos(FromStr, aString);
   end;
   Result := Result + aString;
XStop(31);
end;

//hier wird die zweite Stelle des durch tab geteilten Strings aus quelle ermittelt
function gibmirwortart(s:string; sep:char) :string;
var
  t: Tstringlist;
begin
XStart(32);
  //hier muss jetzt das zweite Wort rausgefiltert werden
  t:= tstringlist.create;
  try
  extractstrings([char(sep)], [' '], pchar(s), t);
  result:= t.Strings[1];
  finally
  t.free;
  end;
XStop(32);
end;

//hier wird die erste Stelle des durch tab geteilten Strings aus quelle ermittelt
function gibmirToken(s:string; sep:char) :string;
var
  t: Tstringlist;
begin
XStart(33);
  //hier muss jetzt das zweite Wort rausgefiltert werden
  t:= tstringlist.create;
  try
  extractstrings([char(sep)], [' '], pchar(s), t);
  result:= t.Strings[0];
  finally
  t.free;
  end;
XStop(33);
end;

//hier wird die dritte Stelle des durch tab geteilten Strings aus quelle ermittelt
function gibmirLemma(s:string; sep:char) :string;
var
  t: Tstringlist;
begin
XStart(34);
  //hier muss jetzt das zweite Wort rausgefiltert werden
  t:= tstringlist.create;
  try
  extractstrings([char(sep)], [' '], pchar(s), t);
  result:= t.Strings[2];
  finally
  t.free;
  end;
XStop(34);
end;