Boyer-Moore für Unicode

[Schorschi5566]

Hallo DP,

bei "normalen" Alphabeten ist ja der Boyer-Moore-Algorithmus sehr effizient.

Dabei wird eine Skiptabelle (Bad-Character-Table) von der Größe des Alphabets (<= 256 Zeichen) benutzt um Zeichen, die nicht im Suchmuster vorkommen schnell zu finden.

Für Unicode müsste man nun aber eine Tabelle von 64k Größe (oder noch größer?) verwalten, was die Effizienz dann doch in den Keller wandern lässt.

Die anderen Aspekte bei Boyer-Moore (Good-Suffix) sind unabhängig von der Alphabetgröße, spielen dabei also keine Rolle.

Ich habe mal gegoogled und einen Ansatz mit einer Hashtabelle gefunden. Leider war dort aber nicht beschrieben, wie die entsprechende Hashfunktion auszusehen hat, bzw. wie man die Hashtabelle aufbauen muss.

Das Ganze steht und fällt mit einer schnellen Funktion um zu ermitteln ob ein zu untersuchendes Zeichen im Suchmuster vorhanden ist oder nicht.

Hat jemand eine Idee, wie man das bei einem Unicode-Alphabet anstellen sollte?


Grüße,
Uwe

[Gausi]

Ein Ansatz, den ich mal verfolgt habe, ist UTF8. D.h. Text und Muster liegen UTF8 kodiert vor, und die Suche läuft dann auf dem Bytemuster der Strings. Das klappt auch ganz gut.
Ansonsten wäre eine Einschränkung der Tabelle sinnvoll, wenn man die verwenden Zeichen einschränken kann (z.B. ohne ostasiatische Zeichen). Für die anderen Zeichen setzt man dann den Bad-Character-Shift nur auf 1.

Zitat:

Zitat von Schorschi5566 (Beitrag 1106112)

Die anderen Aspekte bei Boyer-Moore (Good-Suffix) sind unabhängig von der Alphabetgröße, spielen dabei also keine Rolle.

Die spielen in der Praxis sowieso fast nie eine Rolle. ;-) Bzw. es ist eher andersrum. Boyer-Moore nur mit Bad-Character ist in der Regel schneller als Boyer-Moore mit Bad-Character und Good-Suffix.

[Schorschi5566]

Hallo Gausi,

Zitat:

Zitat von Gausi (Beitrag 1106117)

Die spielen in der Praxis sowieso fast nie eine Rolle. ;-) Bzw. es ist eher andersrum. Boyer-Moore nur mit Bad-Character ist in der Regel schneller als Boyer-Moore mit Bad-Character und Good-Suffix.

Stimmt, wer sucht schon nach "supersupe". :lol:

Ich hab's jetzt doch mal mit einem 64K-Array probiert. Wenn man ausnutzt, dass das Array zu 0 initialisiert wird, ist die Performance doch recht gut.

Delphi-Quellcode:

    // Sprungtabelle für Bad-Character
    SetLength(FBadTable, 65536);
//    for i := 0 to 65535 do
//      FBadTable[i] := pLen;

    for i := 0 to pLen do
      FBadTable[Ord(sSearch[i+1])] := - i - 1; // später pLen addieren

Dann muss man beim Skipwert natürlich später noch plen addieren, was aber wesentlich weniger ins Gewicht fällt als die Initialisierung der Skiptable zu pLen. ;)

Delphi-Quellcode:

  while Offset <= sLen do
  begin
{$IFDEF TBDEBUG} ShowOffset(Offset - plen + 1, sText, sSearch); {$ENDIF}
    j := 0; // Anzahl der Übereinstimmungen
    while j < pLen do
    begin
      if sText[Offset - j] = sSearch[pLen - j] then
        inc(j)
      else
      begin
        BadSkip := FBadTable[Ord(sText[Offset - j])] + pLen - j;
        if BadSkip > FGoodTable[j] then
        begin
{$IFDEF TBDEBUG} me.Lines.Add('Bad:' + IntToStr(BadSkip); {$ENDIF}
          inc(Offset, BadSkip);
        end
        else
        begin
{$IFDEF TBDEBUG} me.Lines.Add('Good: ' + IntToStr(FGoodTable[j])); {$ENDIF}
          inc(Offset, FGoodTable[j]);
        end;
        Goto NextStep;
      end;
    end;
    Exit(Offset - pLen + 1);
NextStep:
  end;

[s.h.a.r.k]

Zitat:

Zitat von Schorschi5566 (Beitrag 1106112)

Ich habe mal gegoogled und einen Ansatz mit einer Hashtabelle gefunden. Leider war dort aber nicht beschrieben, wie die entsprechende Hashfunktion auszusehen hat, bzw. wie man die Hashtabelle aufbauen muss.

Das Ganze steht und fällt mit einer schnellen Funktion um zu ermitteln ob ein zu untersuchendes Zeichen im Suchmuster vorhanden ist oder nicht.

Ich weiß leider nicht, ob das bei Delphi 2010 mit dabei ist, aber bei XE gibts in der Unit Generic.Collections diesen generischen Typ TDictionary<TKey,TValue>, welcher mit Hashes arbeitet. Zur Not kann man aber immer noch THashedStringList aus der Unit IniFiles "vergewaltigen", wie ich das früher immer gemacht hatte :stupid: Nur weiß ich nicht, ob dir das was bringt!?

[Schorschi5566]

Hallo Armin,

Zitat:

Zitat von s.h.a.r.k (Beitrag 1106168)

Ich weiß leider nicht, ob das bei Delphi 2010 mit dabei ist, aber bei XE gibts in der Unit Generic.Collections diesen generischen Typ TDictionary<TKey,TValue>, welcher mit Hashes arbeitet. Zur Not kann man aber immer noch THashedStringList aus der Unit IniFiles "vergewaltigen", wie ich das früher immer gemacht hatte :stupid: Nur weiß ich nicht, ob dir das was bringt!?

Danke für den Tipp. Die Generics gibt's auch schon in D2010 aber vermutlich wird ein Suchvorgang über TDictionary länger dauern als auf die Art, wie ich es jetzt mache.

Im Prinzip tut nur das Initialisieren des 64k-Array richtig weh. :D Also lässt man es weg bzw. macht es nur einmal im Constructor. Anschließend werden bei einer neuen Suche nur die Positionen im Array wieder auf 0 gesetzt, die bei der letzten Suche verwendet wurden.

Ich habe das Ganze jetzt mal zu einer Funktion zusammengebaut, der man auch den Offset und die gewünschte Richtung mitgeben kann. Bei kleinen Suchmustern und Suchtexten ist Pos leicht im Vorteil aber ab 10 Zeichen Suchmuster und ca 5k Text, wird Pos dann schon deutlicher abgehängt. ;) Muss man in verschiedenen Texten dasselbe Suchmuster suchen, sieht Pos dann richtig blaß aus weil man in dem Fall die Sprungtabellen nicht neu erzeugen muss. :twisted:

Wer Lust hat, kann's ja mal testen. Bitte nicht über die paar Gotos mokieren. Es ging mir um Performance und da spart man jeden CPU-Zyklus :cyclops:. Lässt sich aber bestimmt noch weiter optimieren.


Grüße,
Uwe

Delphi-Quellcode:

unit BoyerMoore;

interface

uses
  SysUtils;

type
  TDirection = (dForward = 1, dBackward = -1);

  TBoyerMoore = class
  private
    FLastSearchStr : String;
    FLastSearchDir : TDirection;
    FBadTable, FGoodTable : array of Integer;
  public
    constructor Create;
    function PosBM(const Pattern, Text: String; Offset : Integer = 1; const Dir : TDirection = dForward): Integer; register;
  end;

implementation

{ TBoyerMoore }

constructor TBoyerMoore.Create;
begin
  // Array für Unicode initialisieren
  SetLength(FBadTable, 65536);
end;

// *************
// P  o  s  B  M
// *************
//
// Boyer-Moore Stringsuche
//
// Eingabe:
// --------
// Pattern: Suchmuster
//    Text: Suchtext
//  Offset: Position ab der gesucht werden soll
//     Dir: Richtung in die gesucht werden soll: dForward = vorwärts dBackward = rückwärts
//
// Rückgabe:
// ---------
// =0: kein Match
// >0: Position des ersten Match
//
function TBoyerMoore.PosBM(const Pattern, Text: String; Offset: Integer;
  const Dir: TDirection): Integer; register;
var
  i, j, k, iDir, iPLen, iTLen, iOffKorr, iBadSkip : Integer;
label
  NextTryFwd, MatchedFwd, NextTryBwd, MatchedBwd, NextStep;
begin
  Result := 0;
  iPLen := Length(Pattern);
  iTLen := Length(Text);
  iDir := Ord(Dir);

  if (iPLen > iTLen) or (Offset = 0) or (Offset > iTLen) then
    raise Exception.Create('PosBMEx: Invalid parameter!');

  // Good- und Bad-Table nur neu erzeugen, wenn neues Suchmuster verwendet wird
  // oder die Suchrichtung wechselt.
  if (FLastSearchStr <> Pattern) or (FLastSearchDir <> Dir) then
  begin

    // Bad-Table wieder auf 0 setzen
    for i := 1 to Length(FLastSearchStr) do
      FBadTable[Ord(FLastSearchStr[i])] := 0;

    // Good-Table anlegen
    SetLength(FGoodTable, iPLen + 1);

    // Sprungtabellen abhängig von der Richtung erzeugen
    if Dir = dForward then
    begin
      // Bad-Character-Table vorwärts
      for i := 1 to iPLen do
        FBadTable[Ord(Pattern[i])] := - i; // iPLen später addieren

      // Good-Suffix-Table vorwärts
      for j := 0 to iPLen do
      begin
        for i := iPLen-1 downto 1 do
        begin
          for k := 1 to j do
          begin
            if i - k < 0 then
              Goto MatchedFwd;
            if (Pattern[iPLen - k + 1] <> Pattern[i - k + 1]) then
              Goto NextTryFwd;
          end;
          Goto MatchedFwd;
NextTryFwd:
        end;
MatchedFwd:
        FGoodTable[j] := iPLen - i;
      end;
    end
    else
    begin
      // Bad-Character-Table rückwärts
      for i := iPLen downto 1 do
        FBadTable[Ord(Pattern[i])] := i - 1 - iPLen; // iPLen später wieder addieren

      // Good-Suffix-Table rückwärts
      for j := 0 to iPLen do
      begin
        for i := 2 to iPLen do
        begin
          for k := 1 to j do
          begin
            if i + k - 1 > iPLen then
              Goto MatchedBwd;
            if (Pattern[k] <> Pattern[i + k - 1]) then
              Goto NextTryBwd;
          end;
          Goto MatchedBwd;
NextTryBwd:
        end;
MatchedBwd:
        FGoodTable[j] := i - 1;
      end;
    end;

    FLastSearchStr := Pattern;
    FLastSearchDir := Dir;
  end;

  Offset := Offset + (iPLen - 1) * iDir; // Startoffset
  case Dir of
    dForward:
      iOffKorr := iPLen;
    dBackward:
      iOffKorr := 1;
  end;

  while (Offset <= iTLen) and (OffSet >= 0) do
  begin
    j := 0; // Anzahl der Übereinstimmungen
    while j < iPLen do
    begin
      if Text[Offset - j * iDir] = Pattern[iOffKorr - j * iDir] then
        inc(j)
      else
      begin
        iBadSkip := FBadTable[Ord(Text[Offset - j * iDir])] + iPLen - j;
        if iBadSkip > FGoodTable[j] then
        begin
          inc(Offset, iBadSkip * iDir); // Bad-Table verwenden
        end
        else
        begin
          inc(Offset, FGoodTable[j] * iDir); // Good-Table verwenden
        end;
        Goto NextStep;
      end;
    end;
    Exit(Offset - iOffKorr + 1);
NextStep:
  end;
end;

end.

[omata]

Zitat:

Zitat von Schorschi5566 (Beitrag 1106216)

Bitte nicht über die paar Gotos mokieren. Es ging mir um Performance und da spart man jeden CPU-Zyklus :cyclops:. Lässt sich aber bestimmt noch weiter optimieren.

Ja, das spart natürlich, wenn man mit Goto nach dem ersten Durchlauf sofort die Schleife verlässt.

Genau :wall:

Und das ist dir natürlich nicht aufgefallen, weil Goto nunmal unstrukturiert ist. Naja, bleib bei Deiner super Optimierung (die hättest du auch, wenn du deine Schleifen einfach weglassen würdest).

Edit: Habs gerade nochmal angeschaut (echt gruselig), macht vermutlich aber doch das, was du haben möchtest (leider!, macht es das)

[Schorschi5566]

Hehe, ich hab's doch gewußt. Na ein Verkünder der "einzigen, reinen Wahrheit", meldet sich halt immer zu Wort. Hat ja oft schon religiöse Züge. Und viele der Verkünder verwenden hemmungslos Break, Exit und try-except-Blöcke (am besten über drei Bildschirmhöhen hinweg). :lol:

Zitat:

Habs gerade nochmal angeschaut (echt gruselig), macht vermutlich aber doch das, was du haben möchtest (leider!, macht es das)

Wieso leider und gruselig? Effizient, würde ich sagen. Aber ich will mich nicht mit fremden Federn schmücken. Der Teil ist aus den einschlägigen Beispielen für Boyer-Moore entnommen und von mir lediglich an Delphi und die Rückwärtssuche angepaßt worden. (Da war doch noch ein dummes "break" drin, das auf ein Goto gesprungen ist, was logischerweise 2 Jumps bedeutet, wo nur einer nötig ist und wurde prompt von mir durch ein Goto ersetzt. :-D)

Zitat:

weil Goto nunmal unstrukturiert ist

Strukturier's halt ohne Gotos, wenn dir das mit der gleichen Performance und in zehn Zeilen gelingt. Viel Spaß.

Ich bin auch gegen Gotos (aber ich erzähl's nicht jedem bei jeder Gelegenheit) und musste erstmal nachsehen, wie das in Delphi überhaupt geht aber wohl dosiert und wenn es sinnvoll ist habe ich kein Problem dieses Sprachelement einzusetzen.

Im Übrigen gibt es diese Diskussion hier doch schon mehrfach und du musst niemanden bekehren.

[Deep-Sea]

Zitat:

Zitat von Schorschi5566 (Beitrag 1106112)

Für Unicode müsste man nun aber eine Tabelle von 64k Größe (oder noch größer?) verwalten [...]

Allein die Basic Multilingual Plane (BMP) beansprucht 64 kB. Insgesamt bietet Unicode für 1.114.112 ($000000 bis $10FFFF) Zeichen platz. Davon sind aktuell aber nur gut über 100.000 auch wirklich definiert.

[Schorschi5566]

Hallo Deep-Sea,

Zitat:

Allein die Basic Multilingual Plane (BMP) beansprucht 64 kB. Insgesamt bietet Unicode für 1.114.112 ($000000 bis $10FFFF) Zeichen platz. Davon sind aktuell aber nur gut über 100.000 auch wirklich definiert.

Danke für den Hinweis.

Fragt sich, was die Ord-Funktion mit Codes über 65535 macht. Wenn einfach weiter gezählt wird, müsste man nur die Arraygröße im Constructor anpassen.


Grüße,
Uwe

[omata]

Zitat:

Zitat von Schorschi5566 (Beitrag 1106233)

Im Übrigen gibt es diese Diskussion hier doch schon mehrfach und du musst niemanden bekehren.

Tue ich auch nicht. Entschuldigung, dass ich was gesagt habe. ich bereue es schon.

[mkinzler]

Ein Versuch wäre bei dir ja, wie man sieht, eh sinnlos.

[Schorschi5566]

Bin guten Argumenten gegenüber immer aufgeschlossen.

Aber vorhandenen, funktionierenden Code der schönen Struktur wegen zu verlangsamen oder unnötig auszuweiten, widerstrebt mir. ;)

[jbg]

Hast du die Warnungen des Compiler deaktiviert? Denn "i" ist nach der Schleife undefiniert. Und nur weil der aktuelle Compiler hier die Schleife nicht optimiert, funktioniert das. Zukünfige Compiler könnten da aber schon mal Hand ansetzen. Eine C-for-Schleife muss nicht immer unbedingt in eine Pascal-for-Schleife umgewandelt werden.

Hast du auch die $STRINGCHECKS deaktiviert? Denn die fressen die Performance auf. Da ist dein "ein JMP gespart" belanglos, was es ohnehin dank Jump-Optimierung seitens Delphi bereits ist. Delphi erkennt, dass du mit "break" auf ein "goto" springst, und leitet den Sprung direkt weiter ohne den Zwischenstopp. (Einfach mal den Assemblercode im CPU-View anschauen).

Zudem könnte man die Subtraktion aus der inneren Schleife nehmen, indem man auf zwei PChar umstellt und beide mit Dec() rückwärts laufen lässt ("- k"). Und wenn man schon dabei ist, kann man auch gleich noch die if-Abfrage in der inneren Schleife entfernen und dafür die for-Schleifen-Grenze anpassen.
Außerdem kann man sich den j=0 Durchlauf sparen, da dort für all i (und k) überhaupt nichts geschieht, außer ein vollständiger unnötiger i-Durchlauf.

[jbg]

Du kannst auch noch einen Speicherzugriff einsparen, wenn du das FBadTable dynamische Array direkt als "array[0..65535] of Integer" deklarierst. Da entfällt eine Speicher-Indirektion und du brauchst keinen eigenen Konstruktor mehr.

[Deep-Sea]

Zitat:

Zitat von Schorschi5566 (Beitrag 1106216)

Delphi-Quellcode:

[...]
            if (Pattern[iPLen - k + 1] <> Pattern[i - k + 1]) then
              Goto NextTryFwd;
          end;
          Goto MatchedFwd;
NextTryFwd:
        end;
MatchedFwd:
        FGoodTable[j] := iPLen - i;
      end;
    end
[...]

Kommt mir bekannt vor:

Code:

[...]
                if (p[plen - k] != p[i - k]) {
                    goto nexttry;
                }
            }
            goto matched;
nexttry:
            ;
        }
matched:
        next[j] = plen - i;
    }
[...]

Quelle: Wikipedia

[Schorschi5566]

@Deep-Sea:

Zitat:

Zitat von Schorschi5566 (Beitrag 1106233)

Aber ich will mich nicht mit fremden Federn schmücken. Der Teil ist aus den einschlägigen Beispielen für Boyer-Moore entnommen und von mir lediglich an Delphi und die Rückwärtssuche angepaßt worden.

@jbg:

Zitat:

Da ist dein "ein JMP gespart" belanglos, was es ohnehin dank Jump-Optimierung seitens Delphi bereits ist. Delphi erkennt, dass du mit "break" auf ein "goto" springst, und leitet den Sprung direkt weiter ohne den Zwischenstopp. (Einfach mal den Assemblercode im CPU-View anschauen).

Danke, das war mir neu. :)

@all:
Ich hab mal den "goto-verseuchten" Teil umgeschrieben. ;)

Delphi-Quellcode:

      // Good-Suffix-Table vorwärts
      FGoodTable[0] := 1;
      j := 1;
      i := iPLen - 1;
      k := 0;
      bMatch := False;
      while j < iPLen  do
      begin
        while (i > 0) and (k <> j) do
        begin
          while (k < j) and (i - k > 0) and (Pattern[iPLen - k] = Pattern[i - k]) do
          begin
            bMatch := True;
            inc(k);
          end;
          if (k < j) then // kein ganzes Suffix gefunden
          begin
            if i-k <= 0 then
              i := 0 // Maximal-Skip
            else
            begin
              if bMatch then  // kein Match mit dieser Länge...weitersuchen
              begin
                k := 0; // wieder von vorn
                bMatch := False;
              end;
              Dec(i);
            end;
          end;
        end;
        FGoodTable[j] := iPLen - i;
        inc(j);
      end;

[himitsu]

Delphi-Quellcode:

goto NextStep;

=> Continue (das Gegenstück zum Break)

Ansonsten ist diese Schleife, mit dem exit am ende vollkommen vermurkst, wenn das Exit immer die Schleife beendet, ist das schonmal ein guter Hinweis, daß da was nicht stimmt.
Aber wurde ja nun schon umgeschrieben.

PS: Mit goto kann man auch rückwärts springen, was dann das Exit-while-Goto durch ein goto ersetzt hätte. :roll:

[Schorschi5566]

Hallo Himitsu,

da hast du aber übersehen, dass Goto Nextstep an das Ende der äußeren Schleife springt, oder? :)

[Deep-Sea]

Zitat:

Zitat von himitsu (Beitrag 1106393)

[...] wenn das Exit immer die Schleife beendet, ist das schonmal ein guter Hinweis, daß da was nicht stimmt.

Naja, bei einer Suche ist das aber fast die Regel :stupid:
Beispiel:

Delphi-Quellcode:

function FindeEtwas(const AName: String): String;
var
  I: Integer;
begin
  For I := 0 to EineListe.Count - 1 do
  begin
    If EineListe[I].Name = AName then Exit(EineListe[I].Wert);
  end;
  Result := '< Nicht gefunden >';
end;

Wenn ich nicht mit Exit gehen dürfte, müsste ich das "Nicht gefunden" ggf. sinnlos am Anfang zuweisen und dann bei Erfolg einen Block aufmachen und einmal Result zuweisen und Break aufrufen. Imho komplizierter - zumindest seit es das verbesserte Exit gibt *es liebe* :P

[himitsu]

Das IF liegt aber nicht direkt in der Schleife, sondern in dem IF. :wink:

Delphi-Quellcode:

For I := 0 to EineListe.Count - 1 do
begin
  ...
  Exit(...);
end;

Und was sagst du dazu?

PS: Sowas ist oben in den beiden drei verschachtelten Schleifen auch drin, die Mittlere wird niemals durchlaufen, da sie anscheinend (falls ich das richtig seh) immer gleich im ersten Durchgang abgebrochen wird.

[Deep-Sea]

Na das ist dann natürlich sinnlos. Deine Aussage klang halt nur so allgemein :wink:

[himitsu]

ganz dringend: Delphioptionen > Indexprüfung aktivieren

Ich bin mir ganz relativ sehr sicher, daß das nötig sein wird, da dur ganz bestimmt ein paar nette Indexfehler (Buffer Overrun) verbaut hast.

PS: Die letzen zwei Schleifen lassen sich zu einer vereinen, so daß Exit und Goto überflüssig werden.

[Schorschi5566]

Hallo Himitsu,

bin mir gerade nicht sicher ob wir von der selben Codestelle reden. :) NextStep war ja in der Hauptschleife.

Kann man natürlich ohne Goto machen, aber so wie es da steht, würde ich sagen stimmt es und da hilft auch kein Continue. Aber ich verwende Continue eigentlich nie. Continue setzt doch die aktuelle Schleife fort ohne den Rest der Schleife zu durchlaufen, oder? Wäre in dem Fall also die innere Schleife, was falsch wäre. An den Anfang der äußeren Schleife zu springen wäre auch falsch weil dann die Schleifenbedingung nicht abgefragt würde.

Ist aber alles Makulatur, weil ich ja auch das letzte Goto entfernt habe. ;)

Alte Version:

Delphi-Quellcode:

 while (Offset <= iTLen) and (OffSet >= 0) do
  begin
    j := 0; // Anzahl der Übereinstimmungen
    while j < iPLen do
    begin
      if Text[Offset - j * iDir] = Pattern[iOffKorr - j * iDir] then
        inc(j)
      else
      begin
        iBadSkip := FBadTable[Ord(Text[Offset - j * iDir])] + iPLen - j;
        if iBadSkip > FGoodTable[j] then
        begin
          inc(Offset, iBadSkip * iDir); // Bad-Table verwenden
        end
        else
        begin
          inc(Offset, FGoodTable[j] * iDir); // Good-Table verwenden
        end;
        Goto NextStep;
      end;
    end;
    Exit(Offset - iOffKorr + 1);
NextStep:
  end;

Aktuelle Version:

Delphi-Quellcode:

  while (Offset <= iTLen) and (OffSet >= 0) do
  begin
    pcPattern := @Pattern[iOffKorr];
    pcText := @Text[Offset];
    j := 0; // Anzahl der Übereinstimmungen
    while (j < iPLen) and (pcText^ = pcPattern^) do
    begin
      dec(pcPattern, iDir);
      dec(pcText, iDir);
      inc(j)
    end;
    if j < iPLen then
    begin
      iBadSkip := FBadTable[Ord(pcText^)] + iPLen - j;
      if iBadSkip > FGoodTable[j] then
      begin
        inc(Offset, iBadSkip * iDir);
      end
      else
      begin
        inc(Offset, FGoodTable[j] * iDir);
      end;
    end
    else
      Exit(Offset - iOffKorr + 1);
  end;

[Schorschi5566]

Hier nochmal die aktuelle Unit. Danke für eure Tipps. :)

Die Wikipedia-C-Version hatte auch noch andere Fehler.

Neue Version Boyer-Moore für Unicode:
- statisches Array für Bad-Table
- Goto-frei ;)
- Charpointer statt indizierter Zugriff auf Pattern und Text
- $STRINGCHECKS OFF

Wer die Good-Table weglassen möchte, muss im Suchteil eine Abfrage auf iBadSkip < 1 machen und dann um 1 skippen. Je nach Suchmuster (wenige bis keine Suffixe) ist die Suche dann nochmal schneller.
iBadSkip < 1 kann vorkommen, wenn es Teilmatches gibt und der aktuelle nicht gematchte Char aus Text im Teilmatch vorkommt (negativer Offset). Mit Goodtable ist das egal weil die in so einem Fall zuschlägt. Ohne Goodtable und entsprechende Abfrage, hängt die Suche in diesem Fall.


Grüße,
Uwe

Delphi-Quellcode:

unit BoyerMoore;

{$STRINGCHECKS OFF}

interface

uses
  SysUtils;

type
  TDirection = (dForward = 1, dBackward = -1);

  TBoyerMoore = class
  strict private
    FPattern : String;
    FPatternLen : Integer;
    FDir : TDirection;
    FBadTable : array[0..65535] of Integer; // Größe entspricht gewünschtem Alphabet
    FGoodTable : array of Integer;
  public
    function PosBM(const Pattern, Text: String; Offset : Integer = 1; const Dir : TDirection = dForward): Integer; register;
  end;

implementation

{ TBoyerMoore }

// *************
// P  o  s  B  M
// *************
//
// Boyer-Moore Stringsuche
//
// Eingabe:
// --------
// Pattern: Suchtext
//    Text: Text, der durchsucht wird.
//  Offset: Position ab der gesucht werden soll.
//     Dir: Richtung in die gesucht werden soll: dForward = vorwärts dBackward = rückwärts
//
// Rückgabe:
// ---------
// =0: kein Match
// >0: Position des ersten Match
//
function TBoyerMoore.PosBM(const Pattern, Text: String; Offset: Integer;
  const Dir: TDirection): Integer; register;
var
  i, j, k, iDir, iTLen, iOffCorr, iBadSkip : Integer;
  bMatch : Boolean;
  pcPattern, pcSuffix, pcPattFirst, pcText : PChar;
begin
  Result := 0;
  iTLen := Length(Text);
  iDir := Ord(Dir);

  // Good- und Bad-Table nur neu erzeugen, wenn neues Suchmuster verwendet wird
  // oder die Suchrichtung wechselt.
  if (FPattern <> Pattern) or (FDir <> Dir) then
  begin
    // Bad-Table der letzten Suche wieder auf 0 setzen
    pcPattern := PChar(Pointer(FPattern)); // Pattern der vorhergehenden Suche
    pcPattFirst := pcPattern;
    while pcPattern - pcPattFirst < FPatternLen do
    begin
      FBadTable[Ord(pcPattern^)] := 0;
      Inc(pcPattern);
    end;

    FPatternLen := Length(Pattern); // neue Patternlänge merken

    SetLength(FGoodTable, FPatternLen);

    // Sprungtabellen abhängig von der Suchrichtung erzeugen
    case Dir of
      dForward:
      begin
        // Bad-Character-Table vorwärts
        pcPattern := PChar(Pointer(Pattern));
        i := 1;
        while i <= FPatternLen do
        begin
          FBadTable[Ord(pcPattern^)] := - i; // FPatternLen später addieren
          Inc(pcPattern);
          Inc(i);
        end;

        // Good-Suffix-Table vorwärts
        j := 1;
        i := FPatternLen - 1; // Initialisierung für Good-Table vorwärts
        k := 0;
        bMatch := False;
        while j < FPatternLen  do
        begin
          while (i > 0) and (k < j) do
          begin
            if (i - k > 0) then
            begin
              pcPattern := @Pattern[FPatternLen - k];
              pcSuffix := @Pattern[i - k];
              while (k < j) and (i - k > 0) and (pcPattern^ = pcSuffix^) do
              begin
                bMatch := True;
                inc(pcPattern);
                inc(pcSuffix);
                inc(k);
              end;
            end;
            if (k < j) then // kein ganzes Suffix gefunden
            begin
              if (i - k <= 0) then // Ende erreicht, Rest mit MaxSkip füllen
                i := 0 // Maximal-Skip
              else
              begin
                if bMatch then  // kein Match mit dieser Länge...weitersuchen
                begin
                  k := 0; // wieder von vorn
                  bMatch := False;
                end;
                Dec(i);
              end;
            end;
          end;
          FGoodTable[j] := FPatternLen - i;
          inc(j);
        end;
      end;
      dBackward:
      begin
        // Bad-Character-Table rückwärts
        pcPattern := @Pattern[FPatternLen];
        i := FPatternLen;
        while i > 0 do
        begin
          FBadTable[Ord(pcPattern^)] := i - 1 - FPatternLen; // FPatternLen später wieder addieren
          Dec(pcPattern);
          Dec(i);
        end;

        // Good-Suffix-Table rückwärts
        j := 1;
        i := 1; // Initialisierung für Good-Table rückwärts
        k := 1;
        bMatch := False;
        while j < FPatternLen  do
        begin
          while (i < FPatternLen) and (k - 1 < j) do
          begin
            if (i + k < FPatternLen) then
            begin
              pcPattern := @Pattern[k];
              pcSuffix := @Pattern[i + k];
              while (k - 1 < j) and (i + k < FPatternLen) and (pcPattern^ = pcSuffix^) do
              begin
                bMatch := True;
                inc(pcPattern);
                inc(pcSuffix);
                inc(k);
              end;
            end;
            if (k - 1 < j) then // kein ganzes Suffix gefunden
            begin
              if i + k > FPatternLen then // Ende erreicht, Rest mit MaxSkip füllen
                i := FPatternLen // Maximal-Skip
              else
              begin
                if bMatch then  // kein Match mit dieser Länge...weitersuchen
                begin
                  k := 1; // wieder von vorn
                  bMatch := False;
                end;
                Inc(i);
              end;
            end;
          end;
          FGoodTable[j] := i;
          inc(j);
        end;
      end;
    end;

    FPattern := Pattern; // Pattern merken
    FDir := Dir; // Richtung merken
  end;

  if (FPatternLen > iTLen) or (FPatternLen * iTLen = 0) or
     (Offset = 0) or (Offset > iTLen) then
    raise Exception.Create('PosBM: Invalid parameter!');

  Offset := Offset + (FPatternLen - 1) * iDir; // Startoffset
  case Dir of
    dForward:
      iOffCorr := FPatternLen;
    dBackward:
      iOffCorr := 1;
  end;

  // Pattern in Text suchen
  while (Offset <= iTLen) and (OffSet > 0) do
  begin
    pcPattern := @Pattern[iOffCorr];
    pcText := @Text[Offset];
    j := 0; // Anzahl der Übereinstimmungen
    while (j < FPatternLen) and (pcText^ = pcPattern^) do
    begin
      dec(pcPattern, iDir);
      dec(pcText, iDir);
      inc(j);
    end;
    if j < FPatternLen then // Mismatch
    begin
      iBadSkip := FBadTable[Ord(pcText^)] + FPatternLen - j;
      if iBadSkip > FGoodTable[j] then
      begin
        inc(Offset, iBadSkip * iDir);
      end
      else
      begin
        inc(Offset, FGoodTable[j] * iDir);
      end;
    end
    else // Match
      Exit(Offset - iOffCorr + 1);
  end;
end;

end.

[jbg]

Wenn du jetzt noch aus @str[1] ein PChar(str) machst, dann entfällt der UniqueString Aufruf, den der Compiler einstreut. Und wenn du auch noch den PCharFromUStr loswerden willst, dann kannst du PChar(Pointer(str)) machen (der PChar cast ist zwar nicht notwendig, da Pointer zuweisungskompatibel ist, aber ich schreib den zur Lesbarkeit immer hin)
Dabei musst du aber beachten, dass ein Leerstring dann "nil" und nicht #0 liefert.

Übrigens ist dein statisches FBadTable Array um eins zu groß. In Ord(WideChar) passen nur 0..65535. Nicht 65536. ;-)

[Schorschi5566]

Danke, hab's direkt oben eingebaut. :)

Die Good-Table dürfte auch eins zu groß sein, weil bei GoodTable[FPattLen] ein Vollmatch vorliegt. Mache ich später noch...muss aber los. ;)

[jbg]

Zitat:

Zitat von Schorschi5566 (Beitrag 1106687)

Danke, hab's direkt oben eingebaut. :)

Gerade die Performance-technisch unwichtigste Stelle hast zu geändert. Die anderen @Pattern[1] in den Schleifen hast du aber stehen lassen.

[Schorschi5566]

Echt? Habe im Code genau 2x "[1]" gefunden und da habe ich es ersetzt.

[EDIT]Wenn du die Stelle meinst:

Delphi-Quellcode:

    pcPattern := @Pattern[iOffCorr];
    pcText := @Text[Offset];

da habe ich auch so keine Calls mehr drin und 'ne Änderung auf PCHar(Pointer(Text/Pattern)) + Offset bringt 'ne Verschlechterung der Laufzeit. :?
[/EDIT]