program Project1;
uses
SysUtils, StrUtils;
type
SizeIntArray = array of SizeInt;
TReplaceFlags = set of (rfReplaceAll, rfIgnoreCase);
// 从 StrUtils 中复制过来的
procedure FindMatchesBoyerMooreCaseSensitive(const S, OldPattern: PChar;
const SSize, OldPatternSize: SizeInt; out aMatches: SizeIntArray;
const aMatchAll: Boolean);
const
ALPHABET_LENGHT=256;
MATCHESCOUNTRESIZER=100; //Arbitrary value. Memory used = MATCHESCOUNTRESIZER * sizeof(SizeInt)
var
//Stores the amount of replaces that will take place
MatchesCount: SizeInt;
//Currently allocated space for matches.
MatchesAllocatedLimit: SizeInt;
type
AlphabetArray=array [0..ALPHABET_LENGHT-1] of SizeInt;
function Max(const a1,a2: SizeInt): SizeInt;
begin
if a1>a2 then Result:=a1 else Result:=a2;
end;
procedure MakeDeltaJumpTable1(out DeltaJumpTable1: AlphabetArray; const aPattern: PChar; const aPatternSize: SizeInt);
var
i: SizeInt;
begin
for i := 0 to ALPHABET_LENGHT-1 do begin
DeltaJumpTable1[i]:=aPatternSize;
end;
//Last char do not enter in the equation
for i := 0 to aPatternSize - 1 - 1 do begin
DeltaJumpTable1[Ord(aPattern[i])]:=aPatternSize -1 - i;
end;
end;
function IsPrefix(const aPattern: PChar; const aPatternSize, aPos: SizeInt): Boolean;
var
i: SizeInt;
SuffixLength: SizeInt;
begin
SuffixLength:=aPatternSize-aPos;
for i := 0 to SuffixLength-1 do begin
if (aPattern[i] <> aPattern[aPos+i]) then begin
exit(false);
end;
end;
Result:=true;
end;
function SuffixLength(const aPattern: PChar; const aPatternSize, aPos: SizeInt): SizeInt;
var
i: SizeInt;
begin
i:=0;
while (aPattern[aPos-i] = aPattern[aPatternSize-1-i]) and (i < aPos) do begin
inc(i);
end;
Result:=i;
end;
procedure MakeDeltaJumpTable2(var DeltaJumpTable2: SizeIntArray; const aPattern: PChar; const aPatternSize: SizeInt);
var
Position: SizeInt;
LastPrefixIndex: SizeInt;
SuffixLengthValue: SizeInt;
begin
LastPrefixIndex:=aPatternSize-1;
Position:=aPatternSize-1;
while Position>=0 do begin
if IsPrefix(aPattern,aPatternSize,Position+1) then begin
LastPrefixIndex := Position+1;
end;
DeltaJumpTable2[Position] := LastPrefixIndex + (aPatternSize-1 - Position);
Dec(Position);
end;
Position:=0;
while Position<aPatternSize
-1 do begin SuffixLengthValue:=SuffixLength(aPattern,aPatternSize,Position);
if aPattern[Position-SuffixLengthValue] <> aPattern[aPatternSize-1 - SuffixLengthValue] then begin
DeltaJumpTable2[aPatternSize - 1 - SuffixLengthValue] := aPatternSize - 1 - Position + SuffixLengthValue;
end;
Inc(Position);
end;
end;
//Resizes the allocated space for replacement index
procedure ResizeAllocatedMatches;
begin
MatchesAllocatedLimit:=MatchesCount+MATCHESCOUNTRESIZER;
SetLength(aMatches,MatchesAllocatedLimit);
end;
//Add a match to be replaced
procedure AddMatch(const aPosition: SizeInt); inline;
begin
if MatchesCount = MatchesAllocatedLimit then begin
ResizeAllocatedMatches;
end;
aMatches[MatchesCount]:=aPosition;
inc(MatchesCount);
end;
var
i,j: SizeInt;
DeltaJumpTable1: array [0..ALPHABET_LENGHT-1] of SizeInt;
DeltaJumpTable2: SizeIntArray;
begin
MatchesCount:=0;
MatchesAllocatedLimit:=0;
SetLength(aMatches,MatchesCount);
if OldPatternSize=0 then begin
Exit;
end;
SetLength(DeltaJumpTable2,OldPatternSize);
MakeDeltaJumpTable1(DeltaJumpTable1,OldPattern,OldPatternSize);
MakeDeltaJumpTable2(DeltaJumpTable2,OldPattern,OldPatternSize);
i:=OldPatternSize-1;
while i < SSize do begin
j:=OldPatternSize-1;
while (j>=0) and (S[i] = OldPattern[j]) do begin
dec(i);
dec(j);
end;
if (j<0) then begin
AddMatch(i+1);
//Only first match ?
if not aMatchAll then break;
inc(i,OldPatternSize);
inc(i,OldPatternSize);
end else begin
i:=i + Max(DeltaJumpTable1[ord(s[i])],DeltaJumpTable2[j]);
end;
end;
SetLength(aMatches,MatchesCount);
end;
// 从 StrUtils 中复制过来的（I modified the line 189）
procedure FindMatchesBoyerMooreCaseINSensitive(const S, OldPattern: PChar;
const SSize, OldPatternSize: SizeInt; out aMatches: SizeIntArray;
const aMatchAll: Boolean);
const
ALPHABET_LENGHT=256;
MATCHESCOUNTRESIZER=100; //Arbitrary value. Memory used = MATCHESCOUNTRESIZER * sizeof(SizeInt)
var
//Lowercased OldPattern
lPattern: string;
//Array of lowercased alphabet
lCaseArray: array [0..ALPHABET_LENGHT-1] of char;
//Stores the amount of replaces that will take place
MatchesCount: SizeInt;
//Currently allocated space for matches.
MatchesAllocatedLimit: SizeInt;
type
AlphabetArray=array [0..ALPHABET_LENGHT-1] of SizeInt;
function Max(const a1,a2: SizeInt): SizeInt;
begin
if a1>a2 then Result:=a1 else Result:=a2;
end;
procedure MakeDeltaJumpTable1(out DeltaJumpTable1: AlphabetArray; const aPattern: PChar; const aPatternSize: SizeInt);
var
i: SizeInt;
begin
for i := 0 to ALPHABET_LENGHT-1 do begin
DeltaJumpTable1[i]:=aPatternSize;
end;
//Last char do not enter in the equation
for i := 0 to aPatternSize - 1 - 1 do begin
DeltaJumpTable1[Ord(aPattern[i])]:=aPatternSize - 1 - i;
end;
end;
function IsPrefix(const aPattern: PChar; const aPatternSize, aPos: SizeInt): Boolean; inline;
var
i: SizeInt;
SuffixLength: SizeInt;
begin
SuffixLength:=aPatternSize-aPos;
for i := 0 to SuffixLength-1 do begin
if (aPattern[i] <> aPattern[aPos+i]) then begin // *** I modified this line ***
exit(false);
end;
end;
Result:=true;
end;
function SuffixLength(const aPattern: PChar; const aPatternSize, aPos: SizeInt): SizeInt; inline;
var
i: SizeInt;
begin
i:=0;
while (aPattern[aPos-i] = aPattern[aPatternSize-1-i]) and (i < aPos) do begin
inc(i);
end;
Result:=i;
end;
procedure MakeDeltaJumpTable2(var DeltaJumpTable2: SizeIntArray; const aPattern: PChar; const aPatternSize: SizeInt);
var
Position: SizeInt;
LastPrefixIndex: SizeInt;
SuffixLengthValue: SizeInt;
begin
LastPrefixIndex:=aPatternSize-1;
Position:=aPatternSize-1;
while Position>=0 do begin
if IsPrefix(aPattern,aPatternSize,Position+1) then begin
LastPrefixIndex := Position+1;
end;
DeltaJumpTable2[Position] := LastPrefixIndex + (aPatternSize-1 - Position);
Dec(Position);
end;
Position:=0;
while Position<aPatternSize
-1 do begin SuffixLengthValue:=SuffixLength(aPattern,aPatternSize,Position);
if aPattern[Position-SuffixLengthValue] <> aPattern[aPatternSize-1 - SuffixLengthValue] then begin
DeltaJumpTable2[aPatternSize - 1 - SuffixLengthValue] := aPatternSize - 1 - Position + SuffixLengthValue;
end;
Inc(Position);
end;
end;
//Resizes the allocated space for replacement index
procedure ResizeAllocatedMatches;
begin
MatchesAllocatedLimit:=MatchesCount+MATCHESCOUNTRESIZER;
SetLength(aMatches,MatchesAllocatedLimit);
end;
//Add a match to be replaced
procedure AddMatch(const aPosition: SizeInt); inline;
begin
if MatchesCount = MatchesAllocatedLimit then begin
ResizeAllocatedMatches;
end;
aMatches[MatchesCount]:=aPosition;
inc(MatchesCount);
end;
var
i,j: SizeInt;
DeltaJumpTable1: array [0..ALPHABET_LENGHT-1] of SizeInt;
DeltaJumpTable2: SizeIntArray;
//Pointer to lowered OldPattern
plPattern: PChar;
begin
MatchesCount:=0;
MatchesAllocatedLimit:=0;
SetLength(aMatches,MatchesCount);
if OldPatternSize=0 then begin
Exit;
end;
//Build an internal array of lowercase version of every possible char.
for j := 0 to Pred(ALPHABET_LENGHT) do begin
lCaseArray[j]:=AnsiLowerCase(char(j))[1];
end;
//Create the new lowercased pattern
SetLength(lPattern,OldPatternSize);
for j := 0 to Pred(OldPatternSize) do begin
lPattern[j+1]:=lCaseArray[ord(OldPattern[j])];
end;
SetLength(DeltaJumpTable2,OldPatternSize);
MakeDeltaJumpTable1(DeltaJumpTable1,@lPattern[1],OldPatternSize);
MakeDeltaJumpTable2(DeltaJumpTable2,@lPattern[1],OldPatternSize);
plPattern:=@lPattern[1];
i:=OldPatternSize-1;
while i < SSize do begin
j:=OldPatternSize-1;
while (j>=0) and (lCaseArray[Ord(S[i])] = plPattern[j]) do begin
dec(i);
dec(j);
end;
if (j<0) then begin
AddMatch(i+1);
//Only first match ?
if not aMatchAll then break;
inc(i,OldPatternSize);
inc(i,OldPatternSize);
end else begin
i:=i + Max(DeltaJumpTable1[Ord(lCaseArray[Ord(s[i])])],DeltaJumpTable2[j]);
end;
end;
SetLength(aMatches,MatchesCount);
end;
// 从 StrUtils 中复制过来的
procedure FindMatchesBoyerMooreCaseSensitive(const S,OldPattern: String; out aMatches: SizeIntArray; const aMatchAll: Boolean);
Var
I : SizeInt;
begin
FindMatchesBoyerMooreCaseSensitive(PChar(S),Pchar(OldPattern),Length(S),Length(OldPattern),aMatches,aMatchAll);
For I:=0 to pred(Length(AMatches)) do
Inc(AMatches[i]);
end;
// 从 StrUtils 中复制过来的
procedure FindMatchesBoyerMooreCaseInSensitive(const S, OldPattern: String; out aMatches: SizeIntArray; const aMatchAll: Boolean);
Var
I : SizeInt;
begin
FindMatchesBoyerMooreCaseInSensitive(PChar(S),Pchar(OldPattern),Length(S),Length(OldPattern),aMatches,aMatchAll);
For I:=0 to pred(Length(AMatches)) do
Inc(AMatches[i]);
end;
// 从 StrUtils 中复制过来的
function StringReplaceBoyerMoore(const S, OldPattern, NewPattern: string;Flags: TReplaceFlags): string;
var
Matches: SizeIntArray;
OldPatternSize: SizeInt;
NewPatternSize: SizeInt;
MatchesCount: SizeInt;
MatchIndex: SizeInt;
MatchTarget: SizeInt;
MatchInternal: SizeInt;
AdvanceIndex: SizeInt;
begin
OldPatternSize:=Length(OldPattern);
NewPatternSize:=Length(NewPattern);
if (OldPattern='') or (Length(OldPattern)>Length(S)) then begin
Result:=S;
exit;
end;
if rfIgnoreCase in Flags then begin
FindMatchesBoyerMooreCaseINSensitive(@s[1],@OldPattern[1],Length(S),Length(OldPattern),Matches, rfReplaceAll in Flags);
end else begin
FindMatchesBoyerMooreCaseSensitive(@s[1],@OldPattern[1],Length(S),Length(OldPattern),Matches, rfReplaceAll in Flags);
end;
MatchesCount:=Length(Matches);
//Create room enougth for the result string
SetLength(Result,Length(S)-OldPatternSize*MatchesCount+NewPatternSize*MatchesCount);
MatchIndex:=1;
MatchTarget:=1;
//Matches[x] are 0 based offsets
for MatchInternal := 0 to Pred(MatchesCount) do begin
//Copy information up to next match
AdvanceIndex:=Matches[MatchInternal]+1-MatchIndex;
if AdvanceIndex>0 then begin
move(S[MatchIndex],Result[MatchTarget],AdvanceIndex);
inc(MatchTarget,AdvanceIndex);
inc(MatchIndex,AdvanceIndex);
end;
//Copy the new replace information string
if NewPatternSize>0 then begin
move(NewPattern[1],Result[MatchTarget],NewPatternSize);
inc(MatchTarget,NewPatternSize);
end;
inc(MatchIndex,OldPatternSize);
end;
if MatchTarget<=Length(Result) then begin
//Add remain data at the end of source.
move(S[MatchIndex],Result[MatchTarget],Length(Result)-MatchTarget+1);
end;
end;
var
i: Integer;
S: string;
Matches: SizeIntArray;
begin
S := ' 空 空 空 空 空 空';
StrUtils.FindMatchesBoyerMooreCaseSensitive(S, ' ', Matches, true);
for i := 0 to High(Matches) do
write(Matches[i], ' ');
writeln;
StrUtils.FindMatchesBoyerMooreCaseInSensitive(S, ' ', Matches, true);
for i := 0 to High(Matches) do
write(Matches[i], ' ');
writeln;
writeln('----------');
FindMatchesBoyerMooreCaseSensitive(S, ' ', Matches, true);
for i := 0 to High(Matches) do
write(Matches[i], ' ');
writeln;
FindMatchesBoyerMooreCaseInSensitive(S, ' ', Matches, true);
for i := 0 to High(Matches) do
write(Matches[i], ' ');
writeln;
writeln(StringReplaceBoyerMoore(S, ' ', '', [rfReplaceAll, rfIgnoreCase]));
end.
Recent
