Boyer Moore Algorithmus

[Ginko]

Hallo, hier diese Klasse http://www.delphipraxis.net/108604-post5.html, zum durchsuchen von Textdateinen, teste ich gerade. Allerdings gehen ab und zu ein paar Wörter verloren...
Ich weiß jetzt nicht ob es an Lazarus liegt oder ob ich sonst ein Fehler eingebaut habe.

Den Code, den ich aus dem oben verlinkten Projekt übernommen habe und unter Lazarus zum laufen gebracht habe, ist im Anhang.
In der Textdatei ist ein Text bei dem das lezte Wort, bei der Suche nicht berücksichtigt wird. Es kommt aber auch vor das ein Wort mitten drin nicht gezählt wird.

[Furtbichler]

Hi,

Ich kann es nicht belegen, aber laut Recherche sind die Delphi-Boyer-Moore-Implementierungen im Netz fehlerhaft. Ob das für den JsTextSearch-Code gilt, kann ich nicht sagen.

Aber was hält dich davon ab, es erst einmal mit einer einfachen Implementierung zu versuchen?

Delphi-Quellcode:

Function CountWords (Const text, wort : String) : Integer;
Var
  i : Integer;

Begin
  i:=1;
  Result := 0;
  repeat
    i := StrUtils.PosEx(wort,text,i)+1;
    if i>1 then inc(Result) else exit;
  until false
End;

Es verwendet 'PosEx', welches einen Teilstring ab einer bestimmten Stelle sucht. Nach dem Finden des Wortes wird dessen Position + 1 als nächste Anfangsposition verwendet. Das kann man alles natürlich noch verbessern, aber für den Anfang sollte es reichen.

Superduperschnell ist es nicht, aber benötigst du unbedingt BM? Und wenn ja, dann vermutlich besser QuickSearch, Horspool o.ä.

[Ginko]

Danke für die Antwort. Schade das die fehlerhaft sind...

So eine ähnliche Implementierung hatte ich schon. Ich werde das ganze mal noch hier mit versuchen http://www.delphipraxis.net/712289-post42.html. Allerdings meckert hier Lazarus bei einigen Assemblerbefehelen.

Z.B. hier:

Delphi-Quellcode:

@FillSkip: movzx edx,[edi+ecx] // SearchFor[i]

FastPosUnit.pas(85,30) Error: Asm: [movzx reg32,mem32] invalid combination of opcode and operands

Aber das wäre vielleicht ein neues Thema.

[BUG]

Zitat:

Zitat von Furtbichler (Beitrag 1217482)

Und wenn ja, dann vermutlich besser QuickSearch, Horspool o.ä.

Die Implementierung von Quicksearch sieht gar nicht so kompliziert aus, dass sollte man in Delphi übertragen können.

[p80286]

Hast Du denn das Delphi-Original nicht?

Delphi-Quellcode:

unit BoyerMooreHorsepool;

interface

function Search_BMH_Unrolled(sourcestring,suchstr: String): Integer;

implementation


type
  TBC_IntArray = Array[Char] of Integer;


function PreProcess_BMH_BC(p: String): TBC_IntArray;
var
  i,
  m : Integer;
  c : Char;
begin
  m := Length(p);
  for c := low(Char) to High(Char) do
    result[c] := m;
  for i := 1 to m-1 do
    result[p[i]] := m-i;
end;

// Suche mit Horspool, direkt die unrolled-Variante. Sehr ähnlich zu BM_Unrolled
function Search_BMH_Unrolled(sourcestring,suchstr: String): Integer;
var
  m, n, k, j: Integer;
  BC      : TBC_IntArray;
  BC_last : Integer;
  Large   : Integer;
begin
  m := Length(suchstr);
  n := Length(sourcestring);
  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 := 0;

  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;
        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;

end.

[Ginko]

Danke, den hatte ich auch grad gefunden nur etwas weniger ausführlich. Beim testen fehlen aber fast die Hälfte der Wörter. Vielleicht habe ich auch einen Fehler in der NextPos Funktion, muss mal schauen.

[Ginko]

Zur Sicherheit habe ich mal nicht meine NextPos geholt, sondern hier diese http://www.swissdelphicenter.ch/de/showcode.php?id=474. Wenn ich hier Pos mit Search_BMH_Unrolled ersetze fehlen immer ein haufen Wörter.

Delphi-Quellcode:

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

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

Zitat von Horst_ (Beitrag 1217551)

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:

Zitat von Ginko (Beitrag 1217526)

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

Zitat von Furtbichler (Beitrag 1217618)

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. :stupid:

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

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

Zitat von Gausi (Beitrag 1217653)

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:

Zitat von Gausi (Beitrag 1217653)

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:

Zitat von BUG (Beitrag 1217691)

Zitat:

Zitat von Gausi (Beitrag 1217653)

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:

Zitat von Horst_ (Beitrag 1217695)

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:

Zitat von Horst_ (Beitrag 1217703)

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:

Zitat von Furtbichler (Beitrag 1217699)

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:

Zitat von Furtbichler (Beitrag 1217797)

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;

[Furtbichler]

Moin,
Das ist aber ein Service ;-)

Aber: Es ist klar, das Boyer-Moore hier nicht sonderlich gut abschneidet, denn das Alphabet ist klein und die Wörter kurz, da bringt die Sprungtabelle nicht viel bzw. wird durch den Overhead aufgefressen. Generell ist kaum möglich, eine (gepimpte) einfache Suchschleife zu toppen.

Sucht man z.B. nach 'Line Square PointPoint>' ist der BMH schon fast doppelt so schnell bzw. wird deine Routine hier langsamer: Sie ist also speziell auf kurze Suchstrings ausgelegt.

[Ginko]

Zitat:

Zitat von Furtbichler (Beitrag 1217824)

Aber: Es ist klar, das Boyer-Moore hier nicht sonderlich gut abschneidet, denn das Alphabet ist klein und die Wörter kurz, da bringt die Sprungtabelle nicht viel bzw. wird durch den Overhead aufgefressen. Generell ist kaum möglich, eine (gepimpte) einfache Suchschleife zu toppen.

Bei meinem letzen Testprogramm (Anhang 5) ist der BMH nur bei einem Buchstaben etwas langsamer als die Standard Funktion. Ansonsten ist er meistens 2 bis 3 mal schneller. Der letzte Test hat das ganze Alphabet und auch längere Wörter. Das entspricht eher der Anwendung für die ich den Algorithmus brauche.

Die Assembler Suche bringt immer noch 0 Funde in Lazarus schade...

Mfg

[Furtbichler]

Was für ein Anhang 5? Kannst Du das nochmal hier einführen. Ich glaub das nämlich nicht.

[Ginko]

Ja klar.

[Horst_]

Hallo,

die Asm Version hat ja einfach die Paramter vertauscht
SearchIn Searchfor und Suchtext,SuchWort... -> muss ja 0 werden.
Also EAX und EDX im zu Beginn ander sbehandeln, wieso habe ich nicht einfach ein
XCHG EAX,EDX davorgesetet....:-(

Ich würde in der ASM Version mal an repne scasb //scasw in Betracht ziehen.
Bei Jaenicke's Version
http://www.entwickler-ecke.de/topic_..._91942,20.html , bringt es einiges ab 7 Buchstaben Abstand.

Hier die angepasste Unit1 für Version 5b.

Delphi-Quellcode:

unit Unit1;

{$mode objfpc}{$H+}
{$ASMMODE INTEL}
interface

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

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    ComboBox1: TComboBox;
    Edit2: TEdit;
    Edit3: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;


implementation

{$R *.lfm}

{ TForm1 }

const
  testtxt: string = 'Franz jagt im komplett verwahrlosten Taxi quer durch Bayern.' +
    #13#10;

var
  //Variablen für Zeittest
  freq: int64;
  startTime: int64;
  endTime: int64;
//ASM_ERGEBNIS_ASM : integer;

function CountStr(const SearchIn, SearchFor: string): integer; assembler;
      {$DEFINE ANSI}
asm
         TEST    EDX,EDX
         JE      @Ret // SearchFor leer
         mov     ECX,[EDX-4] // Length(SearchFor)
         PUSH    EBP
         PUSH    EBX
         PUSH    EDI
         PUSH    ESI

         PUSH    Dword 0 // Anzahl Zeichen
         //         MOV     ESI,0 ; MOV     ASM_ERGEBNIS_ASM,ESI

         TEST    EAX,EAX
         JE      @end // SearchIn leer
         mov     EBP,ECX // Length(SearchFor)
         MOV     EBX,[EAX-4] // Length(SearchIn)
         SUB     EBX,ECX // Length(SearchIn)-Length(SearchFor)
         JC      @end // SearchFor länger als SearchIn
      {$IFDEF ANSI}
         lea     ESI,[EDX+ECX] // Hinter SearchFor
         LEA     EDI,[EAX+ECX] // Hinter SearchIn[Length(SearchFor)]
      {$ELSE}
         LEA     ESI,[EDX+ECX*2] // Hinter SearchFor
         LEA     EDI,[EAX+ECX*2] // Hinter SearchIn[Length(SearchFor)]
      {$ENDIF}
         NEG     ECX
         JMP     @Entry
         @NextStart:
         SUB     EBX,1
         JC      @end // Alles durchsucht
      {$IFDEF ANSI}
         add EDI,1 // Nächste Startposition
      {$ELSE}
         ADD     EDI,2 // Nächste Startposition
      {$ENDIF}
         @Entry:
         MOV     EDX,ECX // Count
         @CharLoop:
      {$IFDEF ANSI}
         MOV     AL,[ESI+EDX*1] // SearchFor[edx]
         CMP     AL,[EDI+EDX*1] // SearchIn[edx]
      {$ELSE}
         MOV     AX,[ESI+EDX*2] // SearchFor[edx]
         CMP     AX,[EDI+EDX*2] // SearchIn[edx]
      {$ENDIF}
         JNE     @NextStart
         @NextChar:
         ADD     EDX,1 // Count
         JL      @CharLoop // nächstes Zeichen prüfen

         ADD    DWORD PTR [ESP],1 // Anzahl Fundstellen
         //INC     ASM_ERGEBNIS_ASM

     {$IFDEF ANSI}
         LEA     EDI,[EDI+EBP*1] // Um Length(SearchFor) weiter
     {$ELSE}
         LEA     EDI,[EDI+EBP*2] // Um Length(SearchFor) weiter
     {$ENDIF}
         SUB     EBX,EBP // Anzahl verfügbarer Zeichen
         JNC     @Entry // Noch Zeichen da
         @end:
         POP     EAX
         //         MOV     EAX,ASM_ERGEBNIS_ASM

         POP     ESI
         POP     EDI
         POP     EBX
         POP     EBP
         @Ret:
end;
{$UNDEF ANSI}

function CountWordsStd(const Text, wort: string): integer;
var
  i: integer;
begin  //Mit Standard PosEx zählen
  i := 1;
  Result := 0;
  repeat
    i := PosEx(wort, Text, i) + 1;
    if i > 1 then
      Inc(Result)
    else
      exit;
  until False;
end;


procedure TForm1.Button2Click(Sender: TObject); //Test starten
var
  Filestream: TFileStream;
  SuchWort, SuchText: string;
  i, Ergebnis, Durchlaeufe: integer;
begin
  SuchWort := ComboBox1.Text;
  Durchlaeufe := StrToInt(Edit3.Text);

  if not FileExists(ExtractFilePath(Application.ExeName) + '\test.txt') then
  begin
    ShowMessage('Erst Testdatei mit Button "Create TesFile" erstellen !');
    exit;
  end;

  Filestream := TFileStream.Create('test.txt', fmOpenRead);
  try
    SetLength(SuchText, Filestream.Size);
    Filestream.Read(SuchText[1], Length(SuchText));

    QueryPerformanceFrequency(freq);

    //------------------------------------------------------------------------------
    QueryPerformanceCounter(startTime);//start BMH
    for i := 1 to Durchlaeufe do
      Ergebnis := BMH_CountStr_1(SuchText, SuchWort);
    QueryPerformanceCounter(endTime);//stop

    Memo1.Lines.Add('BMH Count:         ' + IntToStr(Ergebnis) +
      ' in ' + IntToStr((endTime - startTime) * 1000 div freq) + 'ms');

    //------------------------------------------------------------------------------
    QueryPerformanceCounter(startTime);//start SpeedSearch
    for i := 1 to Durchlaeufe do
      Ergebnis := SpeedSearch(SuchText, SuchWort);
    QueryPerformanceCounter(endTime);//stop

    Memo1.Lines.Add('SP Search Count: ' + IntToStr(Ergebnis) + ' in ' +
      IntToStr((endTime - startTime) * 1000 div freq) + 'ms');

    //------------------------------------------------------------------------------
    QueryPerformanceCounter(startTime);//start Standard PosEx
    for i := 1 to Durchlaeufe do
      Ergebnis := CountWordsStd(SuchText, SuchWort);
    QueryPerformanceCounter(endTime);//stop

    Memo1.Lines.Add('Std PosEx Count: ' + IntToStr(Ergebnis) + ' in ' +
      IntToStr((endTime - startTime) * 1000 div freq) + 'ms');

    //------------------------------------------------------------------------------
    QueryPerformanceCounter(startTime);//start Standard PosEx
    for i := 1 to Durchlaeufe do
      Ergebnis := CountStr(SuchText, SuchWort);
    QueryPerformanceCounter(endTime);//stop

    Memo1.Lines.Add('Asm        Count: ' + IntToStr(Ergebnis) + ' in ' + IntToStr(
      (endTime - startTime) * 1000 div freq) + 'ms');
    Memo1.Lines.Add('');
    //------------------------------------------------------------------------------


  finally
    Filestream.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Clear;
end;

procedure TForm1.Button3Click(Sender: TObject); //Testdatei erstellen
var
  Filestream: TFileStream;
  i, zeilen: integer;
begin
  zeilen := StrToInt(Edit2.Text);

  Filestream := TFileStream.Create('test.txt', fmCreate);
  try
    for i := 1 to zeilen do
      Filestream.Write(testtxt[1], Length(testtxt));
  finally
    Filestream.Free;
  end;
end;


end.

Das Motorrad ruft ....schon wieder ;-)

Gruß Horst

[Ginko]

Ahh ja jetzt läufts, Danke euch! Sehr schön. Besonders bei sehr langen Strings und bei einem Buchstaben liegt die ASM Version bei meinen Tests vorne. Teilweise nochmal doppelt so schnell wie der BMH :shock:. Im Mittelfeld allerdings ist der BMH noch vorne.

[Amateurprofi]

Zitat:

Zitat von Horst_ (Beitrag 1217853)

Ich würde in der ASM Version mal an repne scasb //scasw in Betracht ziehen.

Ich nicht!
Zumindest bei mir ist das langsamer, als konventionelles Cmp
Und das war bei mir schon immer so, beim 80486,Pentium, Pentium II, Core 2 und jetzt Core I7.
Bei anderen CPUs mag das anders sein.
Ich meide all diese schönen Super-Instrutionen wie Cmps, Lods, Scas, Stos, Loop.
Die sind zwar schön bequem, aber langsamer.

Hier mal ein kleines Test-Szenario, das in 800 Bytes erfolglos sucht.
Es wird 1000 Mal getestet wie viel CPU-Ticks Repne Scasb und Cmp brauchen.
Die jeweiligen Minimum-Ticks werden gegenübergestellt.
Bei mir ergab sich für Repne Scasb 3526 Ticks, für konventionelles Cmp 3468 Ticks.
Kein großer Unterschied, aber jedenfalls ein Unterschied zu Gunsten Cmp.

Delphi-Quellcode:

PROCEDURE TestRepneScas(var T1,T2:Int64);
const len=800;
asm
         // Register sichern
         push     ebp
         push     ebx
         push     edi
         push     esi
         // Parameter sichern
         push     eax                     // @T1
         push     edx                     // @T2
         // Len Bytes auf Stack reservieren und mit 0 füllen
         sub      esp,len
         mov      ecx,len
         lea      edx,[esp+ecx]
         neg      ecx
@L1:     mov      byte[edx+ecx],0
         add      ecx,1
         jl       @L1
         // repnw Scasb testen
         rdtsc
         mov      ebp,eax                 // TSC.Lo
         mov      ebx,edx                 // TSC.Hi
         mov      ecx,len                 // Anzahl Bytes
         mov      edi,esp                 // Ab hier prüfen
         mov      al,1                    // 1 suchen (wird nicht gefunden
         repne    scasb
         rdtsc
         sub      eax,ebp
         sbb      edx,ebx
         mov      ebp,eax                 // Ticks für Repne Scas byte
         mov      ebx,edx
         // konventionelle Schleife
         rdtsc
         mov      edi,eax
         mov      esi,edx
         mov      ecx,len                 // Anzahl Bytes
         lea      edx,[esp+ecx]
         neg      ecx
         mov      al,1
@L2:     cmp      [edx+ecx],al
         je       @Found                  // wird nicht eintreten
         add      ecx,1
         jl       @L2
@Found:  rdtsc
         sub      eax,edi                 // Ticks für konventionelles cmp byte
         sbb      edx,esi
         // Len Bytes auf Stack freigeben
         add      esp,len
         pop      ecx                     // @T2
         mov      [ecx],eax               // T2.Lo
         mov      [ecx+4],edx             // T2.Hi
         pop      ecx                     // @T1
         mov      [ecx],ebp               // T1.Lo
         mov      [ecx+4],ebx             // T1.Hi
         // Register wiederherstellen
         pop      esi
         pop      edi
         pop      ebx
         pop      ebp
end;

Delphi-Quellcode:

PROCEDURE TMain.Test;
const count=1000;
var samask,pamask,tamask:NativeUInt;
    t1,t2,ticks1,ticks2:Int64; i:integer; s:string;
begin
   i:=Pos('a',s);
   // Thread auf 1 CPU fixieren
   GetProcessAffinityMask(GetCurrentProcess,pamask,samask);
   if pamask=0 then exit;
   tamask:=1;
   while tamask and pamask=0 do tamask:=tamask shl 1;
   SetThreadAffinityMask(GetCurrentThread,tamask);
   ticks1:=High(Int64);
   ticks2:=High(Int64);
   for i:=1 to count do begin
      TestRepneScas(t1,t2);
      if t1<ticks1 then ticks1:=t1;
      if t2<ticks2 then ticks2:=t2;
   end;
   ShowMessage('Repne Scas: '+IntToStr(ticks1)+' Ticks'#13+
               'Konv. CMP: '+IntToStr(ticks2)+' Ticks'#13+
               'Delta: '+IntToStr(ticks1-ticks2)+' Ticks');
end;

[Amateurprofi]

Zitat:

Zitat von Furtbichler (Beitrag 1217824)

Moin,
Das ist aber ein Service ;-)

Aber: Es ist klar, das Boyer-Moore hier nicht sonderlich gut abschneidet, denn das Alphabet ist klein und die Wörter kurz, da bringt die Sprungtabelle nicht viel bzw. wird durch den Overhead aufgefressen. Generell ist kaum möglich, eine (gepimpte) einfache Suchschleife zu toppen.

Sucht man z.B. nach 'Line Square PointPoint>' ist der BMH schon fast doppelt so schnell bzw. wird deine Routine hier langsamer: Sie ist also speziell auf kurze Suchstrings ausgelegt.

Ich denke, es kommt hauptsächlich darauf an, wie lang der zu durchsuchende String ist.
Wenn der sehr lang ist wird sich BM positiv auswirken, ist er eher kurz, dann wird der BMs Overhead mehr Zeit fressen, als die eigentliche Suche.
Beim Durchsuchen größerer Datenbestände wird BM sicherlich Sinn machen.

[Horst_]

Hallo,

@Amateurprofi:
Du hat Deine CPU aber noch nicht die Frequenz hochgeschraubt..
Wenn ich nur Test aufrufe, kommt 6684 / 6660 raus->delta = 24
Wenn ich in Test nach der Festlegung auf CPU1 eine rechneintensive Schleife einbaue ~1 Sekunde dann habe 1700/1694-> delta= 6 ( recht genau 3.2/0.8 [Ghz/Ghz]
Hier gibt es auch schon eine Variante mit REPNE SCASB
http://www.delphipraxis.net/51284-te...n-zaehlen.html
Lazarus will es nicht kompilieren und wenn ich EAX und EDX wieder einsetze statt &S und EAX um 1 statt 65536 erhöhe und shr 16 entferne , zählt das Programm bei 100000 Zeilen "Franz jagt..." nur 85 "Taxi" in nur 209 ms statt über 300 ms für alle anderen.

Gruß Horst

[Furtbichler]

Zitat:

Zitat von Amateurprofi (Beitrag 1217873)

Ich denke, es kommt hauptsächlich darauf an, wie lang der zu durchsuchende String ist.
Wenn der sehr lang ist wird sich BM positiv auswirken, ist er eher kurz, dann wird der BMs Overhead mehr Zeit fressen, als die eigentliche Suche.
Beim Durchsuchen größerer Datenbestände wird BM sicherlich Sinn machen.

Natürlich spielt so ein Algorithmus seine Stärken bei längeren Texten aus. Aber wichtig ist hier ja die Sprungtabelle, und die ist umso optimaler, je länger der zu suchende Text ist und umso größer die Wahrscheinlichkeit ist, das Zeichen des Suchtextes im Originaltext seltener vorkommen.