Dynamische Arrays "verketten"

[Bjoerk]

Den Boyer-Moore kannte ich nicht. Deshalb hab ich mich mal etwas eingearbeitet und den Algo von da überarbeitet, erweitert und getestet. Tut. In machen Fällen ist er so 2..5 mal schneller. Es gibt einen Parameter IgnoreCase. Ob der dabei in der LowCase angenommene Unterschied von 32 in der Codepage auch für UTF-8 bzw. 16 noch stimmt weiß ich nicht. Ggf. anpassen. Wäre schön wenn sich jemand findet der nach asm übersetzt (vermutlich dann wohl procedural), dann könnte man mal mit der PosEx_JOH_IA32_8_b aus der FastPosEx vergleichen?

Delphi-Quellcode:

  TBoyerMoore = class
  private
    class function LowCase(const C: char): char;
    class function SameChar(const A, B: char; const IgnoreCase: boolean): boolean;
  public
    class function PosEx(const SubStr, S: string;
      const Index: integer = 1; const IgnoreCase: boolean = false): integer;
  end;

..

{ TBoyerMoore }

class function TBoyerMoore.LowCase(const C: char): char;
const
  CharSet: TSysCharSet = ['A'..'Z', 'Ä', 'Ö', 'Ü'];
begin
  if C in CharSet then // if CharInSet(C, CharSet) then
    Result := Char(Ord(C) + 32) // 32 ??? bei UTF-8, UTF-16
  else
    Result := C;
end;

class function TBoyerMoore.SameChar(const A, B: char; const IgnoreCase: boolean): boolean;
begin
  if IgnoreCase then
    Result := LowCase(A) = LowCase(B)
  else
    Result := A = B;
end;

class function TBoyerMoore.PosEx(const SubStr, S: string;
  const Index: integer; const IgnoreCase: boolean): integer;
var
  I, J, K, N, M: integer;
  C: char;
  Skip: array[Char] of integer;
begin
  Result := 0;
  N := Length(S);
  M := Length(SubStr);
  if (Index > 0) and (N > 0) and (M > 0) and (Index <= N - M + 1) then
  begin
    for C := Low(Char) to High(Char) do
      Skip[C] := M;
    if not IgnoreCase then
      for K := 1 to M - 1 do
        Skip[SubStr[K]] := M - K
    else
      for K := 1 to M - 1 do
        Skip[LowCase(SubStr[K])] := M - K;
    K := M + Index - 1;
    while (Result = 0) and (K <= N) do
    begin
      I := K;
      J := M;
      while (J > 0) and SameChar(S[I], SubStr[J], IgnoreCase) do
      begin
        Dec(J);
        Dec(I);
      end;
      if J = 0 then
        Result := I + 1
      else
        if not IgnoreCase then
          K := K + Skip[S[K]]
        else
          K := K + Skip[LowCase(S[K])];
    end;
  end;
end;