function IsAnagram_benibela(const S1, S2: String; IgnoreSpaces: Boolean = True; ExceptionOnError: Boolean = False): Boolean;
const ALWAYS_RETURN_FALSE_ON_INVALID_INPUT = true;
type
TFreqLittle = array [0..255] of byte;
TFreqBig = array [0..255] of integer;
TLowTableEntry = byte;
TLowTable = array [0..255] of TLowTableEntry;
PLowTableEntry = ^TLowTableEntry;
const
FLow: TLowTable = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60,
61, 62, 63, 64,
97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120,
121, 122, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, 113,
114, 115, 116, 117, 118, 119, 120, 121, 122, 123, 124, 125, 126, 127,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
var isinvalid: boolean = false;
procedure err(const s: string);
begin
isinvalid := ALWAYS_RETURN_FALSE_ON_INVALID_INPUT;
if ExceptionOnError then
Raise ERangeError.CreateFmt('IsAnagram: illegal character in string: %s', [s]);
end;
procedure countLittle(var F: TFreqLittle; const s: string);
var
p,palign,pend: pchar;
block: DWord;
low: PLowTableEntry;
buf: PQWord;
begin
buf := @F[32];
buf[0] := 0; buf[1] := 0; buf[2] := 0; buf[3] := 0;
buf[4] := 0; buf[5] := 0; buf[6] := 0; buf[7] := 0;
buf[8] := 0; buf[9] := 0; buf[10] := 0; buf[11] := 0;
F[0]:=0;
low := @flow[0];
p := pointer(s);
pend := p + length(s);
if p + 32 < pend then begin
palign := pointer(ptruint(pend) and not (sizeof(block) - 1));
while p < palign do begin
block := PUInt32(p)^;
inc(F[low[block and $FF]]);
inc(F[low[( block shr 8 ) and $FF]]);
inc(F[low[( block shr 16 ) and $FF]]);
inc(F[low[( block shr 24 ) and $FF]]);
inc(p,sizeof(block));
end;
end;
while p < pend do
begin
inc(F[low[ord(p^)]]);
inc(p);
end;
if ALWAYS_RETURN_FALSE_ON_INVALID_INPUT or ExceptionOnError then
if F[0] > 0 then err(s);
end;
procedure countBig(var F: TFreqBig; const s: string);
var
p,palign,pend: pchar;
block: {$ifdef cpu64} QWord {$else} DWord{$endif};
c: Integer;
begin
f := default(TFreqBig);
p := pointer(s);
pend := p + length(s);
if p + 32 < pend then begin
palign := pointer(ptruint(pend) and not (sizeof(block) - 1));
while p < palign do begin
block := {$ifdef cpu64} PUInt64(p)^ {$else} PUInt32(p)^{$endif};
inc(F[block and $FF]);
inc(F[( block shr 8 ) and $FF]);
inc(F[( block shr 16 ) and $FF]);
inc(F[( block shr 24 ) and $FF]);
{$ifdef cpu64}
inc(F[( block shr 32 ) and $FF]);
inc(F[( block shr 40 ) and $FF]);
inc(F[( block shr 48 ) and $FF]);
inc(F[( block shr 56 ) and $FF]);
{$endif}
inc(p,sizeof(block));
end;
end;
while p < pend do
begin
inc(F[ord(p^)]);
inc(p);
end;
for c := ord('a') to ord('z') do begin
F[c and not $20] += F[c];
F[c] := 0;
end;
if ALWAYS_RETURN_FALSE_ON_INVALID_INPUT or ExceptionOnError then begin
for c := 0 to ord(' ') - 1 do if F[c] <> 0 then err(s);
for c := 128 to 255 do if F[c] <> 0 then begin err(s); break; end;
end;
end;
var
F1l,F2l: TFreqLittle;
buf1l,buf2l: PQWord;
F1b,F2b: TFreqBig;
i: Integer;
begin
if (IgnoreSpaces = false) and (ExceptionOnError = false) and (length(s1) <> length(s2)) then
exit(false);
if (length(s1) < 255) and (length(s2) < 255) then begin
countLittle(F1l, S1);
countLittle(F2l, S2);
if isinvalid then exit(false);
if IgnoreSpaces then F1l[ord(' ')] := F2l[ord(' ')];
buf1l := @F1l[32]; buf2l := @F2l[32];
result := (buf1l[0] = buf2l[0]) and (buf1l[1] = buf2l[1]) and (buf1l[2] = buf2l[2]) and (buf1l[3] = buf2l[3])
and (buf1l[4] = buf2l[4]) and (buf1l[5] = buf2l[5]) and (buf1l[6] = buf2l[6]) and (buf1l[7] = buf2l[7])
and (buf1l[8] = buf2l[8]) and (buf1l[9] = buf2l[9]) and (buf1l[10] = buf2l[10]) and (buf1l[11] = buf2l[11]);
;
end else begin
countBig(F1b, S1);
countBig(F2b, S2);
if isinvalid then exit(false);
for i := ord(' ')+ord(IgnoreSpaces) to 127 do
if f1b[i] <> f2b[i] then exit(false);
result := true
end;
end;