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

[himitsu]

Im Post #1 wurde noch eine neuer Abschnitt eingefügt ... siehe "Ein Vorteil der gemeinsamen Ersetzung:"
'Old1' => '<New1 Old2>'
'Old2' => '<New2 Old1>'

Text old1 old2 Old1 Old2 old1 old2 Old1 Old2 Text
Text old1 old2 <New1 Old2> <New2 Old1> old1 old2 Old1 Old2 Text
Text old1 old2 <New1 <New2 Old1>> Old2 old1 old2 Old1 Old2 Text

[GPRSNerd]

Hi himitsu,

das neue Flag funktioniert einwandfrei! Jetzt ist es ein vollwertiger Ersatz für das originale StringReplace.

Danke,
Stefan

[GPRSNerd]

Hallo himitsu,

entschuldige, dass ich diesen etwas älteren Fred nochmal aufwärmen muss, bin aber auf einen Fehler/Exception gestoßen, die ich einfach nicht weg kriege.

Es wird immer eine Exception geschmissen, wenn im Suchstring das zu ersetzende Pattern ganz am Ende steht:

Erste Gelegenheit für Exception bei $75669617. Exception-Klasse ERangeError mit Meldung 'Fehler bei Bereichsprüfung'

in der Zeile:

Delphi-Quellcode:

Move(S[i], Result[i2], i4 * SizeOf(Char));

Hier der Test-Code zum Nachvollziehen:

Delphi-Quellcode:

  dummy:='Text Old';
  ergebnis := StrRep.StringReplace(dummy, 'Old', 'New', [rfReplaceAll]);
  Assert(ergebnis='Text New');

Steht der Text am Anfang oder irgendwo in der Mitte (es folgt also noch mindestens ein Buchstabe), so läuft die Funktion einwandfrei.

Vielleicht kannst du mich/uns erhellen...

Danke,
Stefan

[himitsu]

Hmmm, hast du mal einen TestString parat?
Mir ist grade aufgefallen, daß in meinem Testcode das Pattern auch schon am Ende des Strings liegt.

und ebenso hier tritt kein Fehler auf.

Delphi-Quellcode:

S := '123Wort';
S2 := StringReplace(S, 'Wort', 'xxx', [rfReplaceAll]);

[GPRSNerd]

Steht doch oben als Delphi Code!

Ich benutze Delphi 2010 und du?

[GPRSNerd]

Dein Beispiel knallt bei mir auch!

exception number : 1
exception class : ERangeError
exception message : Range check error.

main thread ($17c4):
005376bc +03dc STGCommonUnitTest.exe StrRep 132 +37 StringReplace

[himitsu]

Das hatte ich vorhin auch zum Testen verwendet. :gruebel:

Welche Version nutzt du denn?
Die _300 aus Beitrag #1 sollte die aktuellere Version 1.1 vom 20.11.2009 22°° sein.
(is'n bissl blöd, das mit den nun fehlenden Attachment-Kommentaren und den veränderten Dateinamen)



Ich teste gleich nochmal 'n bissl rum.
(bin grade auf die Idee gekommen mal wieder die Bereichsprüfung zu aktiveren :oops: )

[GPRSNerd]

Ich benutze "natürlich" die v1.1.

Wenn ich die Move-Zeile mit einer If-Abfrage auf i4<>0 ändere, geht alles gut:

Delphi-Quellcode:

if i4<>0 then Move(S[i], Result[i2], i4 * SizeOf(Char));

[himitsu]

Jupp, genau sowas hatte ich grade verbaut.

Hach ja, der Fehler ist in meinem aktiven Code nie aufgefallen,
aber dazu sei vielleicht erwähnt, daß der Originalcode eine andere Stringverwaltung via PChar besitzt. :oops:

ähhhh ... ich würde es ja gerne Anhängen, aber das geht nicht. :shock:

Also bitte vor alle "Move" das "if i4 <> 0 then " einfügen.

[GPRSNerd]

Bin gerade mal Step-by-Step da durchgegangen mit deinem Beispiel mit 123Wort:

i=8
Length(S)=7
i2=7
i4=0

Der Knall kommt dann vom S[i]=S[8] bei einem String mit 7 Zeichen.

[himitsu]

Jupp, wenn dieses der letzte Fund ist, dann wird versuchst den restlichen nachfolgenden String in das Result zu kopieren.
Der selbe Fehler sollte also auch auftreten, wenn der Pattern mehrfacht direkt hintereinander liegt.

Ohne Bereichsprüfung passiert da eigentlich auch nichts, da Move mit einer Länge von 0 aufgerufen würde,
aber mit Bereichsprüfung bekommt diese natürlich mit, daß der Zeichenindex nach dem Fund natürlich außerhalb des Strings liegt.
Daß letztendlich aber dann doch kein Zugriff auf diesen Index passiert, Aufgrund der Länge=0, bekommt dieser Prüfcode natürlich nicht mit.

Im Originalcode hatte ich die Prüfung von MoveMemory ausgenutzt und daher keine Eigene verbaut,
was allerdings bei dem direkten Zugriff auf den String (via S[i]) nicht mehr so gut enden muß. :?

[youuu]

Hi, ich verwende deine Stringreplace Routine, allerdings erhalte ich einen Fehler hier:

Delphi-Quellcode:

  Function StringReplaceX(Const S: String; Const OldPattern, NewPattern: Array of String; Flags: TReplaceFlags = []): String;
    Function GetNewPatt(i: Integer): String;
      Begin
        If i < Length(NewPattern) Then Result := NewPattern[i]
        Else If Length(NewPattern) = 1 Then Result := NewPattern[1]
        Else Result := '';
      End;

Fehlermeldung: Erste Gelegenheit für Exception bei $75F89617. Exception-Klasse EAccessViolation mit Meldung 'Zugriffsverletzung bei Adresse 75F89F11 in Modul 'KERNELBASE.dll'. Lesen von Adresse 00C81000'.

Wenn ich die Exception abfange, rennt er mit OutOfMemory

[mkinzler]

In welcher Zeile?
Was hast du als OldPattern bzw. NewPattern übergeben?

[youuu]

Delphi-Quellcode:

   Else If Length(NewPattern) = 1 Then Result := NewPattern[1]

Ist rot markiert, was genau übergeben wurde, werde ich nun nach schauen

[himitsu]

joar, da stimmt was nicht.
tausch mal die 1 gegen eine 0 aus

Delphi-Quellcode:

Result := NewPattern[0]

[edit]
oder besser so ... ich denk mal das wäre logischer, wenn der Letzte, anstatt der erste Eintrag genutzt würde.

Delphi-Quellcode:

Function GetNewPatt(i: Integer): String;
  Begin
    If i < Length(NewPattern) Then Result := NewPattern[i]
    Else If Length(NewPattern) > 0 Then Result := NewPattern[High(NewPattern)]
    Else Result := '';
  End;

ich tausche die Anhänge auch gleich aus

[youuu]

Himitsu, das wars !

[himitsu]

ach mißt, das läßt sich ja garnicht editieren :wall:
(und das fehlende [PRE]-Tag fällt auch auf ... also bezüglich der nicht mehr geparsten Format-Tags :? )

@Mods: Arbeit für euch > Anhänge dieses Post im ersten Post hochladen

[edit]
Anhänge wurden nun nach Beitrag #1 kopiert, drum lösch ich sie hier mal wieder

[freejay]

Hi himitsu,

danke für diese schnelle StringReplace-Version!

Ich konnte die Dauer in einem Fall von 32 Minuten auf eine knappe Sekunde drücken! Das ist ca. Faktor 2000! ;-)

Danke & Gruß

Freejay

[p80286]

@Himitsu:thumb::thumb::thumb:

Ich hab eine 25MB große Stringlist.
Ansireplacestring braucht irgendwas um die 30 Minuten, etwas selbstgebasteltes ca 12 und Himitsus irgendwas im 1-5 Sekunden Bereich.

Vielen Dank!

K-H