Boyer Moore Algorithmus

[Horst_]

Hallo,

ich habe weiter oben die Vorbereitungsphase in einen Record ausgelagert, weil mir das sehr unsinnig erschien, das ständig neu zu erstellen.
Ich habe Ginko Version 4 mal etwas umgestellt.
Wobei Count seiner Version entspricht, Count_II meiner vorherigen, bei der der vorbereitete Record für das Suchwort BMH mit Offset wiederholt aufruft, falls man eine Liste aufbauen oder etwas sofort verarbeiten will.
Erstaunlicherweise ist Version Count_II wesentlich langsamer.
50 mal in 100000 Zeilen nach Taxi suchen.

Code:

BMH Count II:  100000 in 424ms
BMH Count:     100000 in 353ms
Std Pos Count: 100000 in 343ms

Wieso da 20% verloren gehen, wobei der große Unterschied nur in einem Aufruf pro Fund und Bestimmung der Länge des Suchtextes besteht, alles Kleckerkram für 5 Mio Aufrufe. 58 CPU-Takte mehr.
PosEX ist aber hier, bei solch speziellen Wörtern ( alle sehr unterschiedlich, um möglichst kompakt alle Buchstaben des Alphabetes unterzubringen ), sehr schnell.
Suche nach " im" also mit Leerzeichen vorne
BMH Count II: 100000 in 573ms
BMH Count: 100000 in 450ms
Std Pos Count: 100000 in 1012ms

Falls es aber, wie im ersten Posting angedeutet, um das Durchsuchen von Dateien geht ist eher die Festplatte die herausforderung.

Gruß Horst

[Furtbichler]

Ich verstehe nicht, wieso Du nicht einfach den BM-Suchalgorithmus in einen Count-Algorithmus umwandelst. Nimm das 'fehlende exit' heraus und ersetze das durch ein 'inc(Result)', wobei 'Result' mit 0 initialisiert wird. Dann kannst Du dir diese Schleife auch sparen, wo der SearchBM immer aufgerufen wird.

Und dann kannst Du dir dein Auslagern des Preprocess sparen. Praktikabel ist es i.A. eh nicht, denn wer sucht schon immer nach dem gleichen Text. Und die paar Nanosekunden sind auch egal. Meistens jedenfalls.

[Horst_]

Hallo,

Hallo,

Zitat von BUG:

Zitat von Gausi:

Boyer-Moore (oder andere Verfahren jenseits des naiven) sind deshalb so schnell, weil sie vor der eigentlichen Suche eine Vorbereitungsphase haben. Bei Boyer-Moore läuft diese Vorbereitungsphase auf Grundlage des Suchstrings und heißt hier PreProcess_BMH_BC.

Imho wäre es schön, die Suche in ein Objekt zu verpacken. Damit könnte man den Status der Suche (uninitialisiert, initialisiert, nach letztem Fund, usw.) gut verwalten.

Zitat von Horst_:

ich habe weiter oben die Vorbereitungsphase in einen Record ausgelagert, weil mir das sehr unsinnig erschien, das ständig neu zu erstellen...
Wobei Count seiner Version entspricht, Count_II meiner vorherigen, bei der der vorbereitete Record für das Suchwort BMH mit Offset wiederholt aufruft, falls man eine Liste aufbauen oder etwas sofort verarbeiten will

Also Count, welches nur einmal aufgerufen wird, existiert immer noch und ist ja auch schneller.
Ich habe auch schon mal vor x Jahren einen Ansatz gehabt, viele Dateien nach vielen Wörtern zu durchsuchen.Dabei wurden, wie im ersten Ansatz von Ginko, Blöcke von 4 Kb eingelesen mit Platz für das längste Wort davor, damit Blockread immer auf die selbe Stelle in selber Größe erfolgte.Lange Rede, keinen Sinn. Dort brauchte man eine Struktur, die den Suchstring und dessen letzte Position speicherte.

Gruß Horst

[CCRDude]

Zitat von Horst_:

viele Dateien nach vielen Wörtern zu durchsuchen.

Da ist der BM/BMH aber der falsche Ansatz, da eignet sich etwa der AC deutlich besser, da er dank eines Suchbaumes mit einem Durchgang und höchstens einem Vergleich pro Zeichen auskommt (den Baum zu bauen ist natürlich ggfls. teurer als die einfache/doppelte Skipliste des BM/BMH).

[Ginko]

Zitat von Furtbichler:

Ich verstehe nicht, wieso Du nicht einfach den BM-Suchalgorithmus in einen Count-Algorithmus umwandelst. Nimm das 'fehlende exit' heraus und ersetze das durch ein 'inc(Result)', wobei 'Result' mit 0 initialisiert wird. Dann kannst Du dir diese Schleife auch sparen, wo der SearchBM immer aufgerufen wird.

Das habe ich bereits gemacht im Anhang 4, Horst_ hat es noch etwas angepasst und eine überflüssige Varible (von mir) rausgeschmissen.

Delphi-Quellcode:

  function  Search_BMH_Count(const SuchText,SuchWort:string):integer;
  var
     n, k, j: integer;
    Large: integer;
  begin
    BC := PreProcess_BMH_BC(SuchWort);
    with BC do
    begin
      n := Length(SuchText);
      Large := BMH_le + n + 1;

      BMH_BC[BMH_Suchwort[BMH_le]] := Large;

      k := BMH_le;
      Result := 0;

      while k <= n do
      begin
        //fast loop
        repeat
          j := BMH_BC[SuchText[k]];
          k := k + j;
        until (j = Large) or (k >= n);

        //Muster/letztes Zeichen im Suchwort nicht gefunden
        if j <> Large then
          break;
        // Letzer Buchstabe des Suchwortes im Suchtext gefunden
        j := 1;
        k := k - Large;
        // die Buchstaben davor auf Gleichheit pruefen slow loop
        while (j < BMH_le) and (BMH_Suchwort[BMH_le - j] = SuchText[k - j]) do
          Inc(j);
        if j = BMH_le then
        begin
          // Muster gefunden
          Inc(Result);
          k := k+1;
        end
        else
        begin
          // Muster verschieben
          if SuchText[k] = BMH_Suchwort[BMH_le] then
            k := k + BMH_le //BC_last;
          else
            k := k + BMH_BC[SuchText[k]];
        end;
      end;
    end;
  end;

[Amateurprofi]

Hab ich mal, so wie in #12 von Horst vorgegeben getestet.
Also 'Point Line Square Point Point Triangle Line PointPoint Line Square PointPoint>>'
in einen String mit 1G Zeichen gefüllt, und dann gezählt, wie oft bestimmte Texte darin vorkommen.

"Straight forward, ohne BM etc."

Und das kam raus:

Code:

"Point"      :  88,607,594 Mal gefunden, Zeit :  920 ms
"Line"       :  37,974,684 Mal gefunden, Zeit :  905 ms
"Square"     :  25,316,456 Mal gefunden, Zeit :  967 ms
"Triangle"   :  12,658,228 Mal gefunden, Zeit :  874 ms
"Point Lin"  :  25,316,456 Mal gefunden, Zeit : 1201 ms
"P"          :  88,607,594 Mal gefunden, Zeit :  905 ms
"L"          :  37,974,684 Mal gefunden, Zeit : 1045 ms
"S"          :  25,316,456 Mal gefunden, Zeit :  936 ms
"T"          :  12,658,228 Mal gefunden, Zeit :  842 ms
"i"          : 139,240,506 Mal gefunden, Zeit :  905 ms

Delphi-Quellcode:

PROCEDURE TMain.Test;
const
   T='Point Line Square Point Point Triangle Line PointPoint Line Square PointPoint>>';
   MaxLen=1000000000;
   ST:Array[0..9] of String=('Point','Line','Square','Triangle','Point Lin',
                             'P','L','S','T','i');
var S,SF,SI:string;  I,LS,N,len:integer; PS,PSI:PChar; Tick,Ticks:Cardinal;
begin
   S:=T;
   PS:=PChar(S);
   LS:=Length(S);
   SetLength(SI,MaxLen);
   PSI:=PChar(SI);
   for I:=0 to MaxLen div LS do begin
      Move(PS^,PSI^,LS*SizeOf(Char));
      Inc(PSI,LS);
   end;
   N:=MaxLen Mod LS;
   if N>0 then Move(PS^,PSI^,N*SizeOf(char));
   reResults.Clear;
   for I:=0 to High(ST) do begin
      SF:=ST[i];
      Tick:=GetTickCount;
      N:=CountStr(SF,SI);
      Ticks:=GetTickCount-Tick;
      reResults.Lines.Add('"'+SF+'" : '+IntToStr(N)+' Mal gefunden, Zeit : '+
                          IntToStr(Ticks)+' ms');
   end;
end;

32 Bit Version

Delphi-Quellcode:

FUNCTION CountStr(const SearchFor,SearchIn:string):Integer;
const sz=SizeOf(Char);
asm
               test     eax,eax
               je       @Ret                 // SearchFor leer
               mov      ecx,[eax-4]          // Length(SearchFor)
               push     ebp
               push     ebx
               push     edi
               push     esi
               push     0                    // Anzahl Zeichen
               test     edx,edx
               je       @End                 // SearchIn leer
               mov      ebp,ecx              // Length(SearchFor)
               mov      ebx,[edx-4]          // Length(SearchIn)
               sub      ebx,ecx              // Length(SearchIn)-Length(SearchFor)
               jc       @End                 // SearchFor länger als SearchIn
               lea      esi,[eax+ecx*sz]     // Hinter SearchFor
               lea      edi,[edx+ecx*sz]     // Hinter SearchIn[Length(SearchFor)]
               neg      ecx
               jmp      @Entry
@NextStart:    sub      ebx,1
               jc       @End                 // Alles durchsucht
               add      edi,sz               // Nächste Startposition
@Entry:        mov      edx,ecx              // Count
@CharLoop:     mov      ax,[esi+edx*sz]      // SearchFor[edx]
               cmp      ax,[edi+edx*sz]      // SearchIn[edx]
               jne      @NextStart
@NextChar:     add      edx,1                // Count
               jl       @CharLoop            // nächstes Zeichen prüfen
               add      [esp],1              // Anzahl Fundstellen
               lea      edi,[edi+ebp*sz]     // Um Length(SearchFor) weiter
               sub      ebx,ebp              // Anzahl verfügbarer Zeichen
               jnc      @Entry               // Noch Zeichen da
@End:          pop      eax                  // Anzahl Zeichen
               pop      esi
               pop      edi
               pop      ebx
               pop      ebp
@Ret:
end;

64 Bit-Version

Delphi-Quellcode:

FUNCTION CountStr(const SearchFor,SearchIn:string):Integer;
const sz=SizeOf(Char);
asm
               xor      rax,rax              // Anzahl Zeichen
               test     rcx,rcx
               je       @Ret                 // SearchFor leer
               xor      r8,r8
               mov      r8d,[rcx-4]          // Length(SearchFor)
@Work:         test     rdx,rdx
               je       @Ret                 // SearchIn leer
               mov      r9,r8                // Length(SearchFor)
               xor      r10,r10
               mov      r10d,[rdx-4]         // Length(SearchIn)
               sub      r10,r8               // Length(SearchIn)-Length(SearchFor)
               jc       @Ret                 // SearchFor länger als SearchIn
               push     r12
               lea      r11,[rcx+r8*sz]      // Hinter SearchFor
               lea      r12,[rdx+r8*sz]      // Hinter SearchIn[Length(SearchFor)]
               neg      r8
               jmp      @Entry
@NextStart:    sub      r10,1
               jc       @End                 // Alles durchsucht
               add      r12,sz                // Nächste Startposition
@Entry:        mov      rdx,r8               // Count
@CharLoop:     mov      cx,[r11+rdx*sz]      // SearchFor[rdx]
               cmp      cx,[r12+rdx*sz]      // SearchIn[rdx]
               jne      @NextStart
@NextChar:     add      rdx,1                // Count
               jl       @CharLoop            // nächstes Zeichen prüfen
               add      rax,1                // Anzahl Fundstellen
               lea      r12,[r12+r9*sz]      // Um Length(SearchFor) weiter
               sub      r10,r9               // Anzahl verfügbarer Zeichen
               jnc      @Entry               // Noch Zeichen da
@End:          pop      r12
@Ret:
end;

[Furtbichler]

Deine ASM-Routine liefern bei mir imm nur 0, wird aber an dem alten Delphi liegen (BDS 2006)

[Ginko]

Hmm bei mir in Lazarus auch 0 Funde, aber ich musste ein paar Sachen ändern, denn der Lazarus Inline Assembler hat so seine Eigenarten. Der übernimmt einiges nicht, was in Delphi klappt...

[Ginko]

Bei der Version des BMH mit dem Record tritt bei mir noch ein merkwürdiger Fehler auf. Gibt man als Suchwort "Franz jagt im komplett verwahrlosten Taxi quer durch Bayer" findet er nur die Hälfte der Ergebnisse. Der Ursprüngliche BMH ohne Record findet alle. Aber der Fehler war bis jetzt nur bei dieser speziellen Wortfolge...

[Edit]: Im Anhang ist nochmal der Test, der ohne Fehler läuft. Außerdem habe ich noch eine für Lazarus angepasste Version von hier http://www.swissdelphicenter.ch/de/showcode.php?id=277 dieser Suchmethode hinzugefügt. Bei längeren Wörtern ist die etwas schneller als der BMH (aber auch nicht immer...), ansonsten etwas langsamer (und bei einem Buchstaben am schnellsten von den Dreien). Weis jemand was das für eine Methode ist ? Ist das auch eine Boyer Moore Variante?

[Amateurprofi]

Zitat von Furtbichler:

Deine ASM-Routine liefern bei mir imm nur 0, wird aber an dem alten Delphi liegen (BDS 2006)

Da waren Strings noch 1 Byte per Char.
Ab Delphi 9 (soweit ich weiß) 2 Bytes per Char.

Die Größe der Chars ist in der Funktion im Prinzip schon durch die Konstante sz (Size) berücksichtigt, aber ich hatte nicht daran gedacht, das auch bei dem Zeichenvergleich zu berücksichtigen. Dort muss ax in al geändert werden.

Die nachstehende Funktion sollte mit den 1 Byte Chars funktionieren. (konnte ich aber nicht testen)
Für 2 Byte Chars muss das {$DEFINE ANSI} auskommentiert werden.
Weiß jemand ob/wie man das automatisieren kann?

Delphi-Quellcode:

FUNCTION CountStr(const SearchFor,SearchIn:string):Integer;
{$DEFINE ANSI}
const sz=SizeOf(Char);
asm
               test     eax,eax
               je       @Ret                 // SearchFor leer
               mov      ecx,[eax-4]          // Length(SearchFor)
               push     ebp
               push     ebx
               push     edi
               push     esi
               push     0                    // Anzahl Zeichen
               test     edx,edx
               je       @End                 // SearchIn leer
               mov      ebp,ecx              // Length(SearchFor)
               mov      ebx,[edx-4]          // Length(SearchIn)
               sub      ebx,ecx              // Length(SearchIn)-Length(SearchFor)
               jc       @End                 // SearchFor länger als SearchIn
               lea      esi,[eax+ecx*sz]     // Hinter SearchFor
               lea      edi,[edx+ecx*sz]     // Hinter SearchIn[Length(SearchFor)]
               neg      ecx
               jmp      @Entry
@NextStart:    sub      ebx,1
               jc       @End                 // Alles durchsucht
               add      edi,sz               // Nächste Startposition
@Entry:        mov      edx,ecx              // Count
@CharLoop:     {$IFDEF ANSI}
               mov      al,[esi+edx*sz]      // SearchFor[edx]
               cmp      al,[edi+edx*sz]      // SearchIn[edx]
               {$ELSE}
               mov      ax,[esi+edx*sz]      // SearchFor[edx]
               cmp      ax,[edi+edx*sz]      // SearchIn[edx]
               {$ENDIF}
               jne      @NextStart
@NextChar:     add      edx,1                // Count
               jl       @CharLoop            // nächstes Zeichen prüfen
               add      [esp],1              // Anzahl Fundstellen
               lea      edi,[edi+ebp*sz]     // Um Length(SearchFor) weiter
               sub      ebx,ebp              // Anzahl verfügbarer Zeichen
               jnc      @Entry               // Noch Zeichen da
@End:          pop      eax                  // Anzahl Zeichen
               pop      esi
               pop      edi
               pop      ebx
               pop      ebp
@Ret:
end;