Boyer-Moore für Unicode

[Deep-Sea]

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

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

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]