program app;
// on WINDOWS use QueryPerformanceCounter
{$ifdef WINDOWS}
uses SysUtils, Windows;
function GetTickCount64: QWord;
const
freq: int64 = 0;
begin
if freq = 0 then QueryPerformanceFrequency(@freq);
QueryPerformanceCounter(@result);
result := trunc((result / freq) * 1000);
end;
{$else}
uses SysUtils;
{$endif}
function IsAnagram(const S1, S2: String; IgnoreSpaces: Boolean = True; ExceptionOnError: Boolean = False): Boolean;
type
TFreq = array[#32..#127] of Integer;
const
AllowedChars = [#32..#127];
var
i,SpaceCnt: Integer;
F1, F2: TFreq;
Ch: Char;
begin
Result := False;
F1 := Default(TFreq);
SpaceCnt := 0;
for i := 1 to Length(S1) do
begin
Ch := LowerCase(S1[i]);
if (Ch in AllowedChars) then
begin
if (Ch = #32) then
Inc(SpaceCnt)
else
Inc(F1[Ch]);
end
else
begin
if ExceptionOnError then
Raise ERangeError.CreateFmt('IsAnagram: illegal character in S1 at position %d',[i]);
Exit;
end;
end;
F2 := Default(TFreq);
for i := 1 to Length(S2) do
begin
Ch := LowerCase(S2[i]);
if (Ch in AllowedChars) then
begin
if (Ch = #32) then
Dec(SpaceCnt)
else
Inc(F2[Ch]);
end
else
begin
if ExceptionOnError then
Raise ERangeError.CreateFmt('IsAnagram: illegal character in S2 at position %d',[i]);
Exit;
end;
end;
Result := IgnoreSpaces or (SpaceCnt = 0);
if Result then
Result := CompareMem(@F1, @F2, SizeOf(TFreq));
end;
function IsAnagram_fibo(const S1, S2: String; IgnoreSpaces: Boolean = True; ExceptionOnError: Boolean = False): Boolean;
var
F1, F2: array[97..122] of Byte;
i, SpaceCnt: Integer;
Ch1, Ch2: Byte;
begin
FillChar(F1, SizeOf(F1), 0);
FillChar(F2, SizeOf(F2), 0);
SpaceCnt := 0;
result := True;
for i := 1 to Length(S1) do begin
Ch1 := Ord(S1[i]);
if (Ch1 < 32) or (Ch1 > 127) then if ExceptionOnError then
Raise ERangeError.CreateFmt('IsAnagram: illegal character in S1 at position %d', [i])
else exit;
if Ch1 = 32 then begin
Inc(SpaceCnt);
continue;
end;
if Ch1 >= 65 then if Ch1 <= 90 then Inc(F1[Ch1 or $20]) else if Ch1 >= 97 then if Ch1 <= 122 then Inc(F1[Ch1]);
end;
for i := 1 to Length(S2) do begin
Ch2 := Ord(S2[i]);
if (Ch2 < 32) or (Ch2 > 127) then if ExceptionOnError then
Raise ERangeError.CreateFmt('IsAnagram: illegal character in S2 at position %d', [i])
else exit;
if Ch2 = 32 then begin
Dec(SpaceCnt);
continue;
end;
if Ch2 >= 65 then if Ch2 <= 90 then Inc(F2[Ch2 or $20]) else if Ch2 >= 97 then if Ch2 <= 122 then Inc(F2[Ch2]);
end;
result := (IgnoreSpaces or (SpaceCnt = 0)) and CompareMem(@F1, @F2, SizeOf(F1));
end;
procedure main;
const
ITERATIONS = 1000*1000*5;
var
i, c: integer;
s, d: string;
u: ptruint;
begin
s := 'St a te';
d := 'tas t e';
writeln('*** ROUND 1 ***');
writeln('s1 = ', s);
writeln('s2 = ', d);
writeln;
// test with invalid characters
//s += #1; d += #2;
// -------------------------------------
write('Bart: IgnoreSpaces + ExceptionOnError':50);
c := 0;
u := GetTickCount64;
for i := 1 to ITERATIONS do if IsAnagram(s, d, true, true) then c += 1;
write(' | ', (GetTickCount64-u):4, ' ms');
write(' | result ', c);
writeln;
// -------------------------------------
write('Fibonacci: IgnoreSpaces + ExceptionOnError':50);
c := 0;
u := GetTickCount64;
for i := 1 to ITERATIONS do if IsAnagram_fibo(s, d, true, true) then c += 1;
write(' | ', (GetTickCount64-u):4, ' ms');
write(' | result ', c);
writeln;
// -------------------------------------
write('Bart: IgnoreSpaces':50);
c := 0;
u := GetTickCount64;
for i := 1 to ITERATIONS do if IsAnagram(s, d, true, false) then c += 1;
write(' | ', (GetTickCount64-u):4, ' ms');
write(' | result ', c);
writeln;
// -------------------------------------
write('Fibonacci: IgnoreSpaces':50);
c := 0;
u := GetTickCount64;
for i := 1 to ITERATIONS do if IsAnagram_fibo(s, d, true, false) then c += 1;
write(' | ', (GetTickCount64-u):4, ' ms');
write(' | result ', c);
writeln;
// -------------------------------------
write('Bart':50);
c := 0;
u := GetTickCount64;
for i := 1 to ITERATIONS do if IsAnagram(s, d, false, false) then c += 1;
write(' | ', (GetTickCount64-u):4, ' ms');
write(' | result ', c);
writeln;
// -------------------------------------
write('Fibonacci':50);
c := 0;
u := GetTickCount64;
for i := 1 to ITERATIONS do if IsAnagram_fibo(s, d, false, false) then c += 1;
write(' | ', (GetTickCount64-u):4, ' ms');
write(' | result ', c);
writeln;
// -------------------------------------
writeln;
s := 'night';
d := 'THING';
writeln('*** ROUND 2 ***');
writeln('s1 = ', s);
writeln('s2 = ', d);
writeln;
// -------------------------------------
write('Bart: IgnoreSpaces + ExceptionOnError':50);
c := 0;
u := GetTickCount64;
for i := 1 to ITERATIONS do if IsAnagram(s, d, true, true) then c += 1;
write(' | ', (GetTickCount64-u):4, ' ms');
write(' | result ', c);
writeln;
// -------------------------------------
write('Fibonacci: IgnoreSpaces + ExceptionOnError':50);
c := 0;
u := GetTickCount64;
for i := 1 to ITERATIONS do if IsAnagram_fibo(s, d, true, true) then c += 1;
write(' | ', (GetTickCount64-u):4, ' ms');
write(' | result ', c);
writeln;
// -------------------------------------
write('Bart: IgnoreSpaces':50);
c := 0;
u := GetTickCount64;
for i := 1 to ITERATIONS do if IsAnagram(s, d, true, false) then c += 1;
write(' | ', (GetTickCount64-u):4, ' ms');
write(' | result ', c);
writeln;
// -------------------------------------
write('Fibonacci: IgnoreSpaces':50);
c := 0;
u := GetTickCount64;
for i := 1 to ITERATIONS do if IsAnagram_fibo(s, d, true, false) then c += 1;
write(' | ', (GetTickCount64-u):4, ' ms');
write(' | result ', c);
writeln;
// -------------------------------------
write('Bart':50);
c := 0;
u := GetTickCount64;
for i := 1 to ITERATIONS do if IsAnagram(s, d, false, false) then c += 1;
write(' | ', (GetTickCount64-u):4, ' ms');
write(' | result ', c);
writeln;
// -------------------------------------
write('Fibonacci':50);
c := 0;
u := GetTickCount64;
for i := 1 to ITERATIONS do if IsAnagram_fibo(s, d, false, false) then c += 1;
write(' | ', (GetTickCount64-u):4, ' ms');
write(' | result ', c);
writeln;
// -------------------------------------
writeln;
s := 'Invalid';
d := 'Diff length';
writeln('*** ROUND 3: Invalid chars ***');
writeln('s1 = ', s);
writeln('s2 = ', d);
writeln;
// -------------------------------------
write('Bart: IgnoreSpaces + ExceptionOnError':50);
c := 0;
u := GetTickCount64;
for i := 1 to ITERATIONS do if IsAnagram(s, d, true, true) then c += 1;
write(' | ', (GetTickCount64-u):4, ' ms');
write(' | result ', c);
writeln;
// -------------------------------------
write('Fibonacci: IgnoreSpaces + ExceptionOnError':50);
c := 0;
u := GetTickCount64;
for i := 1 to ITERATIONS do if IsAnagram_fibo(s, d, true, true) then c += 1;
write(' | ', (GetTickCount64-u):4, ' ms');
write(' | result ', c);
writeln;
// -------------------------------------
write('Bart: IgnoreSpaces':50);
c := 0;
u := GetTickCount64;
for i := 1 to ITERATIONS do if IsAnagram(s, d, true, false) then c += 1;
write(' | ', (GetTickCount64-u):4, ' ms');
write(' | result ', c);
writeln;
// -------------------------------------
write('Fibonacci: IgnoreSpaces':50);
c := 0;
u := GetTickCount64;
for i := 1 to ITERATIONS do if IsAnagram_fibo(s, d, true, false) then c += 1;
write(' | ', (GetTickCount64-u):4, ' ms');
write(' | result ', c);
writeln;
// -------------------------------------
write('Bart':50);
c := 0;
u := GetTickCount64;
for i := 1 to ITERATIONS do if IsAnagram(s, d, false, false) then c += 1;
write(' | ', (GetTickCount64-u):4, ' ms');
write(' | result ', c);
writeln;
// -------------------------------------
write('Fibonacci':50);
c := 0;
u := GetTickCount64;
for i := 1 to ITERATIONS do if IsAnagram_fibo(s, d, false, false) then c += 1;
write(' | ', (GetTickCount64-u):4, ' ms');
write(' | result ', c);
writeln;
// -------------------------------------
readln;
end;
begin
main;
end.
Recent
