StringReplace und doppelte Zeichen

[alzaimar]

So, jetzt hab ich mal ein alternatives Testszenario erstellt.

Test #1:
Ein langer String (Länge einstellbar) wird mit zufälligen Großbuchstaben gefüllt. Dann wird die Routine nacheinander für alle Buchstaben aufgerufen. Die gesamte Ausführungszeit wird gemessen und das Ergebnis dargestellt.

Test #2:
Das '_' Zeichen wird zufällig (Häufigkeit einstellbar) in einen String aus Buchstaben eingefügt. Dann wird die Routine mit '_' als zu eliminierendes Zeichen aufgerufen.

Bei den einzelnen Versionen wurden dabei einige kleine Fehler entdeckt und ausgebaut.

Dann habe ich Hawkeyes Version nochmal aufgemotzt und das ist dann in diesen Tests die schnellste Version. Hawkeyes Original ist sowieso schneller als alle anderen...

[himitsu]

hab bei mir mal ein/zwei Fehlerchen behoben

Delphi-Quellcode:

Function ReduceMultiples(Const S: String; C: Char): String;
  Var Pi, Po, Pe: PChar;
    Cm: Char;

  Begin
    Result := S;
    If Result = '' Then Exit;
    Pi := @Result[1];
    Pe := Pi + Length(Result);
    Inc(Pi);
    Po := Pi;
    Cm := Result[1];
    While Pi < Pe do Begin
      If (Pi^ <> Cm) or (Pi^ <> C) Then Begin
        Inc(Po);
        Cm := Pi^;
      End;
      Inc(Pi);
      Po^ := Pi^;
    End;
    SetLength(Result, Po - @Result[1]);
  End;

und leider hab'sch festgestellt, daß mein Compiler besser optimiert, als ich ;(

Delphi-Quellcode:

Function ReduceMultiplesA(Const S: String; C: Char): String;
  Var i: Integer;

  Begin
    Result := S;
    UniqueString(Result);
    ASM
      PUSH EDI
      PUSH ESI
      MOV  &i, 0
      MOV  DL, &C
      MOV  EAX, &Result
      MOV  EAX, [EAX]
      CMP  EAX, 0                   // If Result_EAX = '' Then Exit;
      JZ   @Exit                    //
      MOV  ESI, EAX                 // Pi_ESI := @Result_EAX[1];
      MOV  ECX, ESI                 // Pe_ECX := Pi_ESI + Length(Result_EAX);
      ADD  ECX, DWORD PTR [EAX - 4] //
      INC  ESI                      // Inc(Pi_ESI);
      MOV  EDI, ESI                 // Po_EDI := Pi_ESI;
      MOV  DH, BYTE PTR [EAX]       // Cm_DH := Result_EAX[1];
      @Loop:                        // While Pi_ESI < Pe_ECX do Begin
      CMP  ESI, ECX                 //
      JGE  @LoopEnd                 //
      MOV  AL, BYTE PTR [ESI]       //   If (Pi_ESI^ <> Cm_DH) or (Pi_ESI^ <> C_DL) Then Begin
      CMP  AL, DH                   //
      JNZ  @BeginIf                 //
      CMP  AL, DL                   //
      JZ   @EndIf                   //
      @BeginIf:                     //
      INC  EDI                      //     Inc(Po_EDI);
      MOV  DH, BYTE PTR [ESI]       //     Cm_DH := Pi_ESI^;
      @EndIf:                       //   End;
      INC  ESI                      //   Inc(Pi_ESI);
      MOV  AL, BYTE PTR [ESI]       //   Po_EDI^ := Pi_ESI^;
      MOV  BYTE PTR [EDI], AL       //
      JMP  @Loop                    // End;
      @LoopEnd:                     //
      MOV  EAX, &Result
      SUB  EDI, [EAX]               // i := Po_EDI - @Result_EAX[1];
      MOV  &i, EDI                  //
      @Exit:
      POP  ESI
      POP  EDI
    End;
    SetLength(Result, i);
  End;

[Opa]

Wenn dann ist die Assembler Routine nur minimal schneller.

Als ich das mein (Ding) war nur ein dussliges Abfallprodukt, nach dem Motto schreib mal was rein ins Forum. Konnte ich nicht ahnen das dieses Tun eine solche Reaktion auslöst. Erst hatte ich dachte man macht mich hier nur dumm an.

Lob also allen die sich die Mühe gemacht haben, meinen Gedanken zu optimieren. Und ich habe sogar was gelehrt. SetLength ist mir zwar bekannt gewesen. Das dieser Befehl eine solche Auswirkung hat, was Geschwindigkeit angeht, hatte ich nicht geahnt. Normalerweise mache ich mir darüber auch keine Gedanken mehr. Alles was unterhalb einer Sek. ist, nehme ich kaum zur Kenntnis (früher war das anders, langsamer Rechner).

Ich muss sagen bin positiv überrascht, es wird nicht nur gemäkelt, ist werden auch Verbesserungsvorschläge gemacht. Lob, Lob, Lob all denen usw.
MFG

Ps.: Alter Mann ist immer am langsamten. Aber das so ein Ding nicht in Delphi ist nervt :dp:

Noch was zum optimieren :-D Das ist (ein Test) blah , in Klammern muss weg

Code:

function _DeleteTextInKlammer(const S:string;Auf,Zu:Char):string;overload;
var
  I,P : integer;
  OK  : boolean;
begin
  SetLength(Result, Length(S));
  P :=1;
  I :=1;
  OK := false;
  repeat
    if S[I] = Auf then
    begin
      OK := false;
      while (S[I] <> Zu) and (I< Length(S)) do
      inc(I);
    end;
    if S[I] =Zu
    then Ok := true
    else begin
           if I <= Length(S) then
           begin
             Result[P] := S[I];
             inc(P);
           end;
         end;
    inc(I);
  until I > Length(S);
  if not OK
  then Result := S
  else SetLength(Result,P-1);
end;

[himitsu]

nja, wenn jemand die Überschrift in irgendwas mit Optimieren umbenennt, dann könnten wir mit Klammern weitermachen, aber so past's nicht so ganz zum Thema ;)

im Anhang:
Ratio umgekehrt (so sehn die Zahlen doch netter aus? ... Dauer im Vergleich zum Original)
und es wird angezeigt ob das Testergebnis richtig (OK) ist.

[Opa]

War auch nur gedacht, wenn einer über Wein8 keine arbeit hat. :wink:

[Dipl Phys Ernst Winter]

"Uropa" antwortet "Opa"

Halte Dich doch an das, was Du bewerkstelligen willst: Du willst Zeichen aus einem String löschen.

Delphi-Quellcode:

function TForm1.KillDoppelteZeichen(s: string): string;
var
  i: integer;
begin
  i:= 1;
  repeat
    if s[i+1]=s[i] then begin              // Doppeltes Zeichen
      Delete(s, i+1, 1); continue end        // entfernen
    else Inc(i);                           // sonst weiter
  until i=Length(s)-1;
  Result:= s
end;

Oh, da habe ich doch glatt übersehen, dass Du nur die Doppelten eines bestimmten Buchstaben eliminieren willst. Also:

Delphi-Quellcode:

function TForm1.KillDoppelteZeichen(s: string; ch:Char): string;
var
  i: integer;
begin
  i:= 1;
  repeat
    if (s[i]=ch) and (s[i+1]=s[i]) then begin Delete(s, i+1, 1); continue end
    else Inc(i);
  until i=Length(s)-1;
  Result:= s
end;

Da das alles im Augenblick geht, ist die Geschwindigkeit kein Thema. Oder willst di im String die ganzen Budenbroks übergeben.

[Dax]

Mal davon abgesehen, dass der Thread jetzt schon über ein Jahr alt ist ;) läuft dein Algorithmus in quadratischer Zeit, wo nur lineare Zeit nötig wäre. Das funktioniert zwar, wird aber niemanden überzeugen.

[Dipl Phys Ernst Winter]

function KillDoppelZeichenToZeichen(S:string;C:Char):string ;

Nachdem ich diese kriegerische Funktion in meine Beispielsammlung aufgenommen hatte, kam die Frage
wozu sie nütze ist.

Die Beispiele mit C=x erscheinen mir sinnlos, einzig C=Leerzeichen macht einen Sinn, dann sollten wir aber glech

function DeleteDouleSpace(s: string): string;

entwickeln, die führende und doppelte Leerzeichen entfernt.

Delphi-Quellcode:

function TForm1.DeleteDoubleSpace(s: string): string;
var
  i: integer;
begin
  if Length(s)<2 then begin Result:= ''; Exit end;
  i:= 1;
  repeat
    if (s[i]=' ') and (s[i+1]=s[i]) then begin Delete(s, i+1, 1); continue end
    else Inc(i);
  until i=Length(s);
  Result:= s
end;

Die Geschwindigkeit scheint mir kein Thema zu sein, da das im Augenglick ausgeführt wird.

Exception bei zu kurzem String abgefangen

[himitsu]

völlig unoptimiert, aber zumindestens ohne "unübersichtlierem" Continue-rumgespringe :angel:

Delphi-Quellcode:

Result := S;
i := Length(Result) - 1;
While i > 0 do Begin
  If (Result[i] = ' ') and (Result[i + 1] = ' ') Then Delete(Result, i + 1, 1);
  Dec(i);
End;

steht so in etwa in meinem TXMLFile.Trim ... nja, erst die Funktion, dann alles Durchoptimieren :angel2:

aber wie gesagt, diese ständigen Zugriffe auf die Chars im String (da wird mehr gemacht, als nur das Zeichen ausgelesen) und das zu häufige Rumkopieren des gesamten Strings, bei jedem Delete .... nicht unbedingt Schnell und Resourcenschonend. :angel:

[add]

Code:

function TForm1.DeleteDoubleSpace([b]s: string[/b]): string;

und was den Funktionsaufruf angeht ... siehe http://www.delphipraxis.net/internal...t.php?t=156940

[add2]
ach ja, gib mal bitte deiner Funktion einen Leerstring zum Futtern DeleteDoubleSpace('') ...
die Exception ist bestimmt ganz hübsch Anzusehn
und bei eingeschalteter Bereichsprüfung würde auch schon ein String mit weniger als 2 Zeichen eine Meldung von sich geben.

MfG :angel: