Boyer Moore Algorithmus

[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

[Ginko]

Hi und Danke für die Antworten.
Im Anhang ist ein Projekt welches eine Testdatei erstellen kann (Zeilenlänge nach Wahl) und die Zeit mit dem QueryPerformanceCounter misst.
Zum testen habe ich den Code von Furtbichler genommen, allerdings musste ich ihn noch etwas anpassen, damit das mit dem Offset klappt.
Gezählt wird jetzt jedenfalls absolut korrekt. Aber BMH ist bis zu 5 mal langsamer. Habe ich wahrscheinlich ne Bremse eingebaut...

@Horst_ dein Test hat bei mir keine richtigen Werte geliefert. (Vielleicht habe ich aber auch was vergessen...)

[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.

Dein Code durchläuft nach jedem Fund diese Vorbereitungsphase erneut - und bremst dadurch das Verfahren extrem aus. Inbesondere dann, wenn du viele Fundstellen hast. Wenn du alle Fundstellen haben willst, dann musst du den Code anpassen, und anstelle des "Result := ...; Exit;" eine Liste mit allen Fundstellen aufbauen.

Auto Vergleiche sind ja immer schön: Du hast dein Auto schön auf Vordermann gebracht (frisches Öl, neue Reifen, Spolier) um schneller ans Ziel zu kommen. Und dann steigst du an jeder Ampel aus und machst den Öl- und Reifenwechsel erneut.

[Ginko]

Zitat von Gausi:

Dein Code durchläuft nach jedem Fund diese Vorbereitungsphase erneut - und bremst dadurch das Verfahren extrem aus. Inbesondere dann, wenn du viele Fundstellen hast. Wenn du alle Fundstellen haben willst, dann musst du den Code anpassen, und anstelle des "Result := ...; Exit;" eine Liste mit allen Fundstellen aufbauen.

Danke für den Hinweis das werde ich mal versuchen, hört sich plausibel an.

[Ginko]

So jetzt läufts, ab 2 oder 3 Zeichen wird der BMH deutlich schneller.

[Edit] Ab einer gewissen Länge des Suchwortes wird die Standard Funktion bei mir aber wieder schneller, ist das normal ?

Hier nochmal der der Angepasste Code mit Test:

[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.

[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