Contest: fastest IsAnagram function

[Bart]

Code: Pascal  [Select][+][-]

1. function IsAnagram_paweld(const S1, S2: String; IgnoreSpaces: Boolean = True; ExceptionOnError: Boolean = False): Boolean;
2. <snip>
3.  

Sorry: fails validitytest.

Code: [Select]

TestValidity for Paweld
FAIL to detect invalid character #0
Validitycheck FAIL for Paweld

Bart

[Bart]

Take 2...

Sorry, fails validitytest:

Code: [Select]

TestValidity for SilverCoder
FAIL to detect invalid character #128
Validitycheck FAIL for SilverCoder
Bart

[Bart]

Corrected routine. Wrong invalid character detection on first string at line 61.

Still fails:

Code: [Select]

TestValidity for BrunoK
FAIL to detect invalid character #1
Validitycheck FAIL for BrunoK
Bart

[BrunoK]

Corrected erroneous intialization of indirect pointers.

Removed lines 20-21
 

Code: Pascal  [Select][+][-]

1. function IsAnagram_BrunoK(const S1, S2: String; IgnoreSpaces: Boolean = True;
2.   ExceptionOnError: Boolean = False): Boolean;
3.  
4. const
5.   cCold: boolean = True;          // WarmUp done -> cCold = False
6.   cArIndexStr: shortstring = '';  // Holder for indexes by character
7.  
8.   cFlagArraySize = ((2 + 128 - 32 - (Ord('z') - Ord('a') + 1)) *
9.     SizeOf(SmallInt) + (SizeOf(SizeInt) - 1) div
10.     (SizeOf(SizeInt) div 2));
11.   cFlagArraySizeInt = (cFlagArraySize * 2) div SizeOf(SizeInt);
12. var
13.   vcArIndex: array[0..High(Byte)] of byte absolute cArIndexStr;
14.  
15.   procedure WarmUp;
16.   var
17.     i, j: integer;
18.   begin
19.     FillDWord(vcArIndex, SizeOf(vcArIndex) div SizeOf(DWord), 0); // Init array
20.     j := 2;
21.     for i := Ord(' ') to 128 - 1 do
22.       if (i < Ord('a')) or (i > Ord('z')) then begin
23.         vcArIndex[i] := j;
24.         Inc(j);
25.       end
26.       else
27.         vcArIndex[i] := vcArIndex[i - (Ord('a') - Ord('A'))];
28.     cCold := False;
29.   end;
30.  
31.   procedure Error(const Where: string; AtPos: SizeInt); noreturn;
32.   begin
33.     raise ERangeError.CreateFmt('IsAnagram_bk: illegal character in %s at position %d',
34.       [Where, AtPos]);
35.   end;
36. type
37.   TFreq = array[0..cFlagArraySizeInt - 1] of SizeInt; // Trick from bart
38.  
39. var
40.   F1: array[0..cFlagArraySizeInt - 1] of SizeInt;
41.   F1SI: array[0..cFlagArraySize - 1] of SmallInt absolute F1;
42.   i: integer;
43.   j: integer;
44.   vpIndex: PSmallInt;
45.   pb, pe: PByte;
46. begin
47.   if cCold then
48.     WarmUp;
49.   F1 := Default(TFreq);  // Init array  // Sligth speed improvement
50.   vcArIndex[Ord(' ')] := 2;
51.   if IgnoreSpaces then
52.     vcArIndex[Ord(' ')] := 1; // Send them to dead char
53.  
54.   { Increase counts for S1 }
55.   { for i := 1 to Length(S1) do begin replace with while and pointers }
56.   pb := PByte(S1);
57.   pe := pb+Length(S1);
58.   while pb<pe do begin   // Tiny improvement with pointers
59.     // j := Ord(S1[i]);
60.     j := pb^;
61.     vpIndex := @F1SI[vcArIndex[j]];
62.     Inc(vpIndex^);
63.     if vpIndex<>@F1SI[0] then begin
64.       inc(pb);
65.       Continue;
66.     end;
67.     { Invalid charater }
68.     Result := False;
69.     if ExceptionOnError then
70.       Error('S1', i);
71.     Exit;
72.   end;
73.   F1SI[1] := High(SmallInt); // Do not fail due to deadchar's
74.   { Decrease counts for S2 }
75.   for i := 1 to Length(S2) do begin // No improvement with pointers
76.     j := byte(S2[i]);
77.     vpIndex := @F1SI[vcArIndex[j]];
78.     Dec(vpIndex^);
79.     if vpIndex^ >= 0 then  // All is well, processs next character
80.       Continue;
81.     { Invalid character or more counter become negative }
82.     Result := False;
83.     if ExceptionOnError and (vpIndex = @F1SI[0]) then
84.       Error('S2', i);
85.     Exit;
86.   end;
87.   F1SI[1] := 0;   // Ignore dead characters
88.   for i := 0 to cFlagArraySizeInt - 1 do
89.     if F1[i] <> 0 then
90.       Exit(False);
91.   Result := True;
92. end;

[Bart]

My version:

Code: Pascal  [Select][+][-]

1. function IsAnagramASerge(const S1, S2: string; IgnoreSpaces: Boolean = True;
2.   ExceptionOnError: Boolean = False): Boolean;
3.  

Your code can be improved by having an early exit in the case (IgnoreSpaces=False) and (Length(S1) <> Length(S2)).

Code: [Select]

begin
  if (not IgnoreSpaces) and (Length(S1) <> Length(S2)) then
    Exit(False);
  if not FillOk(S1, F1, SpaceCnt1, ErrPos) then
    if ExceptionOnError then
In my speed test it decrease tick from 219 -> 187.

Bart

[Bart]

Corrected erroneous intialization of indirect pointers.
end;[/code]

OK, you're now as fast as ASerge.

Code: [Select]

Testing speed
Bart           :   281
Bart2          :   219
Warfly         : Failed validity test
Fibonacci      : Failed validity test
ASerge         :   172
Zvoni          : Failed validity test
Zvoni2         : Failed validity test
Alligator      : Failed validity test
SilverCoder    : Failed validity test
AVK            : Failed validity test
Paweld         : Failed validity test
BrunoK         :   172
Martin         : Failed validity test
Dummy          : Failed validity test
Bart

[Bart]

A little warnig regarding speed testing.
When I change the order in which I test the entries, then speed can vary up to 15%.
This is not unexpected, but shows these tests are not absolute.

Bart

[Bart]

To give you some insight in my testing code:

Validity testing:

Code: Pascal  [Select][+][-]

1.  
2. //some typedefs
3. type
4.   TAnagramFunc = function (const S1, S2: String; IgnoreSpaces: Boolean; ExceptionOnError: Boolean = False): Boolean;
5.   TFuncRec = record
6.     Func: TAnagramFunc;
7.     Name: String;
8.     IsValid: Boolean;
9.   end;
10.   TFuncRecs = array of TFuncRec;
11.  
12.   TAnagram = record
13.     S1, S2: String;
14.   end;
15.   TAnagrams = array of TAnagram;
16.  
17. var
18.   ValidAnagrams, InValidAnagrams: TAnagrams;
19.   FuncRecs: TFuncRecs;
20.  
21. ....
22.  
23. function TestValidity(var AFuncRec: TFuncRec): Boolean;
24. var
25.   i: Integer;
26.   S1, S2: String;
27.   Ch: Char;
28. begin
29.   try
30.     Result := False;
31.     AFuncRec.IsValid := False;
32.     writeln;
33.     writeln('TestValidity for ',AfuncRec.Name);
34.     for i := Low(ValidAnagrams) to High(ValidAnagrams) do
35.     begin
36.       if not AFuncRec.Func(ValidAnagrams[i].S1, ValidAnagrams[i].S2, True, False) then
37.       begin
38.         writeln('FAIL: valid anagram rejected (with IgnoreSpaces=TRUE):');
39.         writeln('S1: "',ValidAnagrams[i].S1,'"');
40.         writeln('S2: "',ValidAnagrams[i].S2,'"');
41.         //writeln;
42.         Exit;
43.       end;
44.     end;
45.  
46.     for i := Low(ValidAnagrams) to High(ValidAnagrams) do
47.     begin
48.       S1 := ValidAnagrams[i].S1;
49.       S2 := ValidAnagrams[i].S2;
50.       S1 := StringReplace(S1, #32, '', [rfReplaceAll]);
51.       S2 := StringReplace(S2, #32, '', [rfReplaceAll]);
52.       if not AFuncRec.Func(S1, S2, False, False) then
53.       begin
54.         writeln('FAIL: valid anagram rejected (with IgnoreSpaces=FALSE):');
55.         writeln('S1: "',S1,'"');
56.         writeln('S2: "',S2,'"');
57.         //writeln;
58.         Exit;
59.       end;
60.     end;
61.  
62.     for i := Low(InValidAnagrams) to High(InValidAnagrams) do
63.     begin
64.       if AFuncRec.Func(InValidAnagrams[i].S1, InValidAnagrams[i].S2, True, False) then
65.       begin
66.         writeln('FAIL: erroneously returned as anagram, but they are not (with IgnoreSpaces=True):');
67.         writeln('S1: "',InValidAnagrams[i].S1,'"');
68.         writeln('S2: "',InValidAnagrams[i].S2,'"');
69.         //writeln;
70.         Exit;
71.       end;
72.     end;
73.  
74.     for Ch := #0 to #31 do
75.     begin
76.       S1 := Ch;
77.       S2 := Ch;
78.       if AFuncRec.Func(S1, S2, True, False) then
79.       begin
80.         writeln('FAIL to detect invalid character #',Ord(Ch));
81.         //writeln;
82.         Exit;
83.       end;
84.     end;
85.     for Ch := #128 to #255 do
86.     begin
87.       S1 := Ch;
88.       S2 := Ch;
89.       if AFuncRec.Func(S1, S2, True, False) then
90.       begin
91.         writeln('FAIL to detect invalid character #',Ord(Ch));
92.         //writeln;
93.         Exit;
94.       end;
95.     end;
96.  
97.     AFuncRec.IsValid := True;
98.     Result := True;
99.   except
100.     on E: Exception do
101.     begin
102.       writeln('FAIL: ',E.ToString);
103.       Result := FALSE;
104.       //raise
105.     end;
106.   end
107. end;

Time testing:

Code: Pascal  [Select][+][-]

1. function TimeFunc(AFunc: TAnagramFunc): Integer;
2. const
3.   Cycles = 100000;
4. var
5.   T0: QWord;
6.   i, k: Integer;
7. begin
8.   T0 := GetTickCount64;
9.   for i := 1 to cycles do
10.   begin
11.     for k := Low(ValidAnagrams) to High(ValidAnagrams) do AFunc(ValidAnagrams[k].S1, ValidAnagrams[k].S2, True, False);
12.     //will all be false: tests early exit if lengths differ when IgnoreSpaces=False
13.     for k := Low(ValidAnagrams) to High(ValidAnagrams) do AFunc(ValidAnagrams[k].S1, ValidAnagrams[k].S2 + '  ', False, False);
14.     for k := Low(InValidAnagrams) to High(InValidAnagrams) do AFunc(InValidAnagrams[k].S1, InValidAnagrams[k].S2, True, False);
15.   end;
16.   Result := GetTickCount64 - T0;
17. end;

The Timing test does not check the validity of the results: these should all be OK, since this test will only be run if the validity test is passed OK.

Please inform me if you see any bugs in these (especially the TestValidity function).

Bart

[avk]

Code: [Select]

Testing speed
...
AVK            : Failed validity test
...


Is this about the fixed submission? And which one is it?

[Fibonacci]

TestValidity for Fibonacci-2
TRUE

Code: Pascal  [Select][+][-]

1. function IsAnagram_Fibonacci2(const s1, s2: string; IgnoreSpaces: boolean=true; ExceptionOnError: boolean=false): boolean;
2. var
3.   f1, f2: array[32..127] of int16;
4.   i: integer;
5.   c: byte;
6. begin
7.   if not IgnoreSpaces and (length(s1) <> length(s2)) then exit(false);
8.  
9.   FillWord(f1[32], 127-32, 0);
10.  
11.   for i := 1 to length(s1) do begin
12.     c := pbyte(@s1[i])^;
13.     if (c < 32) or (c > 127) then
14.       if ExceptionOnError then
15.         raise ERangeError.CreateFmt('IsAnagram: illegal character in S1 at position %d', [i])
16.       else exit(false);
17.     inc(f1[c], 1);
18.   end;
19.  
20.   for i := 1 to length(s2) do begin
21.     c := pbyte(@s2[i])^;
22.     if (c < 32) or (c > 127) then
23.       if ExceptionOnError then
24.         raise ERangeError.CreateFmt('IsAnagram: illegal character in S2 at position %d', [i])
25.       else exit(false);
26.     dec(f1[c], 1);
27.   end;
28.  
29.   if IgnoreSpaces then f1[32] := 0;
30.  
31.   FillWord(f2[32], 127-32, 0);
32.   result := CompareByte(f1[32], f2[32], (127-32)*2)=0;
33. end;

[delphius]

TestValidity for Fibonacci-2
TRUE

Is it possible not to fill the second array with zeros, but just use const?

Code: Pascal  [Select][+][-]

1. const
2.   zeroFreq: array[0..255] of Byte = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
5.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
6.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
7.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
8.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
9.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
10.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
11.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
12.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
13.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
14.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
15.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
16.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
17.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
18.  

[Martin_fr]

A little warnig regarding speed testing.
When I change the order in which I test the entries, then speed can vary up to 15%.
This is not unexpected, but shows these tests are not absolute.

- There ought to be a compiler directive for alignment of procedures => set it to at least 32.
- Also, warm up each test once. So previous cache loads are less significant.
- Before the first test, stress the CPU for a short time => if your cpu has some turbo boost, it will apply that during the first test, and the first test only.
  (Or use some tool to fix the frequency of your cpu / if you have intel, there is "intel extreme tuning utility" from intel, at least on Windows)

[delphius]

TestValidity for Fibonacci-2
TRUE

Is it possible not to fill the second array with zeros, but just use const?

Code: Pascal  [Select][+][-]

1. const
2.   zeroFreq: array[0..255] of Byte = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
5.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
6.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
7.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
8.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
9.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
10.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
11.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
12.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
13.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
14.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
15.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
16.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
17.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
18.  

Something like this...

Code: Pascal  [Select][+][-]

1. function IsAnagram_delphius(const S1, S2: string; IgnoreSpaces: Boolean = True; ExceptionOnError: Boolean = False): Boolean;
2. const
3.   zeroFreq: array[32..127] of Byte = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
5.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
6.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
7.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
8.                                      0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
9. var
10.   s1c, s1e, s2c, s2e: PChar;
11.   freq: array[32..127] of Byte;
12.   ch: Byte;
13. begin
14.   if not IgnoreSpaces and (Length(S1) <> Length(S2)) then
15.     Exit(False);
16.  
17.   s1c := PChar(S1);
18.   s1e := s1c + Length(S1);
19.   s2c := PChar(S2);
20.   s2e := s2c + Length(S2);
21.  
22.   FillQWord(freq, 12, 0);
23.  
24.   while s1c < s1e do
25.   begin
26.     ch := Ord(s1c^);
27.     case ch of
28.       32: if not IgnoreSpaces then Inc(freq[ch]);
29.       65..90: Inc(freq[ch or $20]);
30.       33..64, 91..127: Inc(freq[ch]);
31.       else
32.         if ExceptionOnError then
33.           raise ERangeError.CreateFmt('Illegal character in S1 at position %d', [s1c - PChar(S1) + 1])
34.             else Exit(False);
35.     end;
36.     Inc(s1c);
37.   end;
38.  
39.   while s2c < s2e do
40.   begin
41.     ch := Ord(s2c^);
42.     case ch of
43.       32: if not IgnoreSpaces then Dec(freq[ch]);
44.       65..90: Dec(freq[ch or $20]);
45.       33..64, 91..127: Dec(freq[ch]);
46.       else
47.         if ExceptionOnError then
48.           raise ERangeError.CreateFmt('Illegal character in S2 at position %d', [s2c - PChar(S2) + 1])
49.             else Exit(False);
50.     end;
51.     Inc(s2c);
52.   end;
53.  
54.   Result := CompareByte(freq[32], zeroFreq[32], 95) = 0
55. end;
56.  

[BrunoK]

TestValidity for Fibonacci-2
TRUE

Code: Text  [Select][+][-]

1. function IsAnagram_Fibonacci2(const s1, s2: string; IgnoreSpaces: boolean=true;   s := #1'!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~';
2.   d := '~}|{zyxw vutsrqpon mlkjihgfe dcba`_^]\ [ZYXWVUTS RQPONMLKJ IHGFEDCBA @?>=<;:98 76543210/ .-,+*)(''& %$#"!';

Fails detection of #1 with IgnoreCase.
Exception IgnoreCase=False

[Window Title]
Error

[Content]
Project Anagram raised exception class 'External: ACCESS VIOLATION' with message:
Access violation reading from address $000000000140FF6E.

 In file 'Anagram.lpr' at line 859:
for i := 1 to ITERATIONS do if AFunc(s, d, IgnoreSpaces, ExceptionOnError) then c += 1;

[OK]

[Fibonacci]

@delphius: Sure, but test which one is faster. Because I did and oddly it wasnt.

@BrunoK:

Code: Pascal  [Select][+][-]

1. function IsAnagram_Fibonacci2(const s1, s2: string; IgnoreSpaces: boolean=true; ExceptionOnError: boolean=false): boolean;
2. var
3.   f1, f2: array[32..127] of int16;
4.   i: integer;
5.   c: byte;
6. begin
7.   if not IgnoreSpaces and (length(s1) <> length(s2)) then exit(false);
8.  
9.   FillWord(f1[32], 127-32, 0);
10.  
11.   for i := 1 to length(s1) do begin
12.     c := pbyte(@s1[i])^;
13.     if (c < 32) or (c > 127) then
14.       if ExceptionOnError then
15.         raise ERangeError.CreateFmt('IsAnagram: illegal character in S1 at position %d', [i])
16.       else exit(false);
17.     // case insensitive
18.     if (c >= 65) and (c <= 90) then c := c or 32;
19.     inc(f1[c], 1);
20.   end;
21.  
22.   for i := 1 to length(s2) do begin
23.     c := pbyte(@s2[i])^;
24.     if (c < 32) or (c > 127) then
25.       if ExceptionOnError then
26.         raise ERangeError.CreateFmt('IsAnagram: illegal character in S2 at position %d', [i])
27.       else exit(false);    
28.     // case insensitive
29.     if (c >= 65) and (c <= 90) then c := c or 32;
30.     dec(f1[c], 1);
31.   end;
32.  
33.   if IgnoreSpaces then f1[32] := 0;
34.  
35.   FillWord(f2[32], 127-32, 0);
36.   result := CompareByte(f1[32], f2[32], (127-32)*2)=0;
37. end;

EDIT: Updated with little fix