Stringverarbeitung - Leerzeichen reduzieren

[Tyrael Y.]

Hallo zusammen,

ich habe eine Stringverabeitungsfunktion geschrieben, die mehrere aufeinanderfolgende
Leerzeichen innerhalb eines Strings zu einem Leerzeichen reduziert und somit den
String neu aufbaut.

Diese Funktion benutze ich im Zusammhang mit Daten aus einer Datenbank.
Die Funktion wird sehr oft aufgerufen. Es läuft auch gut.
Ich versuche gerade in der Gesamtverarbeitung Performace zu gewinnen.

Hat einer eine Idee, wie ich diese Funktion noch schneller realisieren könnte?

Speicherauslastung spielt keine Rolle, Geschwindigkeit ist primär.

Delphi-Quellcode:

function DeleteBlanksFromStr(const AString: string): string;

  function DeleteBlanks(AStr: string): string;
  var i,
    LIndex,
    LCount: Integer;
    LStr,
    LString: string;
  begin
    //prüfen ob innerhalb des Strings noch zwei aufeinander folgende Leerzeichen sind,
    //wenn keine vorhanden, keine weitere Verarbeitung nötig
    result := AStr;
    LIndex := Pos('  ', AStr);
    if (LIndex > 0) then
    begin
      //falls den leerzeichen ein weiteres folgt prüfen, ob weitere folgen
      i := LIndex + 2;
      while (AStr[i] = ' ') do
      begin
        inc(i);
      end;

      //wenn i sich verändert hat, gab es weitere folgende leerzeichen
          //if not (i = LIndex + 2) then   <- dies würde dazu führen, daß zwei leerzeichen hintereinander nicht 
          //begin                             verarbeitet werden 
        LStr := Copy(AStr, 1 , LIndex);

        LString := Copy(AStr, i, Length(AStr));
        result := LStr +  DeleteBlanks(LString);
         //end;
    end;

  end;

begin
  //Leerzeichen ganz vor und ganz hinten streichen
  result := Trim(AString);

  //alle leerzeichen innerhalb des strings verarbeiten
  result := DeleteBlanks(result);
end;

Danke fürs Lesen.

[jfheins]

Ich würde es so machen:

2 Indizies, einer für den AusgangsString, einer für den Endstring.

Ein bisschen C-like Pseudocode:

Code:

Setlength(Result, length(AString));
j = 0;
for(i=0; i<length(AString); i++)
  if (AString[i] != ' ')
  {
    Result[j] = AString[i];
    inc(j);
  }
setlength(Result, j);

Das sollte es dann sein

Deutlich weniger Funktionsaufrufe und Seicherschieberei

Edits: So, jetzt müssts jeder verstehn, was ich meine ^^

Oh mann, jetzt hab ich gar nicht gelesen was er überhaupt wollte
Muss nochmal überlegen

[Tyrael Y.]

Also die leichteste Lösung ist natürlich eine einfache Schleife, aber sie kann nicht die schnellste Lösung sein, da Strings ohne mehrere Leerzeichen hintereinander auch verabeitet werde.

Ich werde aber mal einen anderen Ansatz testen, ob es schneller als meine oben geschriebene Variante ist.

Eine Schleife mit StringReplace die alle ' ' (zwei Leerzeichen) ducrh ein Leerzeichen ersetzt, bis Pos() keine ' ' (zwei Leerzeichen) mehr findet.

[jfheins]

Soo, hier nochmnal das was du wolltest (Nur Leerzeichen löschen, die doppelt sindd, oder vorne oder hinten)

Code:

Setlength(Result, length(AString)); 
j = 1; 
SpaceBefore = true;
for(i=1; i<=length(AString); i++) 
{
  if (not (AString[i] == ' ' and SpaceBefore)) 
  { 
    Result[j] = AString[i]; 
    inc(j); 
  } 
  
  SpaceBefore = AString[i] == ' ';
}
if (AString[length(AString)] == ' ')
  j = j - 1;
setlength(Result, j-1);

Sollte nicht allzuschwer sein, das nacxh Delphi umzuschreiben.

Zitat von Tyrael Y.:

Also die leichteste Lösung ist natürlich eine einfache Schleife, aber sie kann nicht die schnellste Lösung sein, da Strings ohne mehrere Leerzeichen hintereinander auch verabeitet werde.

Warum nicht? KISS-Prinzip
Ja und? ddann werden eben schöne String auch einmal kopiert.
Wenn du vorher mit pos() prüfst, muss der String ja auch einmal durchgegangen werden. Mal ganz von deinen zig maligen copy()-Aufrufen abgesehen.

Zitat:

Eine Schleife mit StringReplace die alle ' ' (zwei Leerzeichen) ducrh ein Leerzeichen ersetzt, bis Pos() keine ' ' (zwei Leerzeichen) mehr findet.

Also eine Schleife, die den ganzen String durchgeht, um zwei Leerzeichen zu suchen, wenn gefunden, wieder den ganzen String durchgehen, um 2 Leerzeichen durch 1 zu ersetzen, und das in einer Schleife????

Da ist meine Lösung imho um einen Faktor 2-5 schneller

[nahpets]

Hallo,

wär' das was?

Delphi-Quellcode:

function DeleteBlanksFromStr(const AString: string): string;
Var
          i    : Integer;
          iLen : Integer;
          iPos : Integer;
          s    : String;
begin
  s      := Trim(AString);
  iPos   := Pos('  ',s);
  if iPos = 0 then begin
    Result := s;
    exit;
  end;
  iLen   := Length(s);
  Result := Copy(s,1,iPos - 1);
  for i := iPos to iLen do begin
    case s[i - 1] of
      ' ' : case s[i] of
             ' ' : ;
            else
              Result := Result + s[i];
            end;
    else
      Result := Result + s[i];
    end;
  end;
end;

Stephan

[Sir Rufo]

Ja oder vielleicht so:

Delphi-Quellcode:

function DeleteBlanksStr( const Value : string ) : string;
begin
  RESULT := Value;
  while Pos( '  ', RESULT ) > 0 do
    RESULT := {SysUtils.}StringReplace( RESULT, '  ', ' ', [ rfReplaceAll ] );
end;

Geht auf jeden Fall in Delphi 2007

Denn in der Kürze liegt die Würze

cu

Oliver

[DeddyH]

Noch' n Vorschlag:

Delphi-Quellcode:

function DeleteDoubleBlanks(const src: string): string;
var i,j: integer;
begin
  SetLength(Result,Length(src));
  if Length(Result) > 0 then
    begin
      i := 1;
      j := 1;
      while i <= Length(src) do
        begin
          Result[j] := src[i];
          if (src[i] = #32) then
            begin
              while (i <= Length(src)) and (src[i] = #32) do
                inc(i);
            end
          else
            inc(i);
          inc(j);
        end;
      SetLength(Result,j);
    end;
end;

[jfheins]

Ich glaube, jetzt sindd wir an einem Punkt, wo ein quantitativer Vergleich hilfreich wäre

Ausserdem wäre es interessant, wie die Daten aussehen - also ob im Normalfall alles in Ordung ist, und nur in Ausnahmefällen überhaupt etwas gemacht werden muss, oder ob die doppelten Leerzeichen fast immer vorhanden sind

[Sir Rufo]

Hab ich mal gemacht ...

Delphi-Quellcode:

function DeleteBlanksFromStr1( const AString : string ) : string;

  function DeleteBlanks(AStr: string): string; 
  var i, 
    LIndex, 
    LCount: Integer; 
    LStr,
    LString: string; 
  begin 
    //prüfen ob innerhalb des Strings noch zwei aufeinander folgende Leerzeichen sind, 
    //wenn keine vorhanden, keine weitere Verarbeitung nötig 
    result := AStr; 
    LIndex := Pos('  ', AStr); 
    if (LIndex > 0) then 
    begin 
      //falls den leerzeichen ein weiteres folgt prüfen, ob weitere folgen 
      i := LIndex + 2; 
      while (AStr[i] = ' ') do 
      begin 
        inc(i); 
      end; 

      //wenn i sich verändert hat, gab es weitere folgende leerzeichen 
          //if not (i = LIndex + 2) then   <- dies würde dazu führen, daß zwei leerzeichen hintereinander nicht
          //begin                             verarbeitet werden 
        LStr := Copy(AStr, 1 , LIndex); 

        LString := Copy(AStr, i, Length(AStr)); 
        result := LStr +  DeleteBlanks(LString); 
         //end; 
    end; 

  end; 

begin 
  //Leerzeichen ganz vor und ganz hinten streichen 
  result := Trim(AString); 

  //alle leerzeichen innerhalb des strings verarbeiten 
  result := DeleteBlanks(result); 
end;

function DeleteBlanksFromStr2( const AString : string ) : string;
Var
  i    : Integer;
  iLen : Integer;
  iPos : Integer;
  s    : String;
begin
  s      := Trim(AString);
  iPos   := Pos('  ',s);
  if iPos = 0 then begin
    Result := s;
    exit;
  end;
  iLen   := Length(s);
  Result := Copy(s,1,iPos - 1);
  for i := iPos to iLen do begin
    case s[i - 1] of
      ' ' : case s[i] of
             ' ' : ;
            else
              Result := Result + s[i];
            end;
    else
      Result := Result + s[i];
    end;
  end;
end;

function DeleteBlanksFromStr3( const AString : string ) : string;
begin 
  RESULT := AString;
  while Pos( '  ', RESULT ) > 0 do
    RESULT := {SysUtils.}StringReplace( RESULT, '  ', ' ', [ rfReplaceAll ] );
end;

function DeleteBlanksFromStr4( const AString : string ) : string;
var i,j: integer; 
begin 
  SetLength(Result,Length(AString));
  if Length(Result) > 0 then 
    begin 
      i := 1; 
      j := 1;
      while i <= Length(AString) do
        begin 
          Result[j] := AString[i];
          if (AString[i] = #32) then
            begin 
              while (i <= Length(AString)) and (AString[i] = #32) do
                inc(i); 
            end 
          else 
            inc(i); 
          inc(j); 
        end; 
      SetLength(Result,j); 
    end; 
end;

... und hier die Ergebnisse für jeweils 1.000.000 Durchläufe für den Text
"Peter und der Wolf" 1. ca. 3094 ms/1000
2. ca. 2900 ms/1000
3. ca. 1275 ms/1000 *** allerdings nur 10.000 Durchläufe ***
4. ca. 900 ms/1000

Ich sach ja schon nix mehr

cu

Oliver

[taaktaak]

Interessant!
Aber warum bei Variante 3 weniger Durchläufe?
Jetzt fehlt vielleicht noch Detlefs Version mit Zeigern...