Contest: fastest IsAnagram function

[Fibonacci]

Its case sensitive, is that how its supposed to be? Because now it fails every test.

In this case I made tests with different strings.

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

1. *** ROUND 1 ***
2. s1 = s tate
3. s2 = t a  s t  e
4.  
5.                 Bart IgnoreSpaces ExceptionOnError |  1391 ms | result 25000000
6.            Fibonacci IgnoreSpaces ExceptionOnError |   703 ms | result 25000000
7.               ASerge IgnoreSpaces ExceptionOnError |   953 ms | result 25000000
8.                Zvoni IgnoreSpaces ExceptionOnError | 20828 ms | result 25000000
9.            ALLIGATOR IgnoreSpaces ExceptionOnError |  1500 ms | result 25000000
10.                                  Bart IgnoreSpaces |  1797 ms | result 25000000
11.                             Fibonacci IgnoreSpaces |  1141 ms | result 25000000
12.                                ASerge IgnoreSpaces |   859 ms | result 25000000
13.                                 Zvoni IgnoreSpaces | 17078 ms | result 25000000
14.                             ALLIGATOR IgnoreSpaces |   688 ms | result 25000000
15.                                               Bart |  1203 ms | result 0
16.                                          Fibonacci |   640 ms | result 0
17.                                             ASerge |   688 ms | result 0
18.                                              Zvoni |  2969 ms | result 0
19.                                          ALLIGATOR |  1109 ms | result 0

[Zvoni]

Result as expected

But the approach with "Frequency" is intriguing.
Just counting the characters, and then compare.
Nice. Never would have thought of it

[silvercoder70]

My version... and hoping (fingers crossed) there will be some compiler optimisations ...

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

1. function IsAnagram(const S1, S2: String;
2.                    IgnoreSpaces: Boolean = True;
3.                    ExceptionOnError: Boolean = False): Boolean;
4. var
5.   CharCount: array[Byte] of Integer;
6.   i, j: Integer;
7. begin
8.   Result := False;
9.   FillChar(CharCount, SizeOf(CharCount), #0);
10.  
11.   // update array based on S1...
12.   for i := 1 to Length(S1) do
13.   begin
14.     if Ord(S1[i]) < 32 then
15.     begin
16.       if ExceptionOnError then
17.         raise Exception.Create('Invalid character in S1: ' + S1[i]);
18.       Exit;
19.     end;
20.     if (not IgnoreSpaces) or (S1[i] <> ' ') then
21.       CharCount[Ord(Lowercase(S1[i]))] :=
22.         CharCount[Ord(Lowercase(S1[i]))] + 1;
23.   end;
24.  
25.   // now checked elements in S2...
26.   for j := 1 to Length(S2) do
27.   begin
28.     if Ord(S2[j]) < 32 then
29.     begin
30.       if ExceptionOnError then
31.         raise Exception.Create('Invalid character in S2: ' + S2[j]);
32.       Exit;
33.     end;
34.  
35.     // Convert to lowercase and decrement count
36.     if (not IgnoreSpaces) or (S2[j] <> ' ') then
37.     begin
38.       if CharCount[Ord(Lowercase(S2[j]))] = 0 then
39.       begin
40.         if ExceptionOnError then
41.           raise Exception.Create('Strings are not anagrams.');
42.         Exit;
43.       end;
44.  
45.       CharCount[Ord(Lowercase(S2[j]))] :=
46.         CharCount[Ord(Lowercase(S2[j]))] - 1;
47.     end;
48.   end;
49.  
50.   for i := Low(Byte) to High(Byte) do
51.   begin
52.     if CharCount[i] > 0 then
53.     begin
54.       if ExceptionOnError then
55.         raise Exception.Create('Strings are not anagrams.');
56.       Exit;
57.     end;
58.   end;
59.  
60.   Result := True;
61. end;
62.  
63.  

[Fibonacci]

Your code throws exceptions if the strings are not anagrams, which I dont think should happen, it should just return false. Exceptions should be raised only for actual errors, like illegal characters.

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

1. *** ROUND 1 ***
2. s1 = s tate
3. s2 = t a  s t  e
4.  
5.                 Bart IgnoreSpaces ExceptionOnError |  1438 ms | result 25000000
6.            Fibonacci IgnoreSpaces ExceptionOnError |   718 ms | result 25000000
7.               ASerge IgnoreSpaces ExceptionOnError |   875 ms | result 25000000
8.                Zvoni IgnoreSpaces ExceptionOnError | 13375 ms | result 25000000
9.            ALLIGATOR IgnoreSpaces ExceptionOnError |  1313 ms | result 25000000
10.        silvercoder70 IgnoreSpaces ExceptionOnError |  4687 ms | result 25000000
11.                                  Bart IgnoreSpaces |  1422 ms | result 25000000
12.                             Fibonacci IgnoreSpaces |  1156 ms | result 25000000
13.                                ASerge IgnoreSpaces |  1172 ms | result 25000000
14.                                 Zvoni IgnoreSpaces | 13312 ms | result 25000000
15.                             ALLIGATOR IgnoreSpaces |   750 ms | result 25000000
16.                         silvercoder70 IgnoreSpaces |  4704 ms | result 25000000
17.                                               Bart |  1312 ms | result 0
18.                                          Fibonacci |   672 ms | result 0
19.                                             ASerge |   766 ms | result 0
20.                                              Zvoni |  2890 ms | result 0
21.                                          ALLIGATOR |  1281 ms | result 0
22.                                      silvercoder70 |  1579 ms | result 0

Full source code if anyone wants to continue or run it themselves:

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

1. uses
2.   SysUtils;
3.  
4. type
5.   IsAnagramFunc = function (const S1, S2: String; IgnoreSpaces: Boolean = True; ExceptionOnError: Boolean = False): Boolean;
6.  
7. function IsAnagram(const S1, S2: String; IgnoreSpaces: Boolean = True; ExceptionOnError: Boolean = False): Boolean;
8. type
9.   TFreq = array[#32..#127] of Integer;
10. const
11.   AllowedChars = [#32..#127];
12. var
13.   i,SpaceCnt: Integer;
14.   F1, F2: TFreq;
15.   Ch: Char;
16. begin
17.   Result := False;
18.   F1 := Default(TFreq);
19.   SpaceCnt := 0;
20.   for i := 1 to Length(S1) do
21.   begin
22.     Ch := LowerCase(S1[i]);
23.     if (Ch in AllowedChars) then
24.     begin
25.       if (Ch = #32) then
26.         Inc(SpaceCnt)
27.       else
28.         Inc(F1[Ch]);
29.     end
30.     else
31.     begin
32.       if ExceptionOnError then
33.         Raise ERangeError.CreateFmt('IsAnagram: illegal character in S1 at position %d',[i]);
34.       Exit;
35.     end;
36.   end;
37.   F2 := Default(TFreq);
38.   for i := 1 to Length(S2) do
39.   begin
40.     Ch := LowerCase(S2[i]);
41.     if (Ch in AllowedChars) then
42.     begin
43.       if (Ch = #32) then
44.         Dec(SpaceCnt)
45.       else
46.         Inc(F2[Ch]);
47.     end
48.     else
49.     begin
50.       if ExceptionOnError then
51.         Raise ERangeError.CreateFmt('IsAnagram: illegal character in S2 at position %d',[i]);
52.       Exit;
53.     end;
54.   end;
55.   Result := IgnoreSpaces or (SpaceCnt = 0);
56.   if Result then
57.     Result := CompareMem(@F1, @F2, SizeOf(TFreq));
58. end;
59.  
60. function IsAnagram_fibo(const S1, S2: String; IgnoreSpaces: Boolean = True; ExceptionOnError: Boolean = False): Boolean;
61. var
62.   F1, F2: array[33..122] of Byte;
63.   i, SpaceCnt: Integer;
64.   Ch1, Ch2: Byte;
65. begin
66.   FillChar(F1, SizeOf(F1), 0);
67.   FillChar(F2, SizeOf(F2), 0);
68.   SpaceCnt := 0;
69.   result := true;
70.  
71.   for i := 1 to Length(S1) do begin
72.     Ch1 := Ord(S1[i]);
73.     if (Ch1 < 33) or (Ch1 > 122) then if (Ch1 <> 32) and IgnoreSpaces then if ExceptionOnError then
74.       Raise ERangeError.CreateFmt('IsAnagram: illegal character in S1 at position %d', [i])
75.     else exit;
76.     if Ch1 = 32 then Inc(SpaceCnt)
77.     else if Ch1 >= 33 then if Ch1 <= 122 then Inc(F1[Ch1 or $20]) else Inc(F1[Ch1]);
78.   end;
79.  
80.   for i := 1 to Length(S2) do begin
81.     Ch2 := Ord(S2[i]);
82.     if (Ch2 < 33) or (Ch2 > 122) then if (Ch2 <> 32) and IgnoreSpaces then if ExceptionOnError then
83.       Raise ERangeError.CreateFmt('IsAnagram: illegal character in S2 at position %d', [i])
84.     else exit;
85.     if Ch2 = 32 then Dec(SpaceCnt)
86.     else if Ch2 >= 33 then if Ch2 <= 122 then Inc(F2[Ch2 or $20]) else Inc(F2[Ch2]);
87.   end;
88.  
89.   result := (IgnoreSpaces or (SpaceCnt = 0)) and CompareMem(@F1, @F2, SizeOf(F1));
90. end;
91.  
92. function IsAnagramASerge(const S1, S2: string; IgnoreSpaces: Boolean = True;
93.   ExceptionOnError: Boolean = False): Boolean;
94.  
95.   procedure Error(const Where: string; AtPos: SizeInt); //noreturn;
96.   begin
97.     raise ERangeError.CreateFmt(
98.       'IsAnagram: illegal character in %s at position %d', [Where, AtPos]);
99.   end;
100.  
101. type
102.   TFreq = array[33..127] of Integer;
103.  
104.   function FillOk(const S: string; out Data: TFreq; out SpaceCnt, ErrPos: Integer): Boolean;
105.   var
106.     i: Integer;
107.     B: Byte;
108.   begin
109.     FillChar(Data, SizeOf(Data), 0);
110.     SpaceCnt := 0;
111.     for i := 1 to Length(S) do
112.     begin
113.       B := Ord(S[i]);
114.       case B of
115.         32: Inc(SpaceCnt);
116.         33..Pred(Ord('A')): Inc(Data[B]);
117.         Ord('A')..Ord('Z'): Inc(Data[B or $20]);
118.         Ord(Succ('Z'))..127: Inc(Data[B]);
119.       else
120.         ErrPos := i;
121.         Exit(False);
122.       end;
123.     end;
124.     ErrPos := 0;
125.     Result := True;
126.   end;
127.  
128. var
129.   F1, F2: TFreq;
130.   SpaceCnt1, SpaceCnt2, ErrPos: Integer;
131. begin
132.   if not FillOk(S1, F1, SpaceCnt1, ErrPos) then
133.     if ExceptionOnError then
134.       Error('S1', ErrPos)
135.     else
136.       Exit(False);
137.   if not FillOk(S2, F2, SpaceCnt2, ErrPos) then
138.     if ExceptionOnError then
139.       Error('S2', ErrPos)
140.     else
141.       Exit(False);
142.   Result := IgnoreSpaces or (SpaceCnt1 = SpaceCnt2);
143.   if Result then
144.     Result := CompareMem(@F1, @F2, SizeOf(TFreq));
145. end;
146.  
147. // Zvoni
148. Var
149.   os1,os2:String;
150.   b:Boolean;
151. procedure QuickSort(var AI: array of Char; ALo, AHi: Integer);
152. var
153.   Pivot,T: Char;
154.   Lo, Hi:Integer;
155. begin
156.   Lo := ALo;
157.   Hi := AHi;
158.   Pivot := AI[(Lo + Hi) div 2];
159.   repeat
160.     while AI[Lo] < Pivot do
161.       Inc(Lo) ;
162.     while AI[Hi] > Pivot do
163.       Dec(Hi) ;
164.     if Lo <= Hi then
165.     begin
166.       T := AI[Lo];
167.       AI[Lo] := AI[Hi];
168.       AI[Hi] := T;
169.       Inc(Lo) ;
170.       Dec(Hi) ;
171.     end;
172.   until Lo > Hi;
173.   if Hi > ALo then
174.     QuickSort(AI, ALo, Hi) ;
175.   if Lo < AHi then
176.     QuickSort(AI, Lo, AHi) ;
177. end;
178. Function StrSpn(Const str:PChar;Const Accept:PChar):Integer;
179. Var
180.   a:PChar;
181.   table:Array[0..255] Of Byte;
182.   p:PByte;
183.   c0,c1,c2,c3:ByteBool;
184.   s:PChar;
185.   Count:Integer;
186. Begin
187.   If Accept[0]=#0 Then Exit(0);
188.   If Accept[1]=#0 Then
189.     Begin
190.       a:=str;
191.       While a^=accept^ Do Inc(a);
192.       Exit(a-str);
193.     end;
194.   FillChar(table,64,0);
195.   p:=@table[0];
196.   FillChar(table[64],64,0);
197.   FillChar(table[128],64,0);
198.   FillChar(table[192],64,0);
199.   s:=accept;
200.   While s^<>#0 Do
201.     Begin
202.       p[Byte(s^)]:=1;
203.       Inc(s);
204.     end;
205.   s:=str;
206.   If Not ByteBool(p[Byte(s[0])]) Then Exit(0);
207.   If Not ByteBool(p[Byte(s[1])]) Then Exit(1);
208.   If Not ByteBool(p[Byte(s[2])]) Then Exit(2);
209.   If Not ByteBool(p[Byte(s[3])]) Then Exit(3);
210.   Repeat
211.     Inc(s,4);
212.     c0:=ByteBool(p[Byte(s[0])]);
213.     c1:=ByteBool(p[Byte(s[1])]);
214.     c2:=byteBool(p[Byte(s[2])]);
215.     c3:=ByteBool(p[Byte(s[3])]);
216.   until Not (c0 And C1 And C2 And C3);
217.   Count:=s-str;
218.   If Not (c0 And c1) Then
219.     Result:=count+Byte(c0)
220.   Else
221.     Result:=Count+Byte(c2)+2;
222. End;
223. function IsAnagram_Zvoni(const S1, S2: String; IgnoreSpaces: Boolean = True; ExceptionOnError: Boolean = False): Boolean;
224. Var
225.   l1,l2:Integer;
226.   ps1,ps2:Array Of AnsiChar;
227.   i:Integer;
228.   p1,p2:PChar;
229.   by:Byte;
230.   c:Array[32..127] Of Char;    //Legal Characters
231. Begin
232.   Result:=False;
233.   For by:=32 To 127 Do c[by]:=Char(by);
234.   If IgnoreSpaces Then
235.     Begin
236.       p1:=PChar(StringReplace(S1,' ','',[rfReplaceAll]));
237.       p2:=PChar(StringReplace(S2,' ','',[rfReplaceAll]));
238.     end
239.   Else
240.     Begin
241.       p1:=PChar(S1);
242.       p2:=PChar(S2);
243.     end;
244.   l1:=Length(strpas(p1));
245.   l2:=Length(strpas(p2));
246.   If l1<>l2 Then Exit;  //unequal Length.
247.   //We only step into this code if l1=l2
248.   i:=StrSpn(p1,PChar(@c[32]));
249.   If i<>l1 Then Exit; //Illegal char
250.   i:=StrSpn(p2,PChar(@c[32]));
251.   If i<>l2 Then Exit; //Illegal char
252.   SetLength(ps1,l1);
253.   SetLength(ps2,l2);
254.   For i:=0 To l1-1 Do
255.     Begin
256.       ps1[i]:=p1^;
257.       Inc(p1);
258.       ps2[i]:=p2^;
259.       Inc(p2);
260.     end;
261.   QuickSort(ps1,Low(ps1),High(ps1));
262.   QuickSort(ps2,Low(ps2),High(ps2));
263.   Result:=CompareMem(@ps1[0],@ps2[0],Length(ps1));
264. End;
265.  
266. function IsAnagram_ALLIGATOR(const S1, S2: String; IgnoreSpaces: Boolean = True; ExceptionOnError: Boolean = False): Boolean;
267. type
268.   TFreq = array [32..127] of Int32;
269. const
270.   FZero: TFreq = (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,
271.                   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,
272.                   0,0,0,0,0,0,0,0,0,0,0,0);
273. var
274.   i: SizeInt;
275.   F1: TFreq;
276.   Ch: Byte;
277. begin
278.   Result := False;
279.   FillChar(F1, SizeOf(F1), 0);
280.  
281.   i:=0;
282.   while i<Length(S1) do
283.   begin
284.     inc(i);
285.     Ch:=ord(S1[i]);
286.     case Ch of
287.       32..64, 91..122: Inc(F1[Ch]);
288.       65..90: Inc(F1[Ch or $20]);
289.       else
290.         if ExceptionOnError then Raise ERangeError.CreateFmt('IsAnagram: illegal character in S1 at position %d',[i]);
291.     end;
292.   end;
293.  
294.   i:=0;
295.   while i<Length(S2) do
296.   begin
297.     inc(i);
298.     Ch:=ord(S2[i]);
299.     case Ch of
300.       32..64, 91..122: Dec(F1[Ch]);
301.       65..90: Dec(F1[Ch or $20]);
302.       else
303.         if ExceptionOnError then Raise ERangeError.CreateFmt('IsAnagram: illegal character in S1 at position %d',[i]);
304.     end;
305.   end;
306.  
307.   if IgnoreSpaces then
308.   begin
309.     Result := CompareMem(@F1[Low(F1)+1], @FZero, SizeOf(TFreq)-SizeOf(TFreq[Low(TFreq)]));
310.   end else
311.   begin
312.     Result := CompareMem(@F1, @FZero, SizeOf(TFreq));
313.   end;
314. end;
315.  
316. function IsAnagram_silvercoder70(const S1, S2: String;
317.                    IgnoreSpaces: Boolean = True;
318.                    ExceptionOnError: Boolean = False): Boolean;
319. var
320.   CharCount: array[Byte] of Integer;
321.   i, j: Integer;
322. begin
323.   Result := False;
324.   FillChar(CharCount, SizeOf(CharCount), #0);
325.  
326.   // update array based on S1...
327.   for i := 1 to Length(S1) do
328.   begin
329.     if Ord(S1[i]) < 32 then
330.     begin
331.       if ExceptionOnError then
332.         raise Exception.Create('Invalid character in S1: ' + S1[i]);
333.       Exit;
334.     end;
335.     if (not IgnoreSpaces) or (S1[i] <> ' ') then
336.       CharCount[Ord(Lowercase(S1[i]))] :=
337.         CharCount[Ord(Lowercase(S1[i]))] + 1;
338.   end;
339.  
340.   // now checked elements in S2...
341.   for j := 1 to Length(S2) do
342.   begin
343.     if Ord(S2[j]) < 32 then
344.     begin
345.       if ExceptionOnError then
346.         raise Exception.Create('Invalid character in S2: ' + S2[j]);
347.       Exit;
348.     end;
349.  
350.     // Convert to lowercase and decrement count
351.     if (not IgnoreSpaces) or (S2[j] <> ' ') then
352.     begin
353.       if CharCount[Ord(Lowercase(S2[j]))] = 0 then
354.       begin
355.         if ExceptionOnError then
356.           raise Exception.Create('Strings are not anagrams.');
357.         Exit;
358.       end;
359.  
360.       CharCount[Ord(Lowercase(S2[j]))] :=
361.         CharCount[Ord(Lowercase(S2[j]))] - 1;
362.     end;
363.   end;
364.  
365.   for i := Low(Byte) to High(Byte) do
366.   begin
367.     if CharCount[i] > 0 then
368.     begin
369.       if ExceptionOnError then
370.         raise Exception.Create('Strings are not anagrams.');
371.       Exit;
372.     end;
373.   end;
374.  
375.   Result := True;
376. end;
377.  
378. procedure main;
379. var
380.   s, d: string;
381.  
382.   procedure Test(const AFunctionName: string; const AFunc: IsAnagramFunc; const IgnoreSpaces, ExceptionOnError: Boolean);
383.   const
384.     ITERATIONS = 1000*1000*25;
385.     IgnoreSpacesStr: array[boolean] of string = ('', ' IgnoreSpaces');
386.     ExceptionOnErrorStr: array[boolean] of string = ('', ' ExceptionOnError');
387.   var
388.     i, c: integer;
389.     u: ptruint;
390.   begin
391.     write(Concat(AFunctionName, IgnoreSpacesStr[IgnoreSpaces], ExceptionOnErrorStr[ExceptionOnError]):50);
392.     c := 0;
393.     u := GetTickCount64;
394.     for i := 1 to ITERATIONS do if AFunc(s, d, IgnoreSpaces, ExceptionOnError) then c += 1;
395.     write(' | ', (GetTickCount64-u):5, ' ms');
396.     write(' | result ', c);
397.     writeln;
398.   end;
399.  
400.   procedure TestAll;
401.   begin
402.     Test('Bart', @IsAnagram, true, true);
403.     Test('Fibonacci', @IsAnagram_fibo, true, true);
404.     Test('ASerge', @IsAnagramASerge, true, true);
405.     Test('Zvoni', @IsAnagram_Zvoni, true, true);
406.     Test('ALLIGATOR', @IsAnagram_ALLIGATOR, true, true);
407.     Test('silvercoder70', @IsAnagram_silvercoder70, true, true);
408.  
409.     Test('Bart', @IsAnagram, true, false);
410.     Test('Fibonacci', @IsAnagram_fibo, true, false);
411.     Test('ASerge', @IsAnagramASerge, true, false);
412.     Test('Zvoni', @IsAnagram_Zvoni, true, false);
413.     Test('ALLIGATOR', @IsAnagram_ALLIGATOR, true, false);
414.     Test('silvercoder70', @IsAnagram_silvercoder70, true, false);
415.  
416.     Test('Bart', @IsAnagram, false, false);
417.     Test('Fibonacci', @IsAnagram_fibo, false, false);
418.     Test('ASerge', @IsAnagramASerge, false, false);
419.     Test('Zvoni', @IsAnagram_Zvoni, false, false);
420.     Test('ALLIGATOR', @IsAnagram_ALLIGATOR, false, false);
421.     Test('silvercoder70', @IsAnagram_silvercoder70, false, false);
422.   end;
423.  
424. begin
425.   //s := 'St a    te';
426.   //d := 'tas t e';
427.   s := 's tate';
428.   d := 't a  s t  e';
429.   writeln('*** ROUND 1 ***');
430.   writeln('s1 = ', s);
431.   writeln('s2 = ', d);
432.   writeln;
433.  
434.   TestAll;
435.   writeln;
436.  
437.   s := 'night';
438.   d := 'THING';
439.   writeln('*** ROUND 2 ***');
440.   writeln('s1 = ', s);
441.   writeln('s2 = ', d);
442.   writeln;
443.  
444.   TestAll;
445.   writeln;
446.  
447.   s := 'Invalid';
448.   d := 'Diff length';
449.   writeln('*** ROUND 3: Invalid chars ***');
450.   writeln('s1 = ', s);
451.   writeln('s2 = ', d);
452.   writeln;
453.  
454.   TestAll;
455.   readln;
456. end;
457.  
458. begin
459.   main;
460. end.
461.  

[silvercoder70]

If exceptions not required when not an anagram then (i) please remove or (ii) can I submit alternate version tomorrow (too late right now)

I need sleepy bobos ...

[ASerge]

Full source code if anyone wants to continue or run it themselves:

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

1. function IsAnagramASerge(const S1, S2: string; IgnoreSpaces: Boolean = True;
2.   ExceptionOnError: Boolean = False): Boolean;
3.  
4.   procedure Error(const Where: string; AtPos: SizeInt); //noreturn;
5.  
6.  

Why is noreturn commented out?

[avk]

My simple version:

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

1. function IsAnagram_avk(const s1, s2: string; aIgnoreSpaces: Boolean = True; aExceptionOnError: Boolean = False): Boolean;
2. var
3.   Counter: array[#32..#127] of Integer;
4.   I: Integer;
5.   c: AnsiChar;
6. begin
7.   FillChar(Counter, SizeOf(Counter), 0);
8.   for I := 1 to Length(s1) do begin
9.     if DWord(Integer(s1[I])-Integer(32)) > DWord(95) then
10.       if aExceptionOnError then
11.         raise ERangeError.CreateFmt('Illegal character in s1, position %d(#%d)', [I, Ord(s1[I])])
12.       else
13.         exit(False);
14.     Inc(Counter[s1[I]]);
15.   end;
16.  
17.   for I := 1 to Length(s2) do begin
18.     if DWord(Integer(s2[I])-Integer(32)) > DWord(95) then
19.       if aExceptionOnError then
20.         raise ERangeError.CreateFmt('Illegal character in s2, position %d(#%d)', [I, Ord(s2[I])])
21.       else
22.         exit(False);
23.     Dec(Counter[s2[I]]);
24.   end;
25.  
26.   for c := AnsiChar(32 + Ord(aIgnoreSpaces)) to #127 do
27.     if Counter[c] <> 0 then exit(False);
28.   Result := True;  
29. end;
30.  

BTW, the test strings seem too short.

UPD - a little fix: removed unnecessary entities.
UPD2 - typo.

[Zvoni]

Second Try based on rvk:

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

1. function IsAnagram2(const S1, S2: String; IgnoreSpaces: Boolean = True; ExceptionOnError: Boolean = False): Boolean;
2. Var
3.   ls1,ls2:String;
4.   F1,F2:Array[#32..#127] Of UInt32;
5.   i:Integer;
6. Begin
7.   Result:=False;
8.   If IgnoreSpaces Then
9.     Begin
10.       ls1:=LowerCase(StringReplace(S1,' ','',[rfReplaceAll]));
11.       ls2:=LowerCase(StringReplace(S2,' ','',[rfReplaceAll]));
12.     end
13.   Else
14.     Begin
15.       ls1:=LowerCase(S1);
16.       ls2:=LowerCase(S2);
17.     End;
18.   If Length(ls1)<>Length(ls2) Then Exit;
19.   //Both Strings have same Length from here
20.   FillChar(f1,SizeOf(f1),0);
21.   FillChar(f2,SizeOf(f2),0);
22.   For i:=1 To Length(ls1) Do
23.     Begin
24.       Try
25.         Inc(F1[ls1[i]]);
26.       Except
27.         On Exception Do
28.           If ExceptionOnError Then
29.             ERangeError.CreateFmt('Illegal character in s1, position %d(#%d)', [i, Ord(ls1[i])])
30.           Else
31.             Exit;
32.       End;
33.       Try
34.         Inc(F2[ls2[i]]);
35.       Except
36.         On Exception Do
37.           If ExceptionOnError Then
38.             ERangeError.CreateFmt('Illegal character in s2, position %d(#%d)', [i, Ord(ls2[i])])
39.           Else
40.             Exit;
41.       End;
42.     End;
43.   Result:=CompareByte(F1,F2,Length(F1))=0;
44. End;  

[BrunoK]

Complicated but fairly competitive if compile -O2 or above.

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

1. { Pretty fast  when compiled with > O2 compiler switch }
2. function IsAnagram_BrunoK(const S1, S2: String; IgnoreSpaces: Boolean = True;
3.   ExceptionOnError: Boolean = False): Boolean;
4. const
5.   cCold: boolean = True;          // WarmUp done
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.     vcArIndex[0] := 0;   // Invalid character counter
21.     vcArIndex[1] := 1;   // Dead characters
22.     j := 2;
23.     for i := Ord(' ') to 128 - 1 do
24.       if (i < Ord('a')) or (i > Ord('z')) then begin
25.         vcArIndex[i] := j;
26.         Inc(j);
27.       end
28.       else
29.         vcArIndex[i] := vcArIndex[i - (Ord('a') - Ord('A'))];
30.     cCold := False;
31.   end;
32.  
33.   procedure Error(const Where: string; AtPos: SizeInt); noreturn;
34.   begin
35.     raise ERangeError.CreateFmt('IsAnagram: illegal character in %s at position %d',
36.       [Where, AtPos]);
37.   end;
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. label
46.   NextInS1;
47. begin
48.   if cCold then
49.     WarmUp;
50.   for i := 0 to cFlagArraySizeInt - 1 do   // Init array
51.     F1[i] := 0;
52.  
53.   vcArIndex[Ord(' ')] := 2;
54.   if IgnoreSpaces then
55.     vcArIndex[Ord(' ')] := 1; // Send them to dead char
56.  
57.   { Increase counts for S1 }
58.   for i := 1 to Length(S1) do begin
59.     j := Ord(S1[i]);
60.     vpIndex := @F1SI[vcArIndex[j]];
61.     Inc(vpIndex^);
62.     if j >= 1 then
63.       Continue;
64.     { Invalid charater }
65.     Result := False;
66.     if ExceptionOnError then
67.       Error('S1', i);
68.     Exit;
69.   end;
70.   F1SI[1] := High(SmallInt); // Do not fail due to deadchar's
71.   { Decrease counts for S2 }
72.   for i := 1 to Length(S2) do begin
73.     j := byte(S2[i]);
74.     vpIndex := @F1SI[vcArIndex[j]];
75.     Dec(vpIndex^);
76.     if vpIndex^ >= 0 then // All is well, processs next character
77.       Continue;
78.     { Invalid character or more counter become negative }
79.     Result := False;
80.     if ExceptionOnError and (j = 0) then
81.       Error('S2', i);
82.     Exit;
83.   end;
84.   F1SI[1] := 0;   // Ignore dead characters
85.   for i := 0 to cFlagArraySizeInt - 1 do
86.     if F1[i] <> 0 then
87.       Exit(False);
88.   Result := True;
89. end;

IsAnagram_fibo passes

s1 = St a    te @
s2 = tas t e `

where ohters correctly reject it.

[Bart]

Wow, massive amount of replies...

About Benchmarking:

Testing with ExceptionOnError IMO is not very relevant, this is just there so that (if so dersired) one can distinguish between "is not anagram" and "invalid input".

Normally anagrams allow for different amount of whitespace, so having IgnoreSpaces = True will reflect the more common usecase.
(If this parameter is False, we can opt out early of course if lengths are not equal)

Inputstring wil normally not be very long, but we indeed should decide on which strings we test the algo's.

Some general remarks.
Theoretically sorting the strings should on average be slower than counting the frequencies.

[Fibonacci]

Why is noreturn commented out?

tests.lpr(98,75) Error: Raise in subroutines declared as noreturn is not allowed

[ASerge]

Why is noreturn commented out?

tests.lpr(98,75) Error: Raise in subroutines declared as noreturn is not allowed

And what is the FPC version? I don't have such a error. FPC 3.2.2.

[Fibonacci]

Why is noreturn commented out?

tests.lpr(98,75) Error: Raise in subroutines declared as noreturn is not allowed

And what is the FPC version? I don't have such a error. FPC 3.2.2.

Trunk 3.3.1

IsAnagram_fibo passes

s1 = St a    te @
s2 = tas t e `

where ohters correctly reject it.

Not anymore.

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

1. *** ROUND 1 ***
2. s1 = s tate
3. s2 = t a  s t  e
4.  
5.                 Bart IgnoreSpaces ExceptionOnError |  1406 ms | result 25000000
6.            Fibonacci IgnoreSpaces ExceptionOnError |   797 ms | result 25000000
7.               ASerge IgnoreSpaces ExceptionOnError |   922 ms | result 25000000
8.                Zvoni IgnoreSpaces ExceptionOnError | 15859 ms | result 25000000
9.            Zvoni (2) IgnoreSpaces ExceptionOnError |  7719 ms | result 25000000
10.            ALLIGATOR IgnoreSpaces ExceptionOnError |  1437 ms | result 25000000
11.        silvercoder70 IgnoreSpaces ExceptionOnError |  2829 ms | result 25000000
12.                  avk IgnoreSpaces ExceptionOnError |  1531 ms | result 25000000
13.                                  Bart IgnoreSpaces |  1734 ms | result 25000000
14.                             Fibonacci IgnoreSpaces |  1172 ms | result 25000000
15.                                ASerge IgnoreSpaces |  1078 ms | result 25000000
16.                                 Zvoni IgnoreSpaces | 13860 ms | result 25000000
17.                             Zvoni (2) IgnoreSpaces |  7390 ms | result 25000000
18.                             ALLIGATOR IgnoreSpaces |   766 ms | result 25000000
19.                         silvercoder70 IgnoreSpaces |  3265 ms | result 25000000
20.                                   avk IgnoreSpaces |  2047 ms | result 25000000
21.                                               Bart |  1203 ms | result 0
22.                                          Fibonacci |   735 ms | result 0
23.                                             ASerge |   719 ms | result 0
24.                                              Zvoni |  2875 ms | result 0
25.                                          Zvoni (2) |   718 ms | result 0
26.                                          ALLIGATOR |  1094 ms | result 0
27.                                      silvercoder70 |  1109 ms | result 0
28.                                                avk |   891 ms | result 0

New full code:

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

1. uses
2.   SysUtils;
3.  
4. type
5.   IsAnagramFunc = function (const S1, S2: String; IgnoreSpaces: Boolean = True; ExceptionOnError: Boolean = False): Boolean;
6.  
7. function IsAnagram(const S1, S2: String; IgnoreSpaces: Boolean = True; ExceptionOnError: Boolean = False): Boolean;
8. type
9.   TFreq = array[#32..#127] of Integer;
10. const
11.   AllowedChars = [#32..#127];
12. var
13.   i,SpaceCnt: Integer;
14.   F1, F2: TFreq;
15.   Ch: Char;
16. begin
17.   Result := False;
18.   F1 := Default(TFreq);
19.   SpaceCnt := 0;
20.   for i := 1 to Length(S1) do
21.   begin
22.     Ch := LowerCase(S1[i]);
23.     if (Ch in AllowedChars) then
24.     begin
25.       if (Ch = #32) then
26.         Inc(SpaceCnt)
27.       else
28.         Inc(F1[Ch]);
29.     end
30.     else
31.     begin
32.       if ExceptionOnError then
33.         Raise ERangeError.CreateFmt('IsAnagram: illegal character in S1 at position %d',[i]);
34.       Exit;
35.     end;
36.   end;
37.   F2 := Default(TFreq);
38.   for i := 1 to Length(S2) do
39.   begin
40.     Ch := LowerCase(S2[i]);
41.     if (Ch in AllowedChars) then
42.     begin
43.       if (Ch = #32) then
44.         Dec(SpaceCnt)
45.       else
46.         Inc(F2[Ch]);
47.     end
48.     else
49.     begin
50.       if ExceptionOnError then
51.         Raise ERangeError.CreateFmt('IsAnagram: illegal character in S2 at position %d',[i]);
52.       Exit;
53.     end;
54.   end;
55.   Result := IgnoreSpaces or (SpaceCnt = 0);
56.   if Result then
57.     Result := CompareMem(@F1, @F2, SizeOf(TFreq));
58. end;
59.  
60. function IsAnagram_fibo(const S1, S2: String; IgnoreSpaces: Boolean = True; ExceptionOnError: Boolean = False): Boolean;
61. var
62.   F1, F2: array[33..122] of Byte;
63.   i, SpaceCnt: Integer;
64.   Ch1, Ch2: Byte;
65. begin
66.   FillChar(F1, SizeOf(F1), 0);
67.   FillChar(F2, SizeOf(F2), 0);
68.   SpaceCnt := 0;
69.   result := true;
70.  
71.   for i := 1 to Length(S1) do begin
72.     Ch1 := Ord(S1[i]);
73.     if (Ch1 < 33) or (Ch1 > 122) then if (Ch1 <> 32) and IgnoreSpaces then if ExceptionOnError then
74.       Raise ERangeError.CreateFmt('IsAnagram: illegal character in S1 at position %d', [i])
75.     else exit;
76.     if Ch1 = 32 then Inc(SpaceCnt)
77.     else if (Ch1 >= 33) and (Ch1 <> 96) then if Ch1 <= 122 then Inc(F1[Ch1 or $20]) else Inc(F1[Ch1]);
78.   end;
79.  
80.   for i := 1 to Length(S2) do begin
81.     Ch2 := Ord(S2[i]);
82.     if (Ch2 < 33) or (Ch2 > 122) then if (Ch2 <> 32) and IgnoreSpaces then if ExceptionOnError then
83.       Raise ERangeError.CreateFmt('IsAnagram: illegal character in S2 at position %d', [i])
84.     else exit;
85.     if Ch2 = 32 then Dec(SpaceCnt)
86.     else if (Ch2 >= 33) and (Ch2 <> 96) then if Ch2 <= 122 then Inc(F2[Ch2 or $20]) else Inc(F2[Ch2]);
87.   end;
88.  
89.   result := (IgnoreSpaces or (SpaceCnt = 0)) and CompareMem(@F1, @F2, SizeOf(F1));
90. end;
91.  
92. function IsAnagramASerge(const S1, S2: string; IgnoreSpaces: Boolean = True;
93.   ExceptionOnError: Boolean = False): Boolean;
94.  
95.   procedure Error(const Where: string; AtPos: SizeInt); //noreturn;
96.   begin
97.     raise ERangeError.CreateFmt(
98.       'IsAnagram: illegal character in %s at position %d', [Where, AtPos]);
99.   end;
100.  
101. type
102.   TFreq = array[33..127] of Integer;
103.  
104.   function FillOk(const S: string; out Data: TFreq; out SpaceCnt, ErrPos: Integer): Boolean;
105.   var
106.     i: Integer;
107.     B: Byte;
108.   begin
109.     FillChar(Data, SizeOf(Data), 0);
110.     SpaceCnt := 0;
111.     for i := 1 to Length(S) do
112.     begin
113.       B := Ord(S[i]);
114.       case B of
115.         32: Inc(SpaceCnt);
116.         33..Pred(Ord('A')): Inc(Data[B]);
117.         Ord('A')..Ord('Z'): Inc(Data[B or $20]);
118.         Ord(Succ('Z'))..127: Inc(Data[B]);
119.       else
120.         ErrPos := i;
121.         Exit(False);
122.       end;
123.     end;
124.     ErrPos := 0;
125.     Result := True;
126.   end;
127.  
128. var
129.   F1, F2: TFreq;
130.   SpaceCnt1, SpaceCnt2, ErrPos: Integer;
131. begin
132.   if not FillOk(S1, F1, SpaceCnt1, ErrPos) then
133.     if ExceptionOnError then
134.       Error('S1', ErrPos)
135.     else
136.       Exit(False);
137.   if not FillOk(S2, F2, SpaceCnt2, ErrPos) then
138.     if ExceptionOnError then
139.       Error('S2', ErrPos)
140.     else
141.       Exit(False);
142.   Result := IgnoreSpaces or (SpaceCnt1 = SpaceCnt2);
143.   if Result then
144.     Result := CompareMem(@F1, @F2, SizeOf(TFreq));
145. end;
146.  
147. // Zvoni
148. Var
149.   os1,os2:String;
150.   b:Boolean;
151. procedure QuickSort(var AI: array of Char; ALo, AHi: Integer);
152. var
153.   Pivot,T: Char;
154.   Lo, Hi:Integer;
155. begin
156.   Lo := ALo;
157.   Hi := AHi;
158.   Pivot := AI[(Lo + Hi) div 2];
159.   repeat
160.     while AI[Lo] < Pivot do
161.       Inc(Lo) ;
162.     while AI[Hi] > Pivot do
163.       Dec(Hi) ;
164.     if Lo <= Hi then
165.     begin
166.       T := AI[Lo];
167.       AI[Lo] := AI[Hi];
168.       AI[Hi] := T;
169.       Inc(Lo) ;
170.       Dec(Hi) ;
171.     end;
172.   until Lo > Hi;
173.   if Hi > ALo then
174.     QuickSort(AI, ALo, Hi) ;
175.   if Lo < AHi then
176.     QuickSort(AI, Lo, AHi) ;
177. end;
178. Function StrSpn(Const str:PChar;Const Accept:PChar):Integer;
179. Var
180.   a:PChar;
181.   table:Array[0..255] Of Byte;
182.   p:PByte;
183.   c0,c1,c2,c3:ByteBool;
184.   s:PChar;
185.   Count:Integer;
186. Begin
187.   If Accept[0]=#0 Then Exit(0);
188.   If Accept[1]=#0 Then
189.     Begin
190.       a:=str;
191.       While a^=accept^ Do Inc(a);
192.       Exit(a-str);
193.     end;
194.   FillChar(table,64,0);
195.   p:=@table[0];
196.   FillChar(table[64],64,0);
197.   FillChar(table[128],64,0);
198.   FillChar(table[192],64,0);
199.   s:=accept;
200.   While s^<>#0 Do
201.     Begin
202.       p[Byte(s^)]:=1;
203.       Inc(s);
204.     end;
205.   s:=str;
206.   If Not ByteBool(p[Byte(s[0])]) Then Exit(0);
207.   If Not ByteBool(p[Byte(s[1])]) Then Exit(1);
208.   If Not ByteBool(p[Byte(s[2])]) Then Exit(2);
209.   If Not ByteBool(p[Byte(s[3])]) Then Exit(3);
210.   Repeat
211.     Inc(s,4);
212.     c0:=ByteBool(p[Byte(s[0])]);
213.     c1:=ByteBool(p[Byte(s[1])]);
214.     c2:=byteBool(p[Byte(s[2])]);
215.     c3:=ByteBool(p[Byte(s[3])]);
216.   until Not (c0 And C1 And C2 And C3);
217.   Count:=s-str;
218.   If Not (c0 And c1) Then
219.     Result:=count+Byte(c0)
220.   Else
221.     Result:=Count+Byte(c2)+2;
222. End;
223. function IsAnagram_Zvoni(const S1, S2: String; IgnoreSpaces: Boolean = True; ExceptionOnError: Boolean = False): Boolean;
224. Var
225.   l1,l2:Integer;
226.   ps1,ps2:Array Of AnsiChar;
227.   i:Integer;
228.   p1,p2:PChar;
229.   by:Byte;
230.   c:Array[32..127] Of Char;    //Legal Characters
231. Begin
232.   Result:=False;
233.   For by:=32 To 127 Do c[by]:=Char(by);
234.   If IgnoreSpaces Then
235.     Begin
236.       p1:=PChar(StringReplace(S1,' ','',[rfReplaceAll]));
237.       p2:=PChar(StringReplace(S2,' ','',[rfReplaceAll]));
238.     end
239.   Else
240.     Begin
241.       p1:=PChar(S1);
242.       p2:=PChar(S2);
243.     end;
244.   l1:=Length(strpas(p1));
245.   l2:=Length(strpas(p2));
246.   If l1<>l2 Then Exit;  //unequal Length.
247.   //We only step into this code if l1=l2
248.   i:=StrSpn(p1,PChar(@c[32]));
249.   If i<>l1 Then Exit; //Illegal char
250.   i:=StrSpn(p2,PChar(@c[32]));
251.   If i<>l2 Then Exit; //Illegal char
252.   SetLength(ps1,l1);
253.   SetLength(ps2,l2);
254.   For i:=0 To l1-1 Do
255.     Begin
256.       ps1[i]:=p1^;
257.       Inc(p1);
258.       ps2[i]:=p2^;
259.       Inc(p2);
260.     end;
261.   QuickSort(ps1,Low(ps1),High(ps1));
262.   QuickSort(ps2,Low(ps2),High(ps2));
263.   Result:=CompareMem(@ps1[0],@ps2[0],Length(ps1));
264. End;
265.  
266. function IsAnagram_Zvoni2(const S1, S2: String; IgnoreSpaces: Boolean = True; ExceptionOnError: Boolean = False): Boolean;
267. Var
268.   ls1,ls2:String;
269.   F1,F2:Array[#32..#127] Of UInt32;
270.   i:Integer;
271. Begin
272.   Result:=False;
273.   If IgnoreSpaces Then
274.     Begin
275.       ls1:=LowerCase(StringReplace(S1,' ','',[rfReplaceAll]));
276.       ls2:=LowerCase(StringReplace(S2,' ','',[rfReplaceAll]));
277.     end
278.   Else
279.     Begin
280.       ls1:=LowerCase(S1);
281.       ls2:=LowerCase(S2);
282.     End;
283.   If Length(ls1)<>Length(ls2) Then Exit;
284.   //Both Strings have same Length from here
285.   FillChar(f1,SizeOf(f1),0);
286.   FillChar(f2,SizeOf(f2),0);
287.   For i:=1 To Length(ls1) Do
288.     Begin
289.       Try
290.         Inc(F1[ls1[i]]);
291.       Except
292.         On Exception Do
293.           If ExceptionOnError Then
294.             ERangeError.CreateFmt('Illegal character in s1, position %d(#%d)', [i, Ord(ls1[i])])
295.           Else
296.             Exit;
297.       End;
298.       Try
299.         Inc(F2[ls2[i]]);
300.       Except
301.         On Exception Do
302.           If ExceptionOnError Then
303.             ERangeError.CreateFmt('Illegal character in s2, position %d(#%d)', [i, Ord(ls2[i])])
304.           Else
305.             Exit;
306.       End;
307.     End;
308.   Result:=CompareByte(F1,F2,Length(F1))=0;
309. End;
310.  
311. function IsAnagram_ALLIGATOR(const S1, S2: String; IgnoreSpaces: Boolean = True; ExceptionOnError: Boolean = False): Boolean;
312. type
313.   TFreq = array [32..127] of Int32;
314. const
315.   FZero: TFreq = (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,
316.                   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,
317.                   0,0,0,0,0,0,0,0,0,0,0,0);
318. var
319.   i: SizeInt;
320.   F1: TFreq;
321.   Ch: Byte;
322. begin
323.   Result := False;
324.   FillChar(F1, SizeOf(F1), 0);
325.  
326.   i:=0;
327.   while i<Length(S1) do
328.   begin
329.     inc(i);
330.     Ch:=ord(S1[i]);
331.     case Ch of
332.       32..64, 91..122: Inc(F1[Ch]);
333.       65..90: Inc(F1[Ch or $20]);
334.       else
335.         if ExceptionOnError then Raise ERangeError.CreateFmt('IsAnagram: illegal character in S1 at position %d',[i]);
336.     end;
337.   end;
338.  
339.   i:=0;
340.   while i<Length(S2) do
341.   begin
342.     inc(i);
343.     Ch:=ord(S2[i]);
344.     case Ch of
345.       32..64, 91..122: Dec(F1[Ch]);
346.       65..90: Dec(F1[Ch or $20]);
347.       else
348.         if ExceptionOnError then Raise ERangeError.CreateFmt('IsAnagram: illegal character in S1 at position %d',[i]);
349.     end;
350.   end;
351.  
352.   if IgnoreSpaces then
353.   begin
354.     Result := CompareMem(@F1[Low(F1)+1], @FZero, SizeOf(TFreq)-SizeOf(TFreq[Low(TFreq)]));
355.   end else
356.   begin
357.     Result := CompareMem(@F1, @FZero, SizeOf(TFreq));
358.   end;
359. end;
360.  
361. function IsAnagram_silvercoder70(const S1, S2: String;
362.                    IgnoreSpaces: Boolean = True;
363.                    ExceptionOnError: Boolean = False): Boolean;
364. var
365.   CharCount: array[Byte] of Integer;
366.   i, j: Integer;
367. begin
368.   Result := False;
369.   FillChar(CharCount, SizeOf(CharCount), #0);
370.  
371.   // update array based on S1...
372.   for i := 1 to Length(S1) do
373.   begin
374.     if Ord(S1[i]) < 32 then
375.     begin
376.       if ExceptionOnError then
377.         raise Exception.Create('Invalid character in S1: ' + S1[i]);
378.       Exit;
379.     end;
380.     if (not IgnoreSpaces) or (S1[i] <> ' ') then
381.       CharCount[Ord(Lowercase(S1[i]))] :=
382.         CharCount[Ord(Lowercase(S1[i]))] + 1;
383.   end;
384.  
385.   // now checked elements in S2...
386.   for j := 1 to Length(S2) do
387.   begin
388.     if Ord(S2[j]) < 32 then
389.     begin
390.       if ExceptionOnError then
391.         raise Exception.Create('Invalid character in S2: ' + S2[j]);
392.       Exit;
393.     end;
394.  
395.     // Convert to lowercase and decrement count
396.     if (not IgnoreSpaces) or (S2[j] <> ' ') then
397.     begin
398.       if CharCount[Ord(Lowercase(S2[j]))] = 0 then
399.       begin
400.         //if ExceptionOnError then
401.           //raise Exception.Create('Strings are not anagrams.');
402.         Exit;
403.       end;
404.  
405.       CharCount[Ord(Lowercase(S2[j]))] :=
406.         CharCount[Ord(Lowercase(S2[j]))] - 1;
407.     end;
408.   end;
409.  
410.   for i := Low(Byte) to High(Byte) do
411.   begin
412.     if CharCount[i] > 0 then
413.     begin
414.       //if ExceptionOnError then
415.         //raise Exception.Create('Strings are not anagrams.');
416.       Exit;
417.     end;
418.   end;
419.  
420.   Result := True;
421. end;
422.  
423. function IsAnagram_avk(const s1, s2: string; aIgnoreSpaces: Boolean = True; aExceptionOnError: Boolean = False): Boolean;
424. var
425.   Counter: array[#32..#127] of Integer;
426.   I: Integer;
427.   c: AnsiChar;
428. begin
429.   FillChar(Counter, SizeOf(Counter), 0);
430.   for I := 1 to Length(s1) do begin
431.     if DWord(Integer(s1[I])-Integer(32)) > DWord(96) then
432.       if aExceptionOnError then
433.         raise ERangeError.CreateFmt('Illegal character in s1, position %d(#%d)', [I, Ord(s1[I])])
434.       else
435.         exit(False);
436.     Inc(Counter[s1[I]]);
437.   end;
438.  
439.   for I := 1 to Length(s2) do begin
440.     if DWord(Integer(s2[I])-Integer(32)) > DWord(96) then
441.       if aExceptionOnError then
442.         raise ERangeError.CreateFmt('Illegal character in s2, position %d(#%d)', [I, Ord(s2[I])])
443.       else
444.         exit(False);
445.     Dec(Counter[s2[I]]);
446.   end;
447.  
448.   for c := AnsiChar(32 + Ord(aIgnoreSpaces)) to #127 do
449.     if Counter[c] <> 0 then exit(False);
450.   Result := True;
451. end;
452.  
453. procedure main;
454. var
455.   s, d: string;
456.  
457.   procedure Test(const AFunctionName: string; const AFunc: IsAnagramFunc; const IgnoreSpaces, ExceptionOnError: Boolean);
458.   const
459.     ITERATIONS = 1000*1000*25;
460.     IgnoreSpacesStr: array[boolean] of string = ('', ' IgnoreSpaces');
461.     ExceptionOnErrorStr: array[boolean] of string = ('', ' ExceptionOnError');
462.   var
463.     i, c: integer;
464.     u: ptruint;
465.   begin
466.     write(Concat(AFunctionName, IgnoreSpacesStr[IgnoreSpaces], ExceptionOnErrorStr[ExceptionOnError]):50);
467.     c := 0;
468.     u := GetTickCount64;
469.     for i := 1 to ITERATIONS do if AFunc(s, d, IgnoreSpaces, ExceptionOnError) then c += 1;
470.     write(' | ', (GetTickCount64-u):5, ' ms');
471.     write(' | result ', c);
472.     writeln;
473.   end;
474.  
475.   procedure TestAll;
476.   begin
477.     Test('Bart', @IsAnagram, true, true);
478.     Test('Fibonacci', @IsAnagram_fibo, true, true);
479.     Test('ASerge', @IsAnagramASerge, true, true);
480.     Test('Zvoni', @IsAnagram_Zvoni, true, true);
481.     Test('Zvoni (2)', @IsAnagram_Zvoni2, true, true);
482.     Test('ALLIGATOR', @IsAnagram_ALLIGATOR, true, true);
483.     Test('silvercoder70', @IsAnagram_silvercoder70, true, true);
484.     Test('avk', @IsAnagram_avk, true, true);
485.  
486.     Test('Bart', @IsAnagram, true, false);
487.     Test('Fibonacci', @IsAnagram_fibo, true, false);
488.     Test('ASerge', @IsAnagramASerge, true, false);
489.     Test('Zvoni', @IsAnagram_Zvoni, true, false);
490.     Test('Zvoni (2)', @IsAnagram_Zvoni2, true, false);
491.     Test('ALLIGATOR', @IsAnagram_ALLIGATOR, true, false);
492.     Test('silvercoder70', @IsAnagram_silvercoder70, true, false);
493.     Test('avk', @IsAnagram_avk, true, false);
494.  
495.     Test('Bart', @IsAnagram, false, false);
496.     Test('Fibonacci', @IsAnagram_fibo, false, false);
497.     Test('ASerge', @IsAnagramASerge, false, false);
498.     Test('Zvoni', @IsAnagram_Zvoni, false, false);
499.     Test('Zvoni (2)', @IsAnagram_Zvoni2, false, false);
500.     Test('ALLIGATOR', @IsAnagram_ALLIGATOR, false, false);
501.     Test('silvercoder70', @IsAnagram_silvercoder70, false, false);
502.     Test('avk', @IsAnagram_avk, false, false);
503.   end;
504.  
505. begin
506.   //writeln('IsAnagram_fibo = ', IsAnagram_fibo('St a    te @', 'tas t e `'));
507.   //writeln('IsAnagram_fibo = ', IsAnagram_fibo('St a    te !', 'tas t e `'));
508.   //writeln('IsAnagram_fibo = ', IsAnagram_fibo('St a    te ', 'tas t e '));
509.   //writeln('IsAnagram_fibo = ', IsAnagram_fibo('state', 'taste'));
510.   //readln;exit;
511.  
512.   s := 's tate';
513.   d := 't a  s t  e';
514.   writeln('*** ROUND 1 ***');
515.   writeln('s1 = ', s);
516.   writeln('s2 = ', d);
517.   writeln;
518.  
519.   TestAll;
520.   writeln;
521.  
522.   s := 'night';
523.   d := 'THING';
524.   writeln('*** ROUND 2 ***');
525.   writeln('s1 = ', s);
526.   writeln('s2 = ', d);
527.   writeln;
528.  
529.   TestAll;
530.   writeln;
531.  
532.   s := 'Invalid';
533.   d := 'Diff length';
534.   writeln('*** ROUND 3: Invalid chars ***');
535.   writeln('s1 = ', s);
536.   writeln('s2 = ', d);
537.   writeln;
538.  
539.   TestAll;
540.   readln;
541. end;
542.  
543. begin
544.   main;
545. end.
546.  

[Thaddy]

Wow, massive amount of replies...

I am sill amazed that noboby implemented my algorithm. Or is faster. Also sorting at least one of the strings is in practice faster, but I agree it may sound counterintuitive. Even a bubble sort. What do I need to explain to convince you all that testing for bit 6 is enough to ignore case? (given the original parameters)

[Martin_fr]

And here is mine.

MyInt depends on the max allowed input string len.  Smallint = max len 32000.
If longer, then a low probability of false positives exist.

Obviously allowing for longer input affects speed. So if we decide that longest string is 127 then change my code to use ShortInt

Exception timings should be done outside the debugger => otherwise you wait forever, as the debugger adds time.
They also might want a lower iteration count, at least depending on OS....


The FORCENOSTACKFRAME can be removed for fairness (not sure if it actually is needed).

LoopUnroll is wanted by my code.

Haven't tested cross OS/CPU .... Might be that ifdefing/disabling the SMALL_LOOP for some CPU may make it faster on those. On my Intel it was better to have it defined.


Mind that my testloop runs a lot of data. So you may only want to check a subset of it.

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

1. program isa;
2.  
3. uses SysUtils;
4.  
5. // Max safe string len depends on counter size
6. type
7.   //MyInt = Int64;
8.   //MyInt = Integer;
9.   MyInt = SmallInt;
10.   //MyInt = ShortInt;
11.  
12. {$DEFINE WITH_OR}
13. {$DEFINE WITH_EARLYEXIT} // Only for WITH_OR
14.  
15. {$DEFINE SMALL_LOOP}
16. {$Optimization LOOPUNROLL on}
17.  
18.  
19. {$Optimization FORCENOSTACKFRAME on}
20. function IsAnagram(const S1, S2: String; IgnoreSpaces: Boolean = True; ExceptionOnError: Boolean = False): Boolean;
21. var
22.   p, pe: PChar;
23.   i: byte;
24.   Cnt: array [0..255] of MyInt;
25.  
26.   Cnt2: array [0..255] of SizeInt absolute Cnt;
27.   Cnt_Or: SizeInt;
28. const
29.   _Factor = (sizeof(SizeInt) div sizeof(MyInt));
30.   Rng1H = $20 div _Factor - 1;
31.   Rng2L = $20 div _Factor;
32.   Rng2H = $40 div _Factor - 1;
33. begin
34.   FillChar(Cnt, sizeof(Cnt), 0);
35.  
36.   p := pchar(s1);
37.   pe := p + Length(s1);
38.   while p<pe do begin
39.     inc(Cnt[byte(p^)]);
40.     inc(p);
41.   end;
42.  
43.   {$IFDEF WITH_OR}
44.     Cnt_Or := 0;
45.     {$IFDEF SMALL_LOOP}
46.       for i := 0 to 3 do Cnt_Or := Cnt_Or or Cnt2[i];
47.       {$IF Rng1H >= 4} for i := 4 to 7 do Cnt_Or := Cnt_Or or Cnt2[i];     {$ENDIF}
48.       {$IF Rng1H >= 8} for i := 8 to 11 do Cnt_Or := Cnt_Or or Cnt2[i];      {$ENDIF}
49.       {$IF Rng1H >= 12} for i := 12 to Rng1H do Cnt_Or := Cnt_Or or Cnt2[i];      {$ENDIF}
50.     {$ELSE}
51.       for i := 0 to Rng1H do Cnt_Or := Cnt_Or or Cnt2[i];
52.     {$ENDIF}
53.     if Cnt_Or <> 0 then
54.       if ExceptionOnError then raise Exception.Create('invalid')
55.       else exit(False);
56.   {$ELSE}
57.     {$IFDEF SMALL_LOOP}
58.       for i := $00 to $03 do if Cnt[i] <> 0 then
59.         if ExceptionOnError then raise Exception.Create('invalid')
60.         else exit(False);
61.       for i := $04 to $07 do if Cnt[i] <> 0 then
62.         if ExceptionOnError then raise Exception.Create('invalid')
63.         else exit(False);
64.       for i := $08 to $0B do if Cnt[i] <> 0 then
65.         if ExceptionOnError then raise Exception.Create('invalid')
66.         else exit(False);
67.       for i := $0C to $0F do if Cnt[i] <> 0 then
68.         if ExceptionOnError then raise Exception.Create('invalid')
69.         else exit(False);
70.       for i := $10 to $13 do if Cnt[i] <> 0 then
71.         if ExceptionOnError then raise Exception.Create('invalid')
72.         else exit(False);
73.       for i := $14 to $17 do if Cnt[i] <> 0 then
74.         if ExceptionOnError then raise Exception.Create('invalid')
75.         else exit(False);
76.       for i := $18 to $1B do if Cnt[i] <> 0 then
77.         if ExceptionOnError then raise Exception.Create('invalid')
78.         else exit(False);
79.       for i := $1C to $1F do if Cnt[i] <> 0 then
80.         if ExceptionOnError then raise Exception.Create('invalid')
81.         else exit(False);
82.     {$ELSE}
83.       for i := $00 to $1F do if Cnt[i] <> 0 then
84.         if ExceptionOnError then raise Exception.Create('invalid')
85.         else exit(False);
86.     {$ENDIF}
87.   {$ENDIF}
88.  
89.   p := pchar(s2);
90.   pe := p + Length(s2);
91.   while p<pe do begin
92.     dec(Cnt[byte(p^)]);
93.     inc(p);
94.   end;
95.  
96.  
97.   {$IFDEF WITH_OR}
98.  
99.     if ExceptionOnError then begin
100.       Cnt_Or := 0;
101.  
102.       {$IFDEF SMALL_LOOP}
103.         for i := 0 to 3 do Cnt_Or := Cnt_Or or Cnt2[i];
104.         {$IF Rng1H >= 4} for i := 4 to 7 do Cnt_Or := Cnt_Or or Cnt2[i];        {$ENDIF}
105.         {$IF Rng1H >= 8} for i := 8 to 11 do Cnt_Or := Cnt_Or or Cnt2[i];        {$ENDIF}
106.         {$IF Rng1H >= 12} for i := 12 to Rng1H do Cnt_Or := Cnt_Or or Cnt2[i];        {$ENDIF}
107.       {$ELSE}
108.         for i := 0 to Rng1H do Cnt_Or := Cnt_Or or Cnt2[i];
109.       {$ENDIF}
110.       if Cnt_Or <> 0 then raise Exception.Create('invalid'); // Must be first
111.  
112.       for i := $41 to $5A do Cnt_Or := Cnt_Or or (Cnt[i]+Cnt[i+$20]);
113.       {$IFDEF WITH_EARLYEXIT}
114.       if Cnt_Or <> 0 then exit(false);
115.       {$ENDIF}
116.  
117.       {$IF _Factor = 1}
118.         if IgnoreSpaces then
119.           for i := $21 to $40 do Cnt_Or := Cnt_Or or Cnt[i]
120.         else
121.           for i := $20 to $40 do Cnt_Or := Cnt_Or or Cnt[i];
122.       {$ELSE}
123.         if IgnoreSpaces then Cnt[$20] := 0;
124.         {$IFDEF SMALL_LOOP}
125.           for i := Rng2L to Rng2L+3 do Cnt_Or := Cnt_Or or Cnt2[i];
126.           {$IF Rng2H-Rng2L >= 4} for i := Rng2L+4 to Rng2L+7 do Cnt_Or := Cnt_Or or Cnt2[i];          {$ENDIF}
127.           {$IF Rng2H-Rng2L >= 8} for i := Rng2L+8 to Rng2L+11 do Cnt_Or := Cnt_Or or Cnt2[i];          {$ENDIF}
128.           {$IF Rng2H-Rng2L >= 12} for i := Rng2L+12 to Rng2H do Cnt_Or := Cnt_Or or Cnt2[i];          {$ENDIF}
129.         {$ELSE}
130.           for i := Rng2L to Rng2H do Cnt_Or := Cnt_Or or Cnt2[i];
131.         {$ENDIF}
132.       {$ENDIF}
133.       {$IFDEF WITH_EARLYEXIT}
134.       if Cnt_Or <> 0 then exit(false);
135.       {$ENDIF}
136.  
137.       for i := $5B to $60 do Cnt_Or := Cnt_Or or Cnt[i];
138.       for i := $7B to $7F do Cnt_Or := Cnt_Or or Cnt[i];
139.  
140.       Result := Cnt_Or=0;
141.     end
142.     else begin
143.       Cnt_Or := 0;
144.  
145.       for i := $41 to $5A do Cnt_Or := Cnt_Or or (Cnt[i]+Cnt[i+$20]);
146.       {$IFDEF WITH_EARLYEXIT}
147.       if Cnt_Or <> 0 then exit(false);
148.       {$ENDIF}
149.  
150.       {$IF _Factor = 1}
151.         if IgnoreSpaces then
152.           for i := $21 to $40 do Cnt_Or := Cnt_Or or Cnt[i]
153.         else
154.           for i := $20 to $40 do Cnt_Or := Cnt_Or or Cnt[i];
155.       {$ELSE}
156.         if IgnoreSpaces then Cnt[$20] := 0;
157.         {$IFDEF SMALL_LOOP}
158.           for i := Rng2L to Rng2L+3 do Cnt_Or := Cnt_Or or Cnt2[i];
159.           {$IF Rng2H-Rng2L >= 4} for i := Rng2L+4 to Rng2L+7 do Cnt_Or := Cnt_Or or Cnt2[i];          {$ENDIF}
160.           {$IF Rng2H-Rng2L >= 8} for i := Rng2L+8 to Rng2L+11 do Cnt_Or := Cnt_Or or Cnt2[i];          {$ENDIF}
161.           {$IF Rng2H-Rng2L >= 12} for i := Rng2L+12 to Rng2H do Cnt_Or := Cnt_Or or Cnt2[i];          {$ENDIF}
162.         {$ELSE}
163.           for i := Rng2L to Rng2H do Cnt_Or := Cnt_Or or Cnt2[i];
164.         {$ENDIF}
165.       {$ENDIF}
166.  
167.       for i := $5B to $60 do Cnt_Or := Cnt_Or or Cnt[i];
168.       for i := $7B to $7F do Cnt_Or := Cnt_Or or Cnt[i];
169.       {$IFDEF WITH_EARLYEXIT}
170.       if Cnt_Or <> 0 then exit(false);
171.       {$ENDIF}
172.  
173.       {$IFDEF SMALL_LOOP}
174.         for i := 0 to 3 do Cnt_Or := Cnt_Or or Cnt2[i];
175.         {$IF Rng1H >= 4} for i := 4 to 7 do Cnt_Or := Cnt_Or or Cnt2[i];        {$ENDIF}
176.         {$IF Rng1H >= 8} for i := 8 to 11 do Cnt_Or := Cnt_Or or Cnt2[i];        {$ENDIF}
177.         {$IF Rng1H >= 12} for i := 12 to Rng1H do Cnt_Or := Cnt_Or or Cnt2[i];        {$ENDIF}
178.       {$ELSE}
179.         for i := 0 to Rng1H do Cnt_Or := Cnt_Or or Cnt2[i];
180.       {$ENDIF}
181.  
182.       Result := Cnt_Or=0;
183.     end;
184.  
185.   {$ELSE} // WITH_OR;
186.  
187.     if ExceptionOnError then begin
188.       for i := $00 to $1F do if Cnt[i] <> 0 then
189.         raise Exception.Create('invalid'); // Must be first
190.  
191.       for i := $41 to $5A do
192.         if Cnt[i] <> -Cnt[i+$20] then exit(False);
193.  
194.       if IgnoreSpaces then begin
195.         for i := $21 to $40 do if Cnt[i] <> 0 then exit(False);
196.       end
197.       else begin
198.         for i := $20 to $40 do if Cnt[i] <> 0 then exit(False);
199.       end;
200.       for i := $5B to $60 do if Cnt[i] <> 0 then exit(False);
201.       for i := $7B to $7F do if Cnt[i] <> 0 then exit(False);
202.  
203.       Result := True;
204.     end
205.     else begin
206.       for i := $41 to $5A do
207.         if Cnt[i] <> -Cnt[i+$20] then exit(False);
208.  
209.       if IgnoreSpaces then begin
210.         for i := $21 to $40 do if Cnt[i] <> 0 then exit(False);
211.       end
212.       else begin
213.         for i := $20 to $40 do if Cnt[i] <> 0 then exit(False);
214.       end;
215.       for i := $5B to $60 do if Cnt[i] <> 0 then exit(False);
216.       for i := $7B to $7F do if Cnt[i] <> 0 then exit(False);
217.  
218.       for i := $00 to $1F do if Cnt[i] <> 0 then
219.         exit(False);
220.  
221.       Result := True;
222.     end;
223.  
224.   {$ENDIF}
225. end;
226.  
227.  
228. procedure main;
229. const
230.   ITERATIONS = 1000*1000*5;
231.   //ITERATIONS = 1;
232.   TEST: array of string = (
233.     'foo', 'bar', 'hello world', 'word hell lo', 'foo'#1,
234.     'Foo', 'baR', 'hello World', 'word Hell lo', 'fOo'#1,
235.     'Foo 1', '1  fOO', '2 fOO'
236.   );
237. var
238.   i, i2, n: integer;
239.   s, s2, t, a, a2: string;
240.   d: QWord;
241. begin
242.   if not IsAnagram('bar', 'bar', False, False)   then raise exception.Create('!');
243.   if not IsAnagram('bar', 'bAr', False, False)   then raise exception.Create('!');
244.   if not IsAnagram('bar ', ' bAr', False, False)   then raise exception.Create('!');
245.   if not IsAnagram('bar 1', '1 bAr', False, False)   then raise exception.Create('!');
246.   if not IsAnagram('bar !', '! bAr', False, False)   then raise exception.Create('!');
247.  
248.   if     IsAnagram('bar 1', '1bAr', False, False)     then raise exception.Create('!'); // space
249.   if     IsAnagram('bar 1', '1  bAr', False, False)   then raise exception.Create('!'); // space
250.   if not IsAnagram('bar 1', '1bAr', True, False)      then raise exception.Create('!'); // space
251.   if not IsAnagram('bar 1', '1   bAr', True, False)   then raise exception.Create('!'); // space
252.  
253.   if     IsAnagram('bar'#1,  'bar'#1, False, False) then raise exception.Create('!');
254.   if     IsAnagram('bar'#3,  'bar'#3, False, False) then raise exception.Create('!');
255.   if     IsAnagram('bar'#4,  'bar'#4, False, False) then raise exception.Create('!');
256.   if     IsAnagram('bar'#7,  'bar'#7, False, False) then raise exception.Create('!');
257.   if     IsAnagram('bar'#8,  'bar'#8, False, False) then raise exception.Create('!');
258.   if     IsAnagram('bar'#15, 'bar'#15, False, False) then raise exception.Create('!');
259.   if     IsAnagram('bar'#16, 'bar'#16, False, False) then raise exception.Create('!');
260.   if     IsAnagram('bar'#23, 'bar'#23, False, False) then raise exception.Create('!');
261.   if     IsAnagram('bar'#24, 'bar'#24, False, False) then raise exception.Create('!');
262.   if     IsAnagram('bar'#31, 'bar'#31, False, False) then raise exception.Create('!');
263.  
264.   for s in TEST do
265.   for s2 in TEST do
266.   for i := 1 to 10 do
267.   for i2 := 1 to 10 do
268.   begin
269.     a := s;
270.     a2 := s2;
271.     for n := 1 to i do
272.       a := a + a;
273.     for n := 1 to i2 do
274.       a2 := a2 + a2;
275.  
276.     t := '';
277.     write(format('------------- %20s %20s %3d %3d ', [ s, s2, i,  i2]));
278.  
279.     if  IsAnagram(a, a2, False, False) then t := t + ' T ' else t := t + ' F ';
280.  
281.     d := GetTickCount64;
282.     for n := 0 to ITERATIONS do IsAnagram(a, a2, False, False);
283.     d := GetTickCount64 - d;
284.     t := t + IntToStr(d) + ' ';
285.  
286.     d := GetTickCount64;
287.     for n := 0 to ITERATIONS do IsAnagram(a, a2, True, False);
288.     d := GetTickCount64 - d;
289.     t := t + IntToStr(d) + ' ';
290.  
291.     d := GetTickCount64;
292.     for n := 0 to ITERATIONS do try IsAnagram(a, a2, False, True); except end;
293.     d := GetTickCount64 - d;
294.     t := t + IntToStr(d) + ' ';
295.  
296.     d := GetTickCount64;
297.     for n := 0 to ITERATIONS do try IsAnagram(a, a2, True, True); except end;
298.     d := GetTickCount64 - d;
299.     t := t + IntToStr(d) + ' ';
300.  
301.     writeln(t);
302. //if s = 'bar' then exit;
303. //if s2 = 'foo'#1 then exit;
304.   end;
305.  
306.  
307.   readln;
308. end;
309.  
310. begin
311.   main;
312. end.