schnelleres StringReplace und MultiStringReplace

[himitsu]

Code-Library -> Object-Pascal / Delphi-Language -> Ersatz für StringReplace
Bei sakuras Code fehlt das Highlighting
und dann könnte man bitte mal bei seinem Code die AnsiString durch String ersetzen.
Der Code ist für Unicode geeignet, aber so ist er nur Ansi und ab D2009 ist das verwendete POS Unicode.
(AnsiString + Uniode-Pos = ständige Stringumkodierungen)

Die nachfolgenden 3 Beiträge (#2 bis #4) sind auch hinfällig, da die verlinkten Seiten alle nicht mehr existieren.


Wenn man schon dabei ist, dann könnte man diesen Beitrag eventuell gleich noch mit Folgendem verschmelzen:
Code-Library -> Object-Pascal / Delphi-Language -> Mehrere Strings auf einmal ersetzen



Soooo, aber man wird es nicht glauben, da ich die nun fehlenden Beiträge nicht so lassen kann ...
hier noch ein paar neue Versionen.

Diese sind zwar weitestgehend optimiert, aber der Übersichtlichkeit wegen wurde auf PChar's jetzt erstmal absichtlich verzichtet.
(es sollte dennoch recht flott sein)

Hab diese Funktionen jetzt nur mal schnell neu geschrieben und, soweit meine paar Tests es zeigten, sollten sie problemlos funktionieren.

Mit Ansi und Unicode dürften sie klarkommen und sind somit für alle Delphiversionen geeignet.
(solange ein PosEx/PosEx vorhanden ist)

bei der Array-Version:
- die Arrays können beliebig groß sein
- sind weniger NewPattern als OldPattern vorhanden, dann werden die "fehlenden" durch '' ersetzt
- ist genau ein NewPattern vorhanden, dann werden alle OldPattern durch das eine NewPattern ersetzt
- [] und [rfIgnoreCase] ersetzen nur DAS erste Vorkommen, egal was gefunden wird
- [rfReplaceFirstOfAll] und [rfReplaceFirstOfAll, rfIgnoreCase] ersetzen nur JEWEILS das erste Vorkommen aller Suchworte
- [rfReplaceAll] und [rfReplaceAll, rfIgnoreCase] ersetzt ALLE Vorkommen

Delphi-Quellcode:

Function StringReplace(Const S, OldPattern, NewPattern: String;          
  Flags: TReplaceFlags = []): String; Overload;

Function StringReplace(Const S: String; Const OldPattern, NewPattern: Array of String;
  Flags: TReplaceFlags = []): String; Overload;

Als Arrays kann man statische oder dynamische String-Arrays oder die Werte direkt übergeben.

Delphi-Quellcode:

Const X: Array[1..6] of String = ('ae', 'oe', 'ue', 'Ae', 'Oe', 'Ue');

S := StringReplace(S, ['ä', 'ö', 'ü', 'Ä', 'Ö', 'Ü'], X, [rfReplaceAll]);

Falls wer auf die Idee kommt "Wozu das Array? Ich nehm die Funktion einfach doppelt. :)"

Ein Vorteil der gemeinsamen Ersetzung:
'Old1' => '<New1 Old2>'
'Old2' => '<New2 Old1>'

Delphi-Quellcode:

dummy := 'Text Old1 Old2 old1 old2 Old1 Old2 old1 old2 Text';
ergebnis := StringReplace(dummy, ['Old1', 'Old2'], ['<New1 Old2>', '<New2 Old1>'], []);
Memo1.Lines.Add(dummy);
Memo1.Lines.Add(ergebnis);

dummy := 'Text old1 old2 Old1 Old2 old1 old2 Old1 Old2 Text';
ergebnis := SysUtils.StringReplace(dummy, 'Old1', '<New1 Old2>', []);
ergebnis := SysUtils.StringReplace(ergebnis, 'Old2', '<New2 Old1>', []);
Memo1.Lines.Add(ergebnis);

Code:

Text old1 old2 [color=#ff0000]Old1[/color] [color=#0000ff]Old2[/color] old1 old2 Old1 Old2 Text
Text old1 old2 [color=#ff0000]<New1 Old2>[/color] [color=#0000ff]<New2 Old1>[/color] old1 old2 Old1 Old2 Text
Text old1 old2 [color=#ff0000]<New1 [/color][color=#ff00ff]<New2 Old1>[/color][color=#ff0000][b]>[/b][/color] [color=#0000ff]Old2[/color] old1 old2 Old1 Old2 Text

[edit]
kleiner Fehler im Header ... Kommentar nicht abgeschlossen und fast ganze Datei als Kommentar angesehn aka es wurde gemekert, daß kein Code gefunden wurde :oops:

[edit]
entsprechend Post #8 wurde noch ein neues Flag eingefügt

[edit=Matze]Anhänge aktualisiert.[/edit]

[himitsu]

hier nur noch ein kleiner Test dazu

Delphi-Quellcode:

Program Project1;

{$APPTYPE CONSOLE}

Uses Windows, SysUtils, StrRep;

Var C: Integer = 10000;

Var i, i4:   Integer;
  i2, i3:    Int64;
  S, S2, S3: String;
  T:         LongWord;

Begin
  C := (C div 1000) * 1000;

  WriteLn('baue Teststring zusammen...');
  T := GetTickCount;
  S := '';
  //For i := 0 to C - 1 do
  //  S := S + StringOfChar(' ', Random(20)) + 'Wort';
  {}For i := 0 to C div 1000 - 1 do Begin
  {}  S2 := '';
  {}  For i4 := 0 to 1000 - 1 do
  {}    S2 := S2 + StringOfChar(' ', Random(20)) + 'Wort';
  {}  S := S + S2;
  {}End;
  T  := GetTickCount - T;
  WriteLn(C, ' W”rter, ', Length(S), ' Zeichen, ', T, ' ms');

  WriteLn;
  WriteLn('StringReplaceX:');
  //T := GetTickCount;
  {}QueryPerformanceCounter(i2);  // GetTickCount ist zu langsam X'D
  S2 := StringReplaceX(S, 'Wort', 'xxx', [rfReplaceAll]);
  //T := GetTickCount - T;
  //WriteLn(T, ' ms');
  {}QueryPerformanceCounter(i3);
  {}i2 := i3 - i2;
  {}QueryPerformanceFrequency(i3);
  {}WriteLn(i2 * 1000 / i3:0:2, ' ms');

  WriteLn;
  WriteLn('StringReplace:');
  T  := GetTickCount;
  S3 := StringReplace(S, 'Wort', 'xxx', [rfReplaceAll]);
  T  := GetTickCount - T;
  WriteLn(T, ' ms');

  WriteLn;
  WriteLn('Ende mit [Enter]');
  ReadLn;
End.

raus kommt dann sowas

Code:

baue Teststring zusammen...
1000 Wörter, 13386 Zeichen, 0 ms

StringReplaceX:
0.19 ms

StringReplace:
15 ms

Ende mit [Enter]

Wie man nachfolgend sehen kann, wächst bei Borland's Version
mit steigender Ersetzungsanzahl die Zeit expoteniell an,
wärend sie es bei mir nur linear tut. :)

Code:

Delphi 7                             Delphi 2009
********************************     ********************************
1000 Wörter, 13386 Zeichen           1000 Wörter, 13386 Zeichen
0.19 ms                              0.15 ms
15 ms                                16 ms

10000 Wörter, 134623 Zeichen         10000 Wörter, 134623 Zeichen
1.85 ms                              1.42 ms
1953 ms                              484 ms

100000 Wörter, 1351083 Zeichen       100000 Wörter, 1351083 Zeichen
18.41 ms                             13.13 ms
208484 ms                            293313 ms

1000000 Wörter, 13496864 Zeichen     1000000 Wörter, 13496864 Zeichen
196.06 ms                            151.92 ms
{hatte keine Lust zu warten}         {schonwieder keine Lust}

[xaromz]

Hallo,

ich habe mal meine Version angehängt (Delphi 2007), kannst Du die Ergebnisse auf Deinem Rechner zum Vergleich posten?

Gruß
xaromz

[himitsu]

Deine ist gut nochmal doppelt so schnell

Code:

1000 Wörter, 13386 Zeichen
0.08 ms
15 ms

10000 Wörter, 134623 Zeichen
0.72 ms
1281 ms

100000 Wörter, 1351083 Zeichen
7.35 ms
-

1000000 Wörter, 13496864 Zeichen
74.04 ms
-

Und genau deswegen hatte ich mir dann jegliche weitere Optimierung gespart ...
gegenüber dem Original sind so oder so locker mal 99% Zeitersparnis drin. (ab 100 Ersetzungen)
Dafür ist der Code dann noch halbwegs verständlich :angel: ... eine für den Zweck "optimiertere" Version davon ist in meinem himXML verbaut ... bzw. daß ist 'ner abgespeckte Version davon.

(~50% ab 2 Ersetzungen und selbst bei einer Ersetzung werden schon ein paar Nanosekunden gespart)


Kannst gern deine Version (den Code) noch mit anhängen.

[xaromz]

Hallo,

Zitat:

Zitat von himitsu

Kannst gern deine Version (den Code) noch mit anhängen.

mach ich doch glatt. Diese Version ist etwas langsamer, da ich bisher zwei Versionen hatte und mir das Flag rfReplaceAll gespart hatte.

Gruß
xaromz

[himitsu]

Delphi-Quellcode:

finally
  // Clean up
  Finalize(Positions);
  Finalize(Patterns);
end;

Dieses kannst'e dir eigentlich sparen, denn Delphi hat für dynamische Arrays, Strings und Interfaces ein automatisches und exceptionsicheres Finalize (im "End;" der Funktion) eingebaut. :angel:

Delphi-Quellcode:

. // Clean up
  Finalize(Positions);
except
end;

ein Except ohne Fehlerbehandlung ist auch nicht sonderlich gut ... lass es lieber weg

PS: SizeOf(Char) ist eine Konstante und würde direkt verrechnet
und bei CharLength als Variable müßte immer erst der Variableninhalt rüberkopiert werden, bevor gerechnet wird.

[xaromz]

Hallo,

Zitat:

Zitat von himitsu

Delphi-Quellcode:

finally
  // Clean up
  Finalize(Positions);
  Finalize(Patterns);
end;

Dieses kannst'e dir eigentlich sparen, denn Delphi hat für dynamische Arrays, Strings und Interfaces ein automatisches und exceptionsicheres Finalize (im "End;" der Funktion) eingebaut. :angel:

weiß ich, schadet aber ja nicht. Hab's rausgeschmissen.

Zitat:

Zitat von himitsu

ein Except ohne Fehlerbehandlung ist auch nicht sonderlich gut ... lass es lieber weg

Das sind nur noch Reste, da stand mal was drin.

Hab den aktualisierten Code hochgeladen.

Gruß
xaromz

[GPRSNerd]

Hallo himitsu,

folgender Test der Funktion schlägt fehl:

Delphi-Quellcode:

  dummy:='Text Old1 Old2 old1 old2 Old1 Old2 old1 old2 Text';

  //Ohne Flags = Nur die ersten Funde und Case Sensitive
  ergebnis := StringReplaceX(dummy, ['Old1', 'Old2'], ['New1', 'New2'], []);
  Memo.Lines.Add('StringReplaceX('+dummy+', [Old1, Old2], [New1, New2], []):  '+crlf+
                 '               '+ergebnis);
  Assert(ergebnis='Text New1 New2 old1 old2 Old1 Old2 old1 old2 Text');

Oder habe ich die Funktionsweise nicht richtig verstanden?
Ich dachte, dass die jeweils ersten Treffer von Old1 durch New1 und Old2 durch New2 ersetzt werden würden...

Gruß,
Stefan

[himitsu]

Delphi-Quellcode:

//Ohne Flags = Nur DER erste Fund und Case Sensitive
ergebnis := StringReplaceX(dummy, ['Old1', 'Old2'], ['New1', 'New2'], []);
Memo.Lines.Add('StringReplaceX('+dummy+', [Old1, Old2], [New1, New2], [])');
Memo.Lines.Add('               '+ergebnis);
Assert(ergebnis='Text New1 Old2 old1 old2 Old1 Old2 old1 old2 Text');

es wird nur der ERSTE Fund ersetzt,

Delphi-Quellcode:

//Ohne Flags = Nur DER erste Fund und Case Sensitive
ergebnis := StringReplaceX(dummy, ['old2', 'old1'], ['new2', 'new1'], []);
Memo.Lines.Add('StringReplaceX('+dummy+', [old2, old1], [new2, new1], [])');
Memo.Lines.Add('               '+ergebnis);
Assert(ergebnis='Text Old1 Old2 new1 old2 Old1 Old2 old1 old2 Text');

egal was zuerst gefunden wird.



[add]

Zitat:

Kannst gern deine Version (den Code) noch mit anhängen.

jetzt seh ich erst, daß der Code von xaromz schon im anderem Thread drinstand :oops:


[add]
@GPRSNerd: damit du dein Verhalten bekommst, hab ich mal rfReplaceFirstOfAll eingeführt :)

[xaromz]

Hallo,

Zitat:

Zitat von GPRSNerd

Ich dachte, dass die jeweils ersten Treffer von Old1 durch New1 und Old2 durch New2 ersetzt werden würden...

meine Funktion arbeitet genau so.

Zitat:

Zitat von himitsu

jetzt seh ich erst, daß der Code von xaromz schon im anderem Thread drinstand :oops:

Ja, aber der jetzige ist noch etwas neuer.

Gruß
xaromz