Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.993 Beiträge
Delphi 12 Athens
|
Re: TStringlist mit 60000 Einträgen zu langsam
12. Feb 2010, 15:03
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;
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
|