Boyer Moore Algorithmus

[Horst_]

Hallo,

Furtbichlers Vorschlag ist doch insofern sinnig, dass man von einer Festplatte die Daten bestimmt nicht so schnell lesen kann, wie PosEx(wort,text) oder strPos(pAnsiChar(aBuffer[0]), wort) { -> Puffer um 1 vergrößern und dort eine #0 reinschreiben} die Sachen finden.
Wie ist denn die minimale Wortlänge, ab der Boyer Moore überhaupt Sinn macht?

Gruß Horst

[CCRDude]

Da ich selber drei oder vier Versionen aus dem Netz bearbeitet habe, bevor ich mir das selber implementiert habe, kann ich Furtbichler nur recht geben.

Die TJsTextSearch zum Beispiel hat funktionierte so nicht, sobald einzelne Zeichen mehrfach im Suchbegriff vorkommen - da gibt es einen Fehler in InitSkipTable (der Code von p80286 zeigt wie die Skiptable richtig aufgebaut werden muss) und einen in Search.

Irgend eine Implementierung hatte gar einen Sonderfall, wo die Suche in einem von 1 Million Fällen (eine bestimmte Datei halt) endlos lief - da wurde halt immer wieder in der Datei zurück gesprungen.

[p80286]

Zitat von Horst_:

Hallo,

Furtbichlers Vorschlag ist doch insofern sinnig, dass man von einer Festplatte die Daten bestimmt nicht so schnell lesen kann, wie PosEx(wort,text) oder strPos(pAnsiChar(aBuffer[0]), wort) { -> Puffer um 1 vergrößern und dort eine #0 reinschreiben} die Sachen finden.

Was bitte hat die Festplatte damit zu tun? Soweit mir bekannt ist, müssen in den allermeisten Fällen alle Daten, die verarbeitet werden sollen im (Haupt)Speicher vorliegen.

Zitat:

Wie ist denn die minimale Wortlänge, ab der Boyer Moore überhaupt Sinn macht?

Es kommt darauf an.... es gilt aber immer noch je länger, desto besser.
Und je mehr Bumms Dein Rechner hat, desto weniger benötigst Du BM.

Zitat von Ginko:

..fehlen immer ein haufen Wörter.

Du bedenkst aber, daß Hallo<>hallo<>HALLO<>HALLo ist?

@CCRDude
ist nicht "Mein" Code, ich hab es aus einem älteren tread den ich nicht mehr wiederfinde.

Gruß
K-H

[Ginko]

Hier ist mal mein Versuchsaufbau:

Delphi-Quellcode:

unit Unit1;
{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, BMH, strutils;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

function NextPosBMH(SearchStr, Str: string; Position: Integer): Integer;
begin
  Delete(Str, 1, Position - 1);
  Result := Search_BMH_Unrolled(Str,SearchStr);
  if Result = 0 then Exit;
  if (Length(Str) > 0) and (Length(SearchStr) > 0) then
    Result := Result + Position + 1;
end;

Function CountWordsStd(Const text, wort : String) : Integer;
Var
  i : Integer;
Begin
  i:=1;
  Result := 0;
  repeat
    i := PosEx(wort,text,i)+1;
    if i > 1 then inc(Result) else exit;
  until false
End;

Function CountWordsStdBMH(Const text, wort : String) : Integer;
Var
  i : Integer;
Begin
  i:=1;
  Result := 0;
  repeat
    i := NextPosBMH(wort,text,i)+1;
    if i > 1 then inc(Result) else exit;
  until false
End;

procedure TForm1.Button1Click(Sender: TObject); //Std Pos
var
  Filestream : TFileStream;
  SuchWort, SuchText: String;
begin
  SuchWort:= Edit1.Text;

  Filestream:=TFileStream.Create('test.txt',fmOpenRead);
  Try
    SetLength(SuchText,Filestream.Size);
    Filestream.Read(SuchText[1],Length(SuchText));
    Label1.Caption:= IntToStr(CountWordsStd(SuchText,SuchWort));
  Finally
    Filestream.Free;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);   // BMH
var
  Filestream : TFileStream;
  SuchWort, SuchText: String;
begin
  SuchWort:= Edit1.Text;

  Filestream:=TFileStream.Create('test.txt',fmOpenRead);
  Try
    SetLength(SuchText,Filestream.Size);
    Filestream.Read(SuchText[1],Length(SuchText));
    Label1.Caption:= IntToStr(CountWordsStdBMH(SuchText,SuchWort));
  Finally
    Filestream.Free;
  end;
end;
end.

Textdatei test.txt:

Code:

Point

Line

Square

Point Point

Triangle

Line

Point

Die Funktion, die mit der Standard Pos arbeitet findet für "Point" -> 4
Die Funktion, die mit BMH arbeitet findet für "Point" -> 1

[Horst_]

Hallo,

nur mal als Hinweis, wie schnell PosEx ist
Ich habe diese Zeile:
"Point Line Square Point Point Triangle Line PointPoint Line Square PointPoint>>"

So oft hintereinanderkopiert, bis 1Gb belegt waren.Das schafft kein PC-CPU-Cache.
"Gesamttextlaenge 1.000.000.000"
Die Standardsuche nach 87.500.000 "Point" dauerte knapp 2,8 Sekunden
Die Standardsuche nach 12.500.000 "Triangle" dauerte knapp 1,03 Sekunden
Die Suche nach nach 25.000.000 "Point Lin" dagegen um 3,5 Sekunden

Das "T" bei Triangle ist einzigartig im Satz-> "T" gefunden=> Wort gefunden,
während "Point" 7 mal vorkommt, also müssen auch entsprechend oft mindestens 5 Zeichen untersucht werden, was in 5 von 7 Fällen eben vergebens ist.
Das BMH einen in 2.5 Sekunden findet ist nicht wirklich hilfreich

Apropos "Grautier", das wird in 0,72 Sekunden nicht gefunden."G" gibt es nicht.
"Papagei" braucht 2,3 Sekunden um nicht gefunden zu werden."P" sehr oft.

Gruß Horst

[Furtbichler]

Kein Wunder das die BM-Suche so langsam: Hier wird ja jedesmal der String gekürzt und BM liefert eh falsche Ergebnisse, denn er bricht beim ersten Fund nicht ab sondern sucht weiter. Da scheint ein 'exit' zu fehlen:

Delphi-Quellcode:

...
     if j=m then
       begin
         // Muster gefunden
         result := k - j + 1;
         exit; // <<<<<<<<<<<<<<<<<<<<<<< Fehlt
         // Die nächste Zeile ist auskommentiert, denn wir wollen ja nicht weitersuchen
         // k := k + m; //oder: k+1, oder: break; je nachdem, wie man den Text komplett durchsucht haben will
       end else
...

Der Code lässt sich im Übrigen leicht modifizieren, um ein sehr schnelles PosEx_BMH zu implementieren, d.h. 'Suche ab Position'. Hier die Korrekturen.

Delphi-Quellcode:

function Search_BMH_Unrolled(sourcestring,suchstr: String;Offset : integer=1): Integer;
var
   m, n, k, j: Integer;
   BC : TBC_IntArray;
   BC_last : Integer;
   Large : Integer;
begin
   m := Length(suchstr);
   n := Length(sourcestring)-Offset+1;
   Large := m + n + 1;

   BC := PreProcess_BMH_BC(suchstr);

   // "echten" BC-Shift merken
   BC_last := BC[suchstr[m]];
   // BC(lastCh) mit "Large" überschreiben
   BC[suchstr[m]] := Large;

   k := m;
   result := Offset-1;

   while k <= n do
   begin
       //fast loop
       repeat
         k := k + BC[sourcestring[k]];
       until k > n;

       //undo
       if k <= Large then
         //Muster nicht gefunden
         break
       else
         k := k - Large;

       j := 1;
       // slow loop
       while (j < m) and (suchstr[m-j] = sourcestring[k-j]) do
         inc(j);

       if j=m then
       begin
         // Muster gefunden
         result := k - j + 1;
         exit;
       //  k := k + m; //oder: k+1, oder: break; je nachdem, wie man den Text komplett durchsucht haben will
       end else
       begin
           // Muster verschieben
           if sourcestring[k] = suchstr[m] then
             k := k + BC_last // Hier dann den original-Wert nehmen
           else
             k := k + BC[sourcestring[k]];
       end;
   end;
end;

PS: Kann mal einer 'Horsepool' richtig schreiben? Das ist kein Pool für Pferde, sondern der Mann heißt 'Nigel Horspool'.

[Gausi]

Zitat von Furtbichler:

Kein Wunder das die BM-Suche so langsam: Hier wird ja jedesmal der String gekürzt und BM liefert eh falsche Ergebnisse, denn er bricht beim ersten Fund nicht ab sondern sucht weiter. Da scheint ein 'exit' zu fehlen:

Delphi-Quellcode:

...
     if j=m then
       begin
         // Muster gefunden
         result := k - j + 1;
         exit; // <<<<<<<<<<<<<<<<<<<<<<< Fehlt
         // Die nächste Zeile ist auskommentiert, denn wir wollen ja nicht weitersuchen
         // k := k + m; //oder: k+1, oder: break; je nachdem, wie man den Text komplett durchsucht haben will
       end else
...

Das exit fehlt da nicht, das ist da mit Absicht nicht drin - steht ja so in den Original-Kommentaren: "//oder: k+1, oder: break; je nachdem, wie man den Text komplett durchsucht haben will"

Finde ich übrigens schön, dass mein Code hier als "Delphi-Original" gehandelt wird.

In meiner ursprünglichen Routine gab es auch einen optionalen Listen-Parameter, in den alle Fundstellen eingetragen werden konnten. Damit kann man sich dann das ständige Neu-Aufbauen des Skip-Arrays sparen.

Edit: Der Code ist von mir, die Unit-Bezeichnung mit dem Pferd habe ich aber nicht verbockt.

[Horst_]

Hallo,

ich habe es BMH in die Unit gepackt, weil es ständig Unsinn gab.
Jetzt funktioniert es fürs Erste:
Edit, aber Obacht, ich lese die Textdatei bringe sie auf eine vorgegebene Länge.
function TForm1.TextEinlesen(Filname: string): string;
Diese nichts mit der Satzlänge der Textdatei zu tun hat.Bei Textlänge=100000, wird eine 82 Zeilen Zeile eben 1219 fach und 42 Zeichen kopiert.Deshalb funktionierte es im Folgendem bei Ginko nicht.

Delphi-Quellcode:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, strutils;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);

    procedure FormShow(Sender: TObject);
  private
    fT0, fT1: TDateTime;
    fEingabeText: string;
    function TextEinlesen(Filname: string): string;

    { private declarations }
  public
    { public declarations }
  end;

type

  TBC_IntArray = array[char] of integer;
  // Zu einem speziellen TBC_IntArray gehoert ein Suchwort
  TBC_Record = record
    rBC: TBC_IntArray;
    rm : integer;
    rSuchWort: string;
  end;


var
  Form1: TForm1;

const
  BufLen = 128 * 1024 * 1024;
  TextLaenge = BufLen;// 512*1024;


implementation

{$R *.lfm}


function PreProcess_BMH_BC(const p: string): TBC_Record;
var
  i: integer;
  c: char;
begin
  with Result do
  begin
    rSuchWort := p;
    rm := Length(p);
    for c := low(rBC) to High(rBC) do
      rBC[c] := rm;
    //Abstand bis zum Ende
    for i := 1 to rm - 1 do
      rBC[p[i]] := rm - i;
  end;
end;

function Search_BMH_Unrolled(const sourcestring: string; var BC: TBC_Record;
  Offset: integer = 1): integer;
var
  n, k, j: integer;
  //  BC_last: integer;
  Large: integer;
  sTmp: string;
begin
  with BC do
  begin
    n := Length(sourcestring);
    Large := rm + n + 1;

    // "echten" BC-Shift merken
    //Wozu BC_last = m..  BC_last := BC[suchstr[m]];
    // BC(lastCh) mit "Large" überschreiben
    rBC[rSuchWort[rm]] := Large;

    k := Offset + rm - 1;
    Result := 0;

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

      //Muster/letztes Zeichen im Suchwort nicht gefunden
      if j <> Large then
        break;

      j := 1;
      k := k - Large;
      // slow loop
      while (j < rm) and (rSuchWort[rm - j] = sourcestring[k - j]) do
        Inc(j);
      if j = rm then
      begin
        // Muster gefunden
        Result := k - j + 1;
        break;
      end
      else
      begin
        // Muster verschieben
        if sourcestring[k] = rSuchWort[rm] then
          k := k + rm //BC_last;//Hier dann den original-Wert nehmen
        else
          k := k + rBC[sourcestring[k]];
      end;
    end;
  end;
  //BC wiederherstellen
  //  BC[suchstr[m]]:=m;
end;

{ TForm1 }
function TForm1.TextEinlesen(Filname: string): string;
var
  Filestream: TFileStream;
  NeuPos, dl: integer;
begin
  Result := '';
  Filestream := TFileStream.Create(Filname, fmOpenRead);
  try
    with FileStream do
    begin
      setlength(Result, BufLen);
      if Size > TextLaenge then
        Read(Result[1], BufLen)
      else
      begin
        //Solange hintereinanderkopieren bis TextLaenge erreicht
        Read(Result[1], Size);
        Memo1.Clear;
        Memo1.Lines.Add(Copy(Result, 1, Size));
        Memo1.Lines.Add(Format('Gesamttextlaenge %d', [BufLen]));
        dl := Size;
        NeuPos := dl + 1;// statt result[NeuPos+1]
        while NeuPos + dl <= BufLen do
        begin
          Move(Result[1], Result[NeuPos], dl);
          NeuPos := NeuPos + dl;
          if dl < 64 * 1024 div 2 then
            Inc(dl, dl);
        end;
        Move(Result[1], Result[NeuPos], BufLen - NeuPos);
      end;
    end;
  finally
    Filestream.Free;
  end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  FEingabeText := TextEinlesen('test.txt');
end;

function CountWordsStd(const Text, wort: string): integer;
var
  i, delta: integer;
begin
  i := 1;
  delta := Length(Wort);
  Result := 0;
  repeat
    i := PosEx(wort, Text, i) + delta;
    if i > delta then
      Inc(Result)
    else
      exit;
  until False;
end;


function CountWordsStdBMH(const Text, wort: string): integer;
var
  i: integer;
  BC: TBC_Record;
begin
  i := 1;
  Result := 0;
  BC := PreProcess_BMH_BC(wort);
  repeat
    i := Search_BMH_Unrolled(Text, BC, i);
    if i > 0 then
      Inc(Result)
    else
      exit;
    Inc(i);
  until False;
end;

procedure TForm1.Button1Click(Sender: TObject); //Std Pos
var
  cnt, runden: integer;
  sSuchWort, sTmp: string;
begin
  sSuchWort := Edit1.Text;
  stmp := '"' + sSuchWort + '"';
  while length(sTmp) < 10 do
    sTmp := sTmp + ' ';
  fT0 := Time;
  for runden := TextLaenge div BufLen - 1 downto 0 do
    cnt := CountWordsStd(FEingabeText, sSuchWort);
  fT1 := Time;
  sTmp := sTmp + Format('Standard   %8d  ', [cnt]) + FormatDateTime(
    'HH:NN:SS.ZZZ ', fT1 - fT0);
  fT0 := Time;
  cnt := CountWordsStdBMH(FEingabeText, sSuchWort);
  fT1 := Time;
  sTmp := sTmp + Format('Boyer Moore %8d  ', [cnt]) + FormatDateTime(
    'HH:NN:SS.ZZZ ', fT1 - fT0);
  Label1.Caption := IntToStr(cnt);
  Memo1.Lines.Add(sTmp);
  application.ProcessMessages;
end;

end.

Code:

Point Line Square Point Point Triangle Line PointPoint Line Square PointPoint>>

Gesamttextlaenge 134217728
"Point" Boyer Moore 00:00:00.450 Standard 00:00:00.378 
"Point "Boyer Moore 00:00:00.296 Standard 00:00:00.415 
"Triangle" Boyer Moore 00:00:00.148 Standard 00:00:00.140 
"int Tri" Boyer Moore 00:00:00.173 Standard 00:00:00.531

Die Suche BMH ist nicht immer schneller, aber manchmal viel.

Gruß Horst