LastPos Varianten

[relocate]

Hallo,

beim Swissdelphicenter http://www.swissdelphicenter.ch/torr...de.php?id=1315 habe ich eine Lastpos Variante gefunden die recht flott ist, nachdem ich einige gefunden habe die zwar funktionieren, aber total langsam sind, eventuell mit älteren Prozessoren nicht funktionieren, oder mit PosEx (nativ in D5 nicht vorhanden!) arbeiten. Hier habe ich dann noch eine Variante gefunden http://www.delphi-treff.de/tutorials...elbst-gemacht/ und habe die dann mal spaßeshalber gegeneinander laufen lassen und war erstaunt, dass die Delphivariante schneller war, allerdings auf meinem Dual Core AMD. Auf einem Pentium 4 war es umgekehrt. "Leider" waren auf beiden Rechnern die Funktionen auch mal (annähernd) gleich schnell. Wobei eben die Variante 2 auf dem AMD tendentiell schneller war und die Variante 1 auf dem Pentium 4. Kann das mal jemand nachvollziehen oder hat jemand zufällig eine noch schnellere Variante (sofern das geht)!?

Wer jetzt sagt, das macht nichts aus, die heutigen PC sind eh so leistungsfähig blablabla, doch es macht was aus, wenn 100e oder 1000e Datensätze durchforstet werden müssen.

Gruß Relocate

Das Konsolenprogramm kann auch per Doppelklick gestartet werden, das Readln am Ende hält das Fenster offen.

Delphi-Quellcode:

program over;

{$APPTYPE CONSOLE}
uses windows,sysutils;

function LastPos1(const SubStr: AnsiString; const S: AnsiString): LongInt;
asm
TEST EAX,EAX // EAX auf 0 prüfen (d.h. SubStr = nil)
JE @@noWork // wenn EAX = 0 dann Sprung zu noWork

TEST EDX,EDX // Test ob S = nil
JE @@stringEmpty // bei Erfolg -> Sprung zum Label 'stringEmpty'

PUSH EBX
PUSH ESI
PUSH EDI // Register auf dem Stack sichern Grund: OH
// OH: "In einer asm-Anweisung muß der Inhalt
// der Register EDI, ESI, ESP, EBP und EBX
// erhalten bleiben (dh. vorher auf dem Stack
// speichern)

MOV ESI, EAX // ESI = Sourceindex -> Adresse vom SubStr
MOV EDI, EDX // EDI = Destinationindex -> Adresse von S

MOV ECX,[EDI-4] // Länge von S ins Zählregister

MOV EDX,[ESI-4] // Länge des SubStr in EDX
DEC EDX // Length(SubStr) - 1

JS @@fail // Vorzeichenbedingter Sprung (JumpIfSign)
// d.h. (EDX < 0) -> Sprung zu 'fail'

STD; // SetDirectionFlag -> Stringroutinen von hinten
// abarbeiten

ADD ESI, EDX // Pointer auf das letzte Zeichen vom SubStr
ADD EDI, ECX
DEC EDI // Pointer auf das letzte Zeichen von S

MOV AL, [ESI] // letztes Zeichen des SubStr in AL laden
DEC ESI // Pointer auf das vorletzte Zeichen setzen.

SUB ECX, EDX // Anzahl der Stringdurchläufe
// = Length(s) - Length(substr) + 1

JLE @@fail // Sprung zu 'fail' wenn ECX <= 0

@@loop:
REPNE SCASB // Wdh. solange ungleich (repeat while not equal)
// scan string for byte

JNE @@fail

MOV EBX,ECX { Zähleregister, ESI und EDI sichern, da nun der
Vergleich durchgeführt wird ob die nachfolgenden
Zeichen von SubStr in S vorhanden sind }

PUSH ESI
PUSH EDI

MOV ECX,EDX // Länge des SubStrings in ECX
REPE CMPSB // Solange (ECX > 0) und (Compare string fo byte)
// dh. solange S[i] = SubStr[i]
POP EDI
POP ESI // alten Source- und Destinationpointer vom Stack holen

JE @@found // Und schon haben wir den Index da ECX = 0
// dh. alle Zeichen wurden gefunden

MOV ECX, EBX // ECX wieder auf alte Anzahl setzen und
JMP @@loop // Start bei 'loop'

@@fail:
XOR EAX,EAX // EAX auf 0 setzen
JMP @@exit

@@stringEmpty:
XOR EAX,EAX
JMP @@noWork

@@found:
MOV EAX, EBX // in EBX steht nun der aktuelle Index
INC EAX // um 1 erhöhen, um die Position des 1. Zeichens zu
// bekommen
@@exit:
POP EDI
POP ESI
POP EBX
@@noWork:

CLD; // DirectionFlag löschen
end;

function LastPos2(const SubStr, S: string): Integer;
var
  i: Integer;
  j: Integer;
begin
  Result := 0;    // noch nicht gefunden
  i := Length(S);
  j := Length(SubStr);

  while (i >= 1) and (j >= 1) do
  begin
    if S[i] = SubStr[j] then  // passt das Zeichen?
    begin
      // nächstes Zeichen untersuchen
      Dec(j);
    end
    else
    begin
      // wieder mit letztem SubStr-Zeichen anfangen
      i := i + Length(SubStr) - j;
      j := Length(SubStr);
    end;

    if j = 0 then
    begin
      Result := i;  // gefunden
    end;

    Dec(i); // nächstes Zeichen
  end;
end;

var
  S, S2: String;
  C1,C2: Cardinal;
  i,t: Integer;

begin
  S :=  'Dies ist nur ein sinnloser Testtext, der zeigen soll wo sich das letzte ist befindet.';
  S2 := 'ist';
  C1 := GetTickCount;
  for i := 0 to 999999 do begin
    t := LastPos1(S2,S);
  end;
  C2 := GetTickCount;
  WriteLn(C2 - C1);
  WriteLn('Pos:'+IntToStr(t));

  S :=  'Dies ist nur ein sinnloser Testtext, der zeigen soll wo sich das letzte ist befindet.';
  S2 := 'ist';
  C1 := GetTickCount;
  for i := 0 to 999999 do begin
    t := LastPos2(S2,S);
  end;
  C2 := GetTickCount;
  WriteLn(C2 - C1);
  WriteLn('Pos:'+IntToStr(t));

  ReadLn;
end.

[relocate]

Hat sich im Prinzip erledigt.
Man sollte mit längeren Strings testen.
Dann ist die Assembler Variante wie erwartet schneller.

[Bjoerk]

Die asm Variante ist aber auch nicht gerade der Hit.

Probier' eventuell mal meine:

Delphi-Quellcode:

function LastPos(const SubStr, S: string): integer;
var
  I, J, K: integer;
begin
  Result := 0;
  I := Length(S);
  K := Length(SubStr);
  if (K = 0) or (K > I) then
    Exit;
  while (Result = 0) and (I >= K) do
  begin
    J := K;
    if S[I] = SubStr[J] then
    begin
      while (J > 1) and (S[I + J - K - 1] = SubStr[J - 1]) do
        Dec(J);
      if J = 1 then
        Result := I - K + 1;
    end;
    Dec(I);
  end;
end;

Gruß
Thomas

[Amateurprofi]

Oder noch mal deutlich schneller so:
(Nicht wirklich optimiert und nur flüchtig überprüft)

Delphi-Quellcode:

FUNCTION LastPosA(const SearchFor,SearchIn:AnsiString):integer;
asm
               test     eax,eax
               je       @Ret
               test     edx,edx
               je       @ReturnZero
               cmp      eax,edx
               je       @ReturnOne              // Strings identisch
               push     ebp
               push     ebx
               push     edi
               push     esi
               mov      ecx,[eax-4]             // Length(SearchFor)
               mov      ebp,[edx-4]             // Length(SearchIn)
               sub      ebp,ecx
               js       @Fail                   // SearchFor länger als Searchin
               mov      bl,[eax]                // erstes Zeichen aus SearchFor
               sub      ecx,1
               je       @CharLoop
               lea      eax,[eax+ecx+1]         // hinter SearchFor
               neg      ecx
@OuterLoop:    cmp      [edx+ebp],bl
               je       @FirstFound
@NextOuter:    sub      ebp,1
               jns      @OuterLoop
               jmp      @Fail
@FirstFound:   lea      edi,[edx+ebp+1]
               sub      edi,ecx
               mov      esi,ecx
@InnerLoop:    mov      bh,[eax+esi]
               cmp      bh,[edi+esi]
               jne      @NextOuter
               add      esi,1
               jne      @InnerLoop
               jmp      @Found
@CharLoop:     cmp      [edx+ebp],bl
               je       @Found
               sub      ebp,1
               jns      @CharLoop
@Fail:         xor      eax,eax
               jmp      @End
@ReturnZero:   xor      eax,eax
               jmp      @Ret
@ReturnOne:    mov      eax,1
               jmp      @Ret
@Found:        lea      eax,[ebp+1]
@End:          pop      esi
               pop      edi
               pop      ebx
               pop      ebp
@Ret:
end;

[relocate]

@Bjoerk

Ich kann zwar etwas Assembler, aber um so eine Funktion zu entwickeln/verbessern reicht es kaum.
Die Delphi Variante von dir ist auf meinem AMD aber langsamer als die Assembler Variante, auf einem Intelprozessor (aber kein P4) ist sie schneller.

@Amateurprofi
Diese Variante ist wirklich fix, die schnellste auf meinem Intel und AMD Rechner.

Vielen Dank!

Es ist echt erstaunlich manchmal.