AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Funktion optimieren

Ein Thema von Pseudemys Nelsoni · begonnen am 30. Aug 2005 · letzter Beitrag vom 6. Sep 2005
Antwort Antwort
Seite 1 von 2  1 2      
Benutzerbild von Pseudemys Nelsoni
Pseudemys Nelsoni

Registriert seit: 24. Dez 2002
Ort: Hamburg-Harburg
3.551 Beiträge
 
#1

Funktion optimieren

  Alt 30. Aug 2005, 22:14
Moin,

ich habe folgende funktion(eine von vielen) geschrieben:

Delphi-Quellcode:
function AddTok(const S, T: string; const C: Char; CS: Boolean = False): string;
var
  SLen, SIdx, ResIdx, TokStart, TokLen: Integer;
  TokExists: Boolean;
  CurrentTok: string;
begin
  if T <> 'then
  begin
    SLen := Length(S);
    SetLength(Result, SLen+Length(T)+1);
    ResIdx := 0;
    TokExists := False;
    TokStart := 0;
    TokLen := 0;
    for SIdx := 1 to SLen do
    begin
      if (S[SIdx] <> C) or ((ResIdx > 0) and (Result[ResIdx] <> C)) then
      begin
        Inc(ResIdx);
        Result[ResIdx] := S[SIdx];
      end;
      if S[SIdx] <> C then
      begin
        if TokStart = 0 then
          TokStart := SIdx;
        Inc(TokLen);
      end;
      if ((S[SIdx] = C) or (SIdx = SLen)) and (TokStart > 0) then
      begin
        CurrentTok := Copy(S, TokStart, TokLen);
        if not TokExists then
        TokExists := ((CS) and (lstrcmp(PChar(CurrentTok), PChar(T)) = 0)) or
          ((not CS) and (lstrcmpi(PChar(CurrentTok), PChar(T)) = 0));
        TokStart := 0;
        TokLen := 0;
      end;
    end;
    if (ResIdx > 0) and (Result[ResIdx] = C) then
      SetLength(Result, ResIdx-1)
    else SetLength(Result, ResIdx);
    if not TokExists then
      if Result <> 'then
        Result := Result + C + T
      else Result := Result + T;
  end else
    Result := S;
end;
Sie tut nichts anderes, also ein neues wort(T) ans Ende anzufügen, SOFERN es nicht bereits vorkommt (S). Die Wörter selbst sind durch einen Seperator getrennt (C). CS gibt an ob ein vorhandenes Wort mit dem hinzuzufügenden case sensitive sein muss. Am Ende muss der String (im Erfolgsfall) auch sauber wieder zurückgegeben werden, d.h wenn S am Anfang so aussieht:

Zitat:
....Wort1..Wort2.........Wort3....Wort4..
und ich "Wort5" anfügen will, muss es am Ende so aussehen:

Zitat:
Wort1.Wort2.Wort3.Wort4.Wort5
Die Funktion (s.o) funktioniert.... nur kann man sie noch schneller machen?
Mario
  Mit Zitat antworten Zitat
Benutzerbild von Dani
Dani

Registriert seit: 19. Jan 2003
732 Beiträge
 
Turbo Delphi für Win32
 
#2

Re: Funktion optimieren

  Alt 30. Aug 2005, 23:43
Delphi-Quellcode:
function AppendStringIfUnique(StrToChange: String; StrToAppend: String;
  SepChar: Char): String;
begin
 Result := StrToChange;
 StrToAppend := StrToAppend + SepChar;
 If pos(SepChar + StrToAppend, StrToChange) = 0 then
  begin
   If Length(Result) = 0 then Result := SepChar;
   Result := Result + StrToAppend;
  end;
end;
ist auf meinem Rechner ca. um den Faktor 10 schneller, hat aber den Nachteil, dass der Zielstring mit einem Seperator beginnen muss. Falls das nichts ist, habe ich hier noch einen Nachbau deiner Funktion, der zwar mehr Speicher verbraucht, aber um ca. 20% schneller ist (trotzdem noch sehr langsam).

Delphi-Quellcode:
function AppendStringIfUnique(StrToChange: String; StrToAppend: String;
 SepChar: Char; WatchCase: Boolean = false): String;
var iNextSepIdx: Integer;
    sWord: String;
    sSrcStr, sDestStr: String;
    iSrcStrLength, iDestStrLength: Integer;
begin
 Result := StrToChange;
 If (Length(StrToChange)=0) or (Length(StrToAppend)=0) then
  begin
   Result := StrToAppend;
  end
   else begin
    If (not WatchCase) then
     begin
      //Speicher opfern, dafür den Vergleich bei Nichtbeachtung von
      //Groß/Kleinschreibung beschleunigen
      sSrcStr := AnsiLowercase(StrToChange);
      sDestStr := AnsiLowercase(StrToAppend);
     end
      else begin
       sSrcStr := StrToChange;
       sDestStr := StrToAppend;
      end;

    iSrcStrLength := Length(sSrcStr);
    iDestStrLength := Length(sDestStr);

    iNextSepIdx := 1;
    SetLength(sWord, 0);
    //Prüfen, ob das Wort schon enthalten ist, wenn ja die Funktion beenden

    while (iNextSepIdx + iDestStrLength -1 <= iSrcStrLength) do
     begin
     //Nächstes Wort besorgen und prüfen
      while (sSrcStr[iNextSepIdx] <> SepChar)
       and (iNextSepIdx < iSrcStrLength) do inc(iNextSepIdx);
      inc(iNextSepIdx);
      sWord := copy(sSrcStr, iNextSepIdx, iDestStrLength);
      If (sWord = sDestStr) then exit;
     end;

    //Wenn wir hier ankommen ist das Wort nicht im Quellstring enthalten
    Result := Result + SepChar + StrToAppend;
   end;
end;
[edit="Dani"]Delphi-Tags gesetzt[/edit]
Dani H.
At Least I Can Say I Tried
  Mit Zitat antworten Zitat
Benutzerbild von BrunoT
BrunoT

Registriert seit: 23. Jan 2003
Ort: Sandbeiendorf
360 Beiträge
 
Delphi 8 Professional
 
#3

Re: Funktion optimieren

  Alt 31. Aug 2005, 13:56
Hi Pseudemys Nelsoni,

ich habe das mal mit Stringlist versucht.

Delphi-Quellcode:
function AddTok(const S, T: string; const C: Char; CS: Boolean = False): string;
var
  l: Tstringlist;
begin
  l := Tstringlist.Create;
  l.CaseSensitive := CS;
  l.Delimiter := c;
  l.DelimitedText := S;
  if l.IndexOf(T) < 0 then //habe ich heute neu dazu gelernt
    l.Add(T);
  result := l.DelimitedText;
   l.Free;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  memo1.Text := AddTok('wort1;wort2;wort3;wort4', 'wort5', ';', True);
end;

eventuell muss man ja die Stringlist nicht immer neu erzeugen.

mfg

BtunoT
Holger

EDV- Ende der Vernunft
Meine Calcedit-Kompo
  Mit Zitat antworten Zitat
alzaimar
(Moderator)

Registriert seit: 6. Mai 2005
Ort: Berlin
4.956 Beiträge
 
Delphi 2007 Enterprise
 
#4

Re: Funktion optimieren

  Alt 31. Aug 2005, 14:24
Zitat von Dani:
[delphi]
... hat aber den Nachteil, dass der Zielstring mit einem Seperator beginnen muss....
Und? Häng' doch einfach den Separator temporär an die StrToAppend?

Alternativ kann man auch von Separator zu Separator hopsen und immer ab dieser Pos [+1] schauen, ob der StrToAppend vorkommt. Mit einem KMP verknüpft ist das denn auch fix genug, denke ich.
"Wenn ist das Nunstruck git und Slotermeyer? Ja! Beiherhund das Oder die Flipperwaldt gersput!"
(Monty Python "Joke Warefare")
  Mit Zitat antworten Zitat
Benutzerbild von Dani
Dani

Registriert seit: 19. Jan 2003
732 Beiträge
 
Turbo Delphi für Win32
 
#5

Re: Funktion optimieren

  Alt 31. Aug 2005, 14:27
Selbst wenn man nur mit einer Instanz von TStringlist arbeitet, ist das der langsamste Ansatz. DelimitedText wird bei jedem Lesezugriff dynamisch aus TStringlist.Lines erzeugt und bei jedem Schreibzugriff wird TStringlist.Lines neu aufgebaut. Pseudemys Nelsonis Quellcode braucht für 10000 Test-Durchläufe ca. 34 Sekunden, der TStringlist Ansatz rechnet jetzt seit ca. 4 5 6 Minuten
Dani H.
At Least I Can Say I Tried
  Mit Zitat antworten Zitat
Benutzerbild von BrunoT
BrunoT

Registriert seit: 23. Jan 2003
Ort: Sandbeiendorf
360 Beiträge
 
Delphi 8 Professional
 
#6

Re: Funktion optimieren

  Alt 31. Aug 2005, 14:38
Hätte nicht gedacht, dass das so viel langsamer ist.

mfg

BrunoT
Holger

EDV- Ende der Vernunft
Meine Calcedit-Kompo
  Mit Zitat antworten Zitat
Benutzerbild von SirThornberry
SirThornberry
(Moderator)

Registriert seit: 23. Sep 2003
Ort: Bockwen
12.235 Beiträge
 
Delphi 2006 Professional
 
#7

Re: Funktion optimieren

  Alt 31. Aug 2005, 15:32
So ich hab auch noch bischen rumprobiert

AppendStringIfUnique = 422 ms
AddTok = 578 ms
AddIt2(von mir) 219 ms
AddIt3(von mir) 266 ms

[Edit]
Fehler in Funktion wurde behoben und Zeiten korrigiert
AddIt2 entfernt überflüssige Trennzeischen nicht
AddIt3 entfernt überflüssige Trennzeischen
[/Edit]
Allerdings weiß ich nicht ganz ob unter irgendwelchen Umständen meine Funktion fehlerhaft zurückgibt, wäre also nicht schlecht wenn mal jemand bischen testen könnte.
Delphi-Quellcode:
function AddIt2(const S, T: string; const C: Char; CS: Boolean = False): String;
  function IsSame(Str1: PChar; Str2: PChar; ALen: Integer): Boolean;
  var LPos: Integer;
  begin
    result := True;
    LPos := 0;
    while result and (LPos < ALen) do
    begin
      if Str1^ <> Str2^ then
        result := False;
      inc(Str1);
      inc(Str2);
      inc(LPos);
    end;
  end;
var LPos1, LPos2, LSourceLen, LTLen: Integer;
    LFound: Boolean;
    LS, LT: String;
    LSP, LTP: PString;
begin
  LSourceLen := Length(S);
  if Length(S) = 0 then
    result := T
  else begin
    if CS then
    begin
      LSP := @S;
      LTP := @T;
    end else begin
      LS := AnsiLowerCase(S);
      LT := AnsiLowerCase(T);
      LSP := @LS;
      LTP := @LT;
    end;
    LFound := False;
    LTLen := Length(T);
    LPos1 := 1;
    LPos2 := 1;
    while (LPos2 <= LSourceLen) and not(LFound) do
    begin
      if (LSP^[LPos2] = C) then
      begin
        LFound := (LPos2 - LPos1 = LTLen) and IsSame(@LSP^[LPos1], PChar(LTP^), LPos2 - LPos1);
        LPos1 := LPos2 + 1;
      end else if (LPos2 = LSourceLen) then
      begin
        LFound := (LPos2 - LPos1 + 1 = LTLen) and IsSame(@LSP^[LPos1], PChar(LTP^), LPos2 - LPos1 + 1);
        LPos1 := LPos2 + 1;
      end;
      inc(LPos2);
    end;

    if LFound then
      result := S
    else
    begin
      if S[LSourceLen] = C then
        result := S + T
      else
        result := S + C + T;
    end;
  end;
end;
Delphi-Quellcode:
function AddIt3(const S, T: string; const C: Char; CS: Boolean = False): String;
  function IsSame(Str1: PChar; Str2: PChar; ALen: Integer): Boolean;
  var LPos: Integer;
  begin
    result := True;
    LPos := 0;
    while result and (LPos < ALen) do
    begin
      if Str1^ <> Str2^ then
        result := False;
      inc(Str1);
      inc(Str2);
      inc(LPos);
    end;
  end;
var LPos1, LPos2, LSourceLen, LTLen: Integer;
    LFound: Boolean;
    LS, LT: String;
    LSP, LTP: PString;
begin
  LSourceLen := Length(S);
  if LSourceLen = 0 then
    result := T
  else begin
    if CS then
    begin
      LSP := @S;
      LTP := @T;
    end else begin
      LS := AnsiLowerCase(S);
      LT := AnsiLowerCase(T);
      LSP := @LS;
      LTP := @LT;
    end;
    LFound := False;
    LTLen := Length(T);
    LPos1 := 1;
    LPos2 := 1;
    while (LPos2 <= LSourceLen) and not(LFound) do
    begin
      if (LSP^[LPos2] = C) then
      begin
        LFound := (LPos2 - LPos1 = LTLen) and IsSame(@LSP^[LPos1], PChar(LTP^), LPos2 - LPos1);
        LPos1 := LPos2 + 1;
      end else if (LPos2 = LSourceLen) then
      begin
        LFound := (LPos2 - LPos1 + 1 = LTLen) and IsSame(@LSP^[LPos1], PChar(LTP^), LPos2 - LPos1 + 1);
        LPos1 := LPos2 + 1;
      end;
      inc(LPos2);
    end;

    if LFound then
      result := S
    else
    begin
      if S[LSourceLen] = C then
        result := S + T
      else
        result := S + C + T;
    end;

    //überflissige Zeischen rauskicken
    LPos2 := 1;
    LSourceLen := Length(result);
    for LPos1 := 1 to LSourceLen do
    begin
      if (result[LPos1] <> C) or (LPos1 <= 1) or (result[LPos1 - 1] <> C) then
      begin
        result[LPos2] := result[LPos1];
        inc(LPos2);
      end;
    end;
    if result[LPos2 - 1] = C then
      dec(LPos2);
    SetLength(result, LPos2 - 1);
  end;
end;
@Dani: Die Funktion ist um den Faktor 10 Schneller? Ich kann mir nicht vorstellen das So große unterschiede auftreten das deine Funktion gleich 10 mal schneller ist. Außerdem hast du bei dieser Variante das Casesensitive vergessen. Wenn ich bei mir als Parameter das Casesensitive auf False setze komme ich dann auch nur noch auf 78 ms

@Pseudemys Nelsoni: Bist du dir sicher das du die Trennzeischen herausfiltern willst wenn ein Leerstring dazwischen ist? Schließlich ist ein Leerstring nicht unbedingt etwas ungültiges.
Jens
Mit Source ist es wie mit Kunst - Hauptsache der Künstler versteht's
  Mit Zitat antworten Zitat
Benutzerbild von Dani
Dani

Registriert seit: 19. Jan 2003
732 Beiträge
 
Turbo Delphi für Win32
 
#8

Re: Funktion optimieren

  Alt 31. Aug 2005, 18:56
Zitat von Sir Thornberry:
@Dani: Die Funktion ist um den Faktor 10 Schneller? Ich kann mir nicht vorstellen das So große unterschiede auftreten das deine Funktion gleich 10 mal schneller ist. Außerdem hast du bei dieser Variante das Casesensitive vergessen. Wenn ich bei mir als Parameter das Casesensitive auf False setze komme ich dann auch nur noch auf 78 ms
Hm, das könnte an meinem ungenauen Messverfahren liegen.
Delphi-Quellcode:
procedure TForm1.Button3Click(Sender: TObject);
var strBase, s, output: String;
    Idx: Integer;
    TimeStart, TimeEnd, TimeDiff: TDateTime;
begin
 strBase := 'Hurra';
 output := '';
 TimeStart := now;
 for Idx := 0 to 10000 do
  begin
   s := strBase + IntToStr(Idx);
   output := AppendStringIfUnique(output, s, ';');
  end;
  TimeEnd := now;
  TimeDiff := TimeEnd - TimeStart;

  Label1.Caption := 'time: ' + FormatDateTime('ss:zzz', TimeDiff);
  Memo1.Text := output;
end;
Pseudemys Nelsonis Code braucht auf meinem System (Athlon XP 2800+) dafür ca. 34 Sekunden, meiner 3.
Dani H.
At Least I Can Say I Tried
  Mit Zitat antworten Zitat
Benutzerbild von SirThornberry
SirThornberry
(Moderator)

Registriert seit: 23. Sep 2003
Ort: Bockwen
12.235 Beiträge
 
Delphi 2006 Professional
 
#9

Re: Funktion optimieren

  Alt 31. Aug 2005, 19:14
bei deinem Beispiel ist output aber auch leer so das die funktion so gut wie nix macht, in aller regel wird die funktion wohl nicht mit leerstrings aufgerufen. Aber so könnt ich mir den krassen Unterschied dann doch vorstellen.
Jens
Mit Source ist es wie mit Kunst - Hauptsache der Künstler versteht's
  Mit Zitat antworten Zitat
alzaimar
(Moderator)

Registriert seit: 6. Mai 2005
Ort: Berlin
4.956 Beiträge
 
Delphi 2007 Enterprise
 
#10

Re: Funktion optimieren

  Alt 31. Aug 2005, 22:38
Oh, da stimmt Einiges nicht;
1. Die Funktionen funktionieren alle nicht, weil sie auch für den Fall 'Wort111;Wort222' fälschlicherweise das 'Wort' finden. Das ist aber gar nicht in der Liste.

2. Ausserdem sind die AddK, Addit2 und Addit3 vom Aufwand O(n*m), wobei n die Länge der Liste und m die Länge des Wortes bezeichnet.

3. Abschließend ist das Testverfahren keins.

Hier ein Verfahren mit linearem Aufwand:
Delphi-Quellcode:
Function AddIfUnique (Const aList, aToken : String; aSep : Char) : String;
Var
  l,n : Integer;

  Function TokenExists : Boolean;
  Var
    i,j : Integer;

  Begin
    i := 0;
    j := 1;

    For i:=1 to l Do Begin
      If aList[i] = aSep Then // Separator gefunden? Vergleich initialisieren
        j := 1
      Else if (j>0) Then // Wir vergleichen das j.te Zeichen
        If aList[i] = aToken[j] Then // das passt....
          If (j = n) Then // wurde das ganze Wort verglichen ?
            If (i = l) Or (aList[i+1] = aSep) Then Begin // und danach kommt
              Result := True; // ein Separator? Dann sind wir
              Exit; // fertig.
              End
            Else // Ansonsten Vergleich bis zum
              j := 0 // nächsten Separator ausschalten
          Else // Vergleich ok, also nächsten
           Inc (j) // Buchstaben des Wortes anvisieren.
        Else // Vergleich bis zum nächsten
          j := 0; // Separator ausschalten
      End;
    Result := False
  End;

Begin
  l := Length (aList);
  n := Length (aToken);
  If TokenExists Then
    Result := aList
  Else If l = 0 Then // Beim ersten Mal nur den Token liefern
    Result := aToken
  Else Begin
    Result := aList; // sonst ';'Token anhängen
    SetLength (Result, l + n + 1);
    Result [l+1] := aSep;
    Move (aToken[1], Result [l+2], n);
    End
End;
Testverfahren:
Eine Wortliste bestehend aus 4000 Wörtern WortX (X=1...4000), durch ';' getrennt, wird erstellt.

a) 4000x wird "Wort[i]" eingefügt (schlägt fehl, da schon in der Liste)
b) 4000x wird "Wort[i]*" eingefügt. (klappt immer)

AddIfUnique a) : 661
AddIfUnique b) : 3645

AddIt3 a) : 6059
AddIt3 b) : 10485

Da ist bestimmt noch Optimierungspotential drin.
"Wenn ist das Nunstruck git und Slotermeyer? Ja! Beiherhund das Oder die Flipperwaldt gersput!"
(Monty Python "Joke Warefare")
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 1 von 2  1 2      


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 10:36 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz