Этот ответ теперь завершен и работает для чувствительного к регистру режима, но не работает для нечувствительного к регистру режима и, вероятно, имеет и другие ошибки, так как он не очень хорошо тестируется модулем, и, вероятно, может быть оптимизирован в дальнейшем, например, я повторил локальная функция __SameChar вместо использования обратного вызова функции сравнения, который был бы быстрее, и фактически, позволяя пользователю передавать функцию сравнения для всех этих функций, было бы здорово для пользователей Unicode, которые хотят предоставить некоторую дополнительную логику (эквивалентные наборы символов Unicode для некоторых языков).
Основываясь на коде Дорина Доминики, я построил следующее.
{ _FindStringBoyer:
Boyer-Moore search algorith using regular String instead of AnsiSTring, and no ASM.
Credited to Dorin Duminica.
}
function _FindStringBoyer(const sString, sPattern: string;
const bCaseSensitive: Boolean = True; const fromPos: Integer = 1): Integer;
function __SameChar(StringIndex, PatternIndex: Integer): Boolean;
begin
if bCaseSensitive then
Result := (sString[StringIndex] = sPattern[PatternIndex])
else
Result := (CompareText(sString[StringIndex], sPattern[PatternIndex]) = 0);
end; // function __SameChar(StringIndex, PatternIndex: Integer): Boolean;
var
SkipTable: array [Char] of Integer;
LengthPattern: Integer;
LengthString: Integer;
Index: Integer;
kIndex: Integer;
LastMarker: Integer;
Large: Integer;
chPattern: Char;
begin
if fromPos < 1 then
raise Exception.CreateFmt('Invalid search start position: %d.', [fromPos]);
LengthPattern := Length(sPattern);
LengthString := Length(sString);
for chPattern := Low(Char) to High(Char) do
SkipTable[chPattern] := LengthPattern;
for Index := 1 to LengthPattern -1 do
SkipTable[sPattern[Index]] := LengthPattern - Index;
Large := LengthPattern + LengthString + 1;
LastMarker := SkipTable[sPattern[LengthPattern]];
SkipTable[sPattern[LengthPattern]] := Large;
Index := fromPos + LengthPattern -1;
Result := 0;
while Index <= LengthString do begin
repeat
Index := Index + SkipTable[sString[Index]];
until Index > LengthString;
if Index <= Large then
Break
else
Index := Index - Large;
kIndex := 1;
while (kIndex < LengthPattern) and __SameChar(Index - kIndex, LengthPattern - kIndex) do
Inc(kIndex);
if kIndex = LengthPattern then begin
// Found, return.
Result := Index - kIndex + 1;
Index := Index + LengthPattern;
exit;
end else begin
if __SameChar(Index, LengthPattern) then
Index := Index + LastMarker
else
Index := Index + SkipTable[sString[Index]];
end; // if kIndex = LengthPattern then begin
end; // while Index <= LengthString do begin
end;
{ Written by Warren, using the above code as a starter, we calculate the SkipTable once, and then count the number of instances of
a substring inside the main string, at a much faster rate than we
could have done otherwise. Another thing that would be great is
to have a function that returns an array of find-locations,
which would be way faster to do than repeatedly calling Pos.
}
function _StringCountBoyer(const aSourceString, aFindString : String; Const CaseSensitive : Boolean = TRUE) : Integer;
var
foundPos:Integer;
fromPos:Integer;
Limit:Integer;
guard:Integer;
SkipTable: array [Char] of Integer;
LengthPattern: Integer;
LengthString: Integer;
Index: Integer;
kIndex: Integer;
LastMarker: Integer;
Large: Integer;
chPattern: Char;
function __SameChar(StringIndex, PatternIndex: Integer): Boolean;
begin
if CaseSensitive then
Result := (aSourceString[StringIndex] = aFindString[PatternIndex])
else
Result := (CompareText(aSourceString[StringIndex], aFindString[PatternIndex]) = 0);
end; // function __SameChar(StringIndex, PatternIndex: Integer): Boolean;
begin
result := 0;
foundPos := 1;
fromPos := 1;
Limit := Length(aSourceString);
guard := Length(aFindString);
Index := 0;
LengthPattern := Length(aFindString);
LengthString := Length(aSourceString);
for chPattern := Low(Char) to High(Char) do
SkipTable[chPattern] := LengthPattern;
for Index := 1 to LengthPattern -1 do
SkipTable[aFindString[Index]] := LengthPattern - Index;
Large := LengthPattern + LengthString + 1;
LastMarker := SkipTable[aFindString[LengthPattern]];
SkipTable[aFindString[LengthPattern]] := Large;
while (foundPos>=1) and (fromPos < Limit) and (Index<Limit) do begin
Index := fromPos + LengthPattern -1;
if Index>Limit then
break;
kIndex := 0;
while Index <= LengthString do begin
repeat
Index := Index + SkipTable[aSourceString[Index]];
until Index > LengthString;
if Index <= Large then
Break
else
Index := Index - Large;
kIndex := 1;
while (kIndex < LengthPattern) and __SameChar(Index - kIndex, LengthPattern - kIndex) do
Inc(kIndex);
if kIndex = LengthPattern then begin
// Found, return.
//Result := Index - kIndex + 1;
Index := Index + LengthPattern;
fromPos := Index;
Inc(Result);
break;
end else begin
if __SameChar(Index, LengthPattern) then
Index := Index + LastMarker
else
Index := Index + SkipTable[aSourceString[Index]];
end; // if kIndex = LengthPattern then begin
end; // while Index <= LengthString do begin
end;
end;
Это действительно хороший алгоритм, потому что:
- гораздо быстрее подсчитать количество экземпляров подстроки X в строке Y, великолепно так.
- Для простой замены Pos () _FindStringBoyer () работает быстрее, чем версия Pos () с чистой asm, добавленная в Delphi людьми проекта FastCode, которая в настоящее время используется для Pos, и если вам нужна нечувствительность к регистру, вы можете представьте себе повышение производительности, когда нам не нужно вызывать UpperCase для строки размером 100 мегабайт. (Хорошо, ваши строки не будут такими большими. Но, тем не менее, эффективные алгоритмы - это красота.)
Хорошо, я написал String Replace в стиле Бойера-Мура:
function _StringReplaceBoyer(const aSourceString, aFindString,aReplaceString : String; Flags: TReplaceFlags) : String;
var
errors:Integer;
fromPos:Integer;
Limit:Integer;
guard:Integer;
SkipTable: array [Char] of Integer;
LengthPattern: Integer;
LengthString: Integer;
Index: Integer;
kIndex: Integer;
LastMarker: Integer;
Large: Integer;
chPattern: Char;
CaseSensitive:Boolean;
foundAt:Integer;
lastFoundAt:Integer;
copyStartsAt:Integer;
copyLen:Integer;
function __SameChar(StringIndex, PatternIndex: Integer): Boolean;
begin
if CaseSensitive then
Result := (aSourceString[StringIndex] = aFindString[PatternIndex])
else
Result := (CompareText(aSourceString[StringIndex], aFindString[PatternIndex]) = 0);
end; // function __SameChar(StringIndex, PatternIndex: Integer): Boolean;
begin
result := '';
lastFoundAt := 0;
fromPos := 1;
errors := 0;
CaseSensitive := rfIgnoreCase in Flags;
Limit := Length(aSourceString);
guard := Length(aFindString);
Index := 0;
LengthPattern := Length(aFindString);
LengthString := Length(aSourceString);
for chPattern := Low(Char) to High(Char) do
SkipTable[chPattern] := LengthPattern;
for Index := 1 to LengthPattern -1 do
SkipTable[aFindString[Index]] := LengthPattern - Index;
Large := LengthPattern + LengthString + 1;
LastMarker := SkipTable[aFindString[LengthPattern]];
SkipTable[aFindString[LengthPattern]] := Large;
while (fromPos>=1) and (fromPos <= Limit) and (Index<=Limit) do begin
Index := fromPos + LengthPattern -1;
if Index>Limit then
break;
kIndex := 0;
foundAt := 0;
while Index <= LengthString do begin
repeat
Index := Index + SkipTable[aSourceString[Index]];
until Index > LengthString;
if Index <= Large then
Break
else
Index := Index - Large;
kIndex := 1;
while (kIndex < LengthPattern) and __SameChar(Index - kIndex, LengthPattern - kIndex) do
Inc(kIndex);
if kIndex = LengthPattern then begin
foundAt := Index - kIndex + 1;
Index := Index + LengthPattern;
//fromPos := Index;
fromPos := (foundAt+LengthPattern);
if lastFoundAt=0 then begin
copyStartsAt := 1;
copyLen := foundAt-copyStartsAt;
end else begin
copyStartsAt := lastFoundAt+LengthPattern;
copyLen := foundAt-copyStartsAt;
end;
if (copyLen<=0)or(copyStartsAt<=0) then begin
Inc(errors);
end;
Result := Result + Copy(aSourceString, copyStartsAt, copyLen ) + aReplaceString;
lastFoundAt := foundAt;
if not (rfReplaceAll in Flags) then
fromPos := 0; // break out of outer while loop too!
break;
end else begin
if __SameChar(Index, LengthPattern) then
Index := Index + LastMarker
else
Index := Index + SkipTable[aSourceString[Index]];
end; // if kIndex = LengthPattern then begin
end; // while Index <= LengthString do begin
end;
if (lastFoundAt=0) then
begin
// nothing was found, just return whole original string
Result := aSourceString;
end
else
if (lastFoundAt+LengthPattern < Limit) then begin
// the part that didn't require any replacing, because nothing more was found,
// or rfReplaceAll flag was not specified, is copied at the
// end as the final step.
copyStartsAt := lastFoundAt+LengthPattern;
copyLen := Limit; { this number can be larger than needed to be, and it is harmless }
Result := Result + Copy(aSourceString, copyStartsAt, copyLen );
end;
end;
Хорошо, проблема: размер стека:
var
skiptable : array [Char] of Integer; // 65536*4 bytes stack usage on Unicode delphi
Прощай, черт возьми, привет, черт возьми. Если я выберу динамический массив, мне придется изменить его размер во время выполнения. Таким образом, эта вещь в основном быстрая, потому что система виртуальной памяти на вашем компьютере не мигает при 256 КБ в стеке, но это не всегда оптимальный кусок кода. Тем не менее, мой компьютер не мигает при большом стеке, как это. Это не станет стандартной библиотекой Delphi по умолчанию или победой в любом вызове fastcode в будущем. Я думаю, что повторный поиск - это тот случай, когда приведенный выше код должен быть написан как класс, а пропускаемая таблица должна быть полем данных в этом классе. Затем вы можете создать таблицу Бойера-Мура один раз, а со временем, если строка инвариантна, повторно использовать этот объект для быстрого поиска.