Contest: fastest IsAnagram function

ALLIGATOR

New Member
Posts: 24

Re: Contest: fastest IsAnagram function

« Reply #169 on: November 01, 2024, 08:08:22 pm »

Hmmm... please take a look, I took the test from some of the first pages of the topic and I'm testing on it....
I also took the avk algorithm and it seems that on the test data you provided - the results are similar...

FPC trunk, Win64

Code: Pascal [Select][+]

program app;
 
// on WINDOWS use QueryPerformanceCounter
{$ifdef WINDOWS}
uses SysUtils, Windows, math;
 
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 IsAnagramALLIGATOR(const S1, S2: String; IgnoreSpaces: Boolean = True; ExceptionOnError: Boolean = False): Boolean;
type
  TFreq = array [32..127+1] of Int16;
const
  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,
                  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
  i: SizeInt;
  freq: TFreq;
  ch: uint8;
begin
  Result := False;
  FillQWord(freq, SizeOf(freq) div 8, 0);
 
  i:=0;
  while i<Length(S1) do
  begin
    inc(i);
    ch:=ord(S1[i]);
 
    case ch of
      32..64, 91..127: Inc(freq[ch]);
      65..90: Inc(freq[ch or $20]);
      else
        if ExceptionOnError then Raise ERangeError.CreateFmt('IsAnagram: illegal character in S1 at position %d',[i]);
    end;
  end;
 
  i:=0;
  while i<Length(S2) do
  begin
    inc(i);
    ch:=ord(S2[i]);
 
    case ch of
      32..64, 91..127: Dec(freq[ch]);
      65..90: Dec(freq[ch or $20]);
      else
        if ExceptionOnError then Raise ERangeError.CreateFmt('IsAnagram: illegal character in S1 at position %d',[i]);
    end;
  end;
 
  if IgnoreSpaces then
  begin
    Result := CompareDWord(freq[Low(freq)+1], FZero[Low(FZero)], SizeOf(TFreq) div 4)=0;
  end else
  begin
    Result := CompareDWord(freq[Low(freq)], FZero[Low(FZero)], SizeOf(TFreq) div 4)=0;
  end;
end;
 
function IsAnagram_avk(const s1, s2: string; aIgnoreSpaces: Boolean = True; aExceptionOnError: Boolean = False): Boolean;
type
{$IFDEF CPU64}
  TChunk = QWord;
{$ELSE}
  TChunk = DWord;
{$ENDIF}
  PChunk = ^TChunk;
const
{$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT}
  {$IFDEF CPU64}
  MASK = 7;
  {$ELSE}
  MASK = 3;
  {$ENDIF}
{$ENDIF}
{$IFDEF CPU64}
  BITS5 = QWord($2020202020202020);
  BITS6 = QWord($4040404040404040);
  BITS7 = QWord($8080808080808080);
{$ELSE}
  BITS5 = DWord($20202020);
  BITS6 = DWord($40404040);
  BITS7 = DWord($80808080);
{$ENDIF}
  ERR_FMT = 'Illegal character in %s, position %d(#%d)';
 
  function Invalid(aOfs: Integer; aFirstArg: Boolean): Boolean;
  begin
    Invalid := False;
    if aExceptionOnError then
      if aFirstArg then
        raise ERangeError.CreateFmt(ERR_FMT, ['s1', aOfs, Ord(s1[aOfs])])
      else
        raise ERangeError.CreateFmt(ERR_FMT, ['s2', aOfs, Ord(s2[aOfs])])
  end;
 
  function InvalidUp(aFlags: TChunk; aOfs: Integer; aFirstArg: Boolean): Boolean;
  begin
    {$IFDEF ENDIAN_BIG}aFlags := SwapEndian(aFlags);{$ENDIF}
    Inc(aOfs,{$IFDEF CPU64}BsfQWord{$ELSE}BsfDWord{$ENDIF}(aFlags) div 8);
    Result := Invalid(aOfs, aFirstArg);
  end;
 
  function InvalidLo(aFlags: TChunk; aOfs: Integer; aFirstArg: Boolean): Boolean;
  begin
    {$IFDEF ENDIAN_BIG}aFlags := SwapEndian(aFlags);{$ENDIF}
    Inc(aOfs,{$IFDEF CPU64}BsfQWord{$ELSE}BsfDWord{$ENDIF}(aFlags xor BITS5) div 8);
    Result := Invalid(aOfs, aFirstArg);
  end;
 
type
{$IFDEF CPU64}
  TShortBuffer = array[0..8] of QWord;
{$ELSE}
  TShortBuffer = array[0..17] of DWord;
{$ENDIF}
const
{$PUSH}{$J-}
{$IFDEF CPU64}
  ZERO_BUF: TShortBuffer = (0,0,0,0,0,0,0,0,0);
{$ELSE}
  ZERO_BUF: TShortBuffer = (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
{$ENDIF}
  CI_MAP: array[32..127] of Byte = (
    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, 65, 66, 67, 68, 69, 70, 71,
    72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91,
    92, 93, 94, 95, 96, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79,
    80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 97, 98, 99, 100, 101
  );
{$POP}
  function TestShort(const s1, s2: string): Boolean;
  var
    Buf: TShortBuffer;
    Counter: array[32..101] of ShortInt absolute Buf;
    p, pEnd: PByte;
  begin
    Buf := ZERO_BUF;
 
    p := PByte(s1);
    PEnd := p + Length(s1);
  {$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT}
    while (p < pEnd) and (SizeUInt(p) and MASK <> 0) do begin
      if p^ in [32..127] then Inc(Counter[CI_MAP[p^]])
      else exit(Invalid(Succ(p - PByte(s1)), True));
      Inc(p);
    end;
  {$ENDIF}
    while p < pEnd - SizeOf(TChunk) do begin
      if PChunk(p)^ and BITS7 <> 0 then
        exit(InvalidUp(PChunk(p)^ and BITS7, p-PByte(s1)+1, True));
      if (PChunk(p)^ and BITS5) or ((PChunk(p)^ and BITS6) shr 1) < BITS5 then
        exit(InvalidLo((PChunk(p)^ and BITS5) or ((PChunk(p)^ and BITS6) shr 1), p-PByte(s1)+1, True));
      Inc(Counter[CI_MAP[p[0]]]); Inc(Counter[CI_MAP[p[1]]]);
      Inc(Counter[CI_MAP[p[2]]]); Inc(Counter[CI_MAP[p[3]]]);
    {$IFDEF CPU64}
      Inc(Counter[CI_MAP[p[4]]]); Inc(Counter[CI_MAP[p[5]]]);
      Inc(Counter[CI_MAP[p[6]]]); Inc(Counter[CI_MAP[p[7]]]);
    {$ENDIF}
      Inc(p, SizeOf(TChunk));
    end;
    while p < pEnd do begin
      if p^ in [32..127] then Inc(Counter[CI_MAP[p^]])
      else exit(Invalid(Succ(p - PByte(s1)), True));
      Inc(p);
    end;
 
    p := PByte(s2);
    PEnd := p + Length(s2);
  {$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT}
    while (p < pEnd) and (SizeUInt(p) and MASK <> 0) do begin
      if p^ in [32..127] then Dec(Counter[CI_MAP[p^]])
      else exit(Invalid(Succ(p - PByte(s2)), False));
      Inc(p);
    end;
  {$ENDIF}
    while p < pEnd - SizeOf(TChunk) do begin
      if PChunk(p)^ and BITS7 <> 0 then
        exit(InvalidUp(PChunk(p)^ and BITS7, p-PByte(s2)+1, False));
      if (PChunk(p)^ and BITS5) or ((PChunk(p)^ and BITS6) shr 1) < BITS5 then
        exit(InvalidLo((PChunk(p)^ and BITS5) or ((PChunk(p)^ and BITS6) shr 1), p-PByte(s2)+1, False));
      Dec(Counter[CI_MAP[p[0]]]); Dec(Counter[CI_MAP[p[1]]]);
      Dec(Counter[CI_MAP[p[2]]]); Dec(Counter[CI_MAP[p[3]]]);
    {$IFDEF CPU64}
      Dec(Counter[CI_MAP[p[4]]]); Dec(Counter[CI_MAP[p[5]]]);
      Dec(Counter[CI_MAP[p[6]]]); Dec(Counter[CI_MAP[p[7]]]);
    {$ENDIF}
      Inc(p, SizeOf(TChunk));
    end;
    while p < pEnd do begin
      if p^ in [32..127] then Dec(Counter[CI_MAP[p^]])
      else exit(Invalid(Succ(p - PByte(s2)), False));
      Inc(p);
    end;
 
    if aIgnoreSpaces then Counter[32] := 0;
  {$IFDEF CPU64}
    if Buf[0] or Buf[1] or Buf[2] or Buf[3] or Buf[4] or
       Buf[5] or Buf[6] or Buf[7] or Buf[8] <> 0 then exit(False);
  {$ELSE}
    if Buf[0] or Buf[1] or Buf[2] or Buf[3] or Buf[4] or Buf[5] or Buf[6] or Buf[7] or
       Buf[8] or Buf[9] or Buf[10] or Buf[11] or Buf[12] or Buf[13] or Buf[14] or
       Buf[15] or Buf[16] or Buf[17] <> 0 then exit(False);
  {$ENDIF}
    Result := True;
  end;
 
const
  SHORT  = 126;
var
  Counter: array[32..127] of Integer;
  p, pEnd: PByte;
  I: Integer;
begin
  if (s1 = '') or (s2 = '') then
    exit(False);
  if not aIgnoreSpaces and not aExceptionOnError and (Length(s1) <> Length(s2)) then
    exit(False);
  if Math.Max(Length(s1), Length(s2)) <= SHORT then
    exit(TestShort(s1, s2));
 
  FillChar(Counter, SizeOf(Counter), 0);
 
  p := PByte(s1);
  PEnd := p + Length(s1);
{$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT}
  while (p < pEnd) and (SizeUInt(p) and MASK <> 0) do begin
    if p^ in [32..127] then Inc(Counter[p^])
    else exit(Invalid(Succ(p - PByte(s1)), True));
    Inc(p);
  end;
{$ENDIF}
  while p < pEnd - SizeOf(TChunk) do begin
    if PChunk(p)^ and BITS7 <> 0 then
      exit(InvalidUp(PChunk(p)^ and BITS7, p-PByte(s1)+1, True));
    if (PChunk(p)^ and BITS5) or ((PChunk(p)^ and BITS6) shr 1) < BITS5 then
      exit(InvalidLo((PChunk(p)^ and BITS5) or ((PChunk(p)^ and BITS6) shr 1), p-PByte(s1)+1, True));
    Inc(Counter[p[0]]); Inc(Counter[p[1]]);
    Inc(Counter[p[2]]); Inc(Counter[p[3]]);
  {$IFDEF CPU64}
    Inc(Counter[p[4]]); Inc(Counter[p[5]]);
    Inc(Counter[p[6]]); Inc(Counter[p[7]]);
  {$ENDIF}
    Inc(p, SizeOf(TChunk));
  end;
  while p < pEnd do begin
    if p^ in [32..127] then Inc(Counter[p^])
    else exit(Invalid(Succ(p - PByte(s1)), True));
    Inc(p);
  end;
  for I := 97 to 122 do
    if Counter[I] <> 0 then begin
      Inc(Counter[I-32], Counter[I]);
      Counter[I] := 0;
    end;
 
  p := PByte(s2);
  PEnd := p + Length(s2);
{$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT}
  while (p < pEnd) and (SizeUInt(p) and MASK <> 0) do begin
    if p^ in [32..127] then Dec(Counter[p^])
    else exit(Invalid(Succ(p - PByte(s2)), False));
    Inc(p);
  end;
{$ENDIF}
  while p < pEnd - SizeOf(TChunk) do begin
    if PChunk(p)^ and BITS7 <> 0 then
      exit(InvalidUp(PChunk(p)^ and BITS7, p-PByte(s2)+1, False));
    if (PChunk(p)^ and BITS5) or ((PChunk(p)^ and BITS6) shr 1) < BITS5 then
      exit(InvalidLo((PChunk(p)^ and BITS5) or ((PChunk(p)^ and BITS6) shr 1), p-PByte(s2)+1, False));
    Dec(Counter[p[0]]); Dec(Counter[p[1]]);
    Dec(Counter[p[2]]); Dec(Counter[p[3]]);
  {$IFDEF CPU64}
    Dec(Counter[p[4]]); Dec(Counter[p[5]]);
    Dec(Counter[p[6]]); Dec(Counter[p[7]]);
  {$ENDIF}
    Inc(p, SizeOf(TChunk));
  end;
  while p < pEnd do begin
    if p^ in [32..127] then Dec(Counter[p^])
    else exit(Invalid(Succ(p - PByte(s2)), False));
    Inc(p);
  end;
  for I := 97 to 122 do
    if Counter[I] <> 0 then
      Inc(Counter[I-32], Counter[I]);
 
  if aIgnoreSpaces then Counter[32] := 0;
  I := 32;
  while I < 95 do begin
    if Counter[I] or Counter[I+1] or Counter[I+2] or Counter[I+3] <> 0 then
      exit(False);
    Inc(I, 4);
  end;
  if Counter[96] or Counter[123] or Counter[124] or Counter[125] or Counter[126] or Counter[127] <> 0 then
    exit(False);
  Result := True;
end;
 
procedure main;
const
  ITERATIONS = 1000*1000*5;
var
  i, c: integer;
  s, d: string;
  u: ptruint;
begin
//{$IFDEF kaka}
 
  s:='1234567890';
  d:='0 1 2 3 4 5 6 7 8 9 ';
 
  //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('ALLIGATOR: IgnoreSpaces + ExceptionOnError':50);
  c := 0;
  u := GetTickCount64;
  for i := 1 to ITERATIONS do if IsAnagramALLIGATOR(s, d, true, true) then c += 1;
  write(' | ', (GetTickCount64-u):4, ' ms');
  write(' | result ', c);
  writeln;
  // -------------------------------------
  write('avk: IgnoreSpaces + ExceptionOnError':50);
  c := 0;
  u := GetTickCount64;
  for i := 1 to ITERATIONS do if IsAnagram_avk(s, d, true, true) then c += 1;
  write(' | ', (GetTickCount64-u):4, ' ms');
  write(' | result ', c);
  writeln;
  // -------------------------------------
  write('ALLIGATOR: IgnoreSpaces':50);
  c := 0;
  u := GetTickCount64;
  for i := 1 to ITERATIONS do if IsAnagramALLIGATOR(s, d, true, false) then c += 1;
  write(' | ', (GetTickCount64-u):4, ' ms');
  write(' | result ', c);
  writeln;
  // -------------------------------------
  write('avk: IgnoreSpaces':50);
  c := 0;
  u := GetTickCount64;
  for i := 1 to ITERATIONS do if IsAnagram_avk(s, d, true, false) then c += 1;
  write(' | ', (GetTickCount64-u):4, ' ms');
  write(' | result ', c);
  writeln;
  // -------------------------------------
  write('ALLIGATOR':50);
  c := 0;
  u := GetTickCount64;
  for i := 1 to ITERATIONS do if IsAnagramALLIGATOR(s, d, false, false) then c += 1;
  write(' | ', (GetTickCount64-u):4, ' ms');
  write(' | result ', c);
  writeln;
  // -------------------------------------
  write('avk':50);
  c := 0;
  u := GetTickCount64;
  for i := 1 to ITERATIONS do if IsAnagram_avk(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('ALLIGATOR: IgnoreSpaces + ExceptionOnError':50);
  c := 0;
  u := GetTickCount64;
  for i := 1 to ITERATIONS do if IsAnagramALLIGATOR(s, d, true, true) then c += 1;
  write(' | ', (GetTickCount64-u):4, ' ms');
  write(' | result ', c);
  writeln;
  // -------------------------------------
  write('avk: IgnoreSpaces + ExceptionOnError':50);
  c := 0;
  u := GetTickCount64;
  for i := 1 to ITERATIONS do if IsAnagram_avk(s, d, true, true) then c += 1;
  write(' | ', (GetTickCount64-u):4, ' ms');
  write(' | result ', c);
  writeln;
  // -------------------------------------
  write('ALLIGATOR: IgnoreSpaces':50);
  c := 0;
  u := GetTickCount64;
  for i := 1 to ITERATIONS do if IsAnagramALLIGATOR(s, d, true, false) then c += 1;
  write(' | ', (GetTickCount64-u):4, ' ms');
  write(' | result ', c);
  writeln;
  // -------------------------------------
  write('avk: IgnoreSpaces':50);
  c := 0;
  u := GetTickCount64;
  for i := 1 to ITERATIONS do if IsAnagram_avk(s, d, true, false) then c += 1;
  write(' | ', (GetTickCount64-u):4, ' ms');
  write(' | result ', c);
  writeln;
  // -------------------------------------
  write('ALLIGATOR':50);
  c := 0;
  u := GetTickCount64;
  for i := 1 to ITERATIONS do if IsAnagramALLIGATOR(s, d, false, false) then c += 1;
  write(' | ', (GetTickCount64-u):4, ' ms');
  write(' | result ', c);
  writeln;
  // -------------------------------------
  write('avk':50);
  c := 0;
  u := GetTickCount64;
  for i := 1 to ITERATIONS do if IsAnagram_avk(s, d, false, false) then c += 1;
  write(' | ', (GetTickCount64-u):4, ' ms');
  write(' | result ', c);
  writeln;
  // -------------------------------------
 
  writeln;
//{$ENDIF}
 
  //s := 'Invalid';
  //d := 'Diff length';
  writeln('*** ROUND 3: Invalid chars ***');
  writeln('s1 = ', s);
  writeln('s2 = ', d);
  writeln;
 
  // -------------------------------------
  write('ALLIGATOR: IgnoreSpaces + ExceptionOnError':50);
  c := 0;
  u := GetTickCount64;
  for i := 1 to ITERATIONS do if IsAnagramALLIGATOR(s, d, true, true) then c += 1;
  write(' | ', (GetTickCount64-u):4, ' ms');
  write(' | result ', c);
  writeln;
  // -------------------------------------
  write('avk: IgnoreSpaces + ExceptionOnError':50);
  c := 0;
  u := GetTickCount64;
  for i := 1 to ITERATIONS do if IsAnagram_avk(s, d, true, true) then c += 1;
  write(' | ', (GetTickCount64-u):4, ' ms');
  write(' | result ', c);
  writeln;
  // -------------------------------------
  write('ALLIGATOR: IgnoreSpaces':50);
  c := 0;
  u := GetTickCount64;
  for i := 1 to ITERATIONS do if IsAnagramALLIGATOR(s, d, true, false) then c += 1;
  write(' | ', (GetTickCount64-u):4, ' ms');
  write(' | result ', c);
  writeln;
  // -------------------------------------
  write('avk: IgnoreSpaces':50);
  c := 0;
  u := GetTickCount64;
  for i := 1 to ITERATIONS do if IsAnagram_avk(s, d, true, false) then c += 1;
  write(' | ', (GetTickCount64-u):4, ' ms');
  write(' | result ', c);
  writeln;
  // -------------------------------------
  write('ALLIGATOR':50);
  c := 0;
  u := GetTickCount64;
  for i := 1 to ITERATIONS do if IsAnagramALLIGATOR(s, d, false, false) then c += 1;
  write(' | ', (GetTickCount64-u):4, ' ms');
  write(' | result ', c);
  writeln;
  // -------------------------------------
  write('avk':50);
  c := 0;
  u := GetTickCount64;
  for i := 1 to ITERATIONS do if IsAnagram_avk(s, d, false, false) then c += 1;
  write(' | ', (GetTickCount64-u):4, ' ms');
  write(' | result ', c);
  writeln;
  // -------------------------------------
 
  readln;
end;
 
begin
  main;
end.
 

Logged

avk

Hero Member
Posts: 769

Re: Contest: fastest IsAnagram function

« Reply #170 on: November 01, 2024, 08:56:09 pm »

Somewhere closer to the beginning of the thread there are examples of test anagrams and code used for validity check.

But even without them you can see:
Line 33: you zero out 96 elements of the freq array and are left with garbage(if any) in 97.
Line 45,59: if ExceptionOnError is True, an exception is raised. If not, execution just continues, ignoring the illegal character.

« Last Edit: November 01, 2024, 08:59:17 pm by avk »

Logged

BrunoK

Hero Member
Posts: 623
Retired programmer

Re: Contest: fastest IsAnagram function

« Reply #171 on: November 01, 2024, 09:11:50 pm »

Quote from: ALLIGATOR on November 01, 2024, 08:08:22 pm

Hmmm... please take a look, I took the test from some of the first pages of the topic and I'm testing on it....
I also took the avk algorithm and it seems that on the test data you provided - the results are similar...

In my tests,

Code: Text [Select][+]

*** ROUND 5: Long invalid chars ***
s1 = !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~âO'
s2 = âO'~}|{zyxw vutsrqpon mlkjihgfe dcba`_^]\ [ZYXWVUTS RQPONMLKJ IHGFEDCBA @?>=<;:98 76543210/ .-,+*)('& %$#"!
                                 Bart IgnoreSpaces |  12.054 ms | result 0
                               ASerge IgnoreSpaces |   7.857 ms | result 0
                               BrunoK IgnoreSpaces |   5.744 ms | result 0
                              BrunoKb IgnoreSpaces |   5.031 ms | result 0
                              BrunoK2 IgnoreSpaces |   9.424 ms | result 0
                             Delphius IgnoreSpaces |   7.968 ms | result 0
                               PawelD IgnoreSpaces |   6.883 ms | result 0
                           Fibonacci2 IgnoreSpaces |   5.164 ms | result 0
                           Fibonacci4 IgnoreSpaces |  11.451 ms | result 0
                           Benibela_K IgnoreSpaces |   4.692 ms | result 0
                             Benibela IgnoreSpaces |   6.911 ms | result 0
                            ALLIGATOR IgnoreSpaces |  12.768 ms | result 50000
                       Silvercoder70B IgnoreSpaces |   8.732 ms | result 0
                                  Avk IgnoreSpaces |   4.781 ms | result 0
                                 Avk2 IgnoreSpaces |   5.070 ms | result 0
                                 Josh IgnoreSpaces |  40.224 ms | result 50000

Logged

Bart

Hero Member
Posts: 5465

Re: Contest: fastest IsAnagram function

« Reply #172 on: November 01, 2024, 11:30:11 pm »

Quote from: ALLIGATOR on November 01, 2024, 08:08:22 pm

Hmmm... please take a look, I took the test from some of the first pages of the topic and I'm testing on it....

Just ran a single test on your code:

Code: Pascal [Select][+]

begin
  //
  InitValidAnagrams;
  InitInvalidAnagrams;
  InitFuncs;
  InitUserCode;
 
  writeln('IsAnagram_Alligator(''1234567890'',''0 1 2 3 4 5 6 7 8 9 '',True, False) -> ',IsAnagram_Alligator('1234567890','0 1 2 3 4 5 6 7 8 9 ',True, False)); exit;
...

Output:

Code: [Select]

C:\Users\Bart\LazarusProjecten\bugs\forum\anagram>anagram
IsAnagram_Alligator('1234567890','0 1 2 3 4 5 6 7 8 9 ',True, False) -> FALSE

Bart

Logged

alpine

Hero Member
Posts: 1289

Re: Contest: fastest IsAnagram function

« Reply #173 on: November 02, 2024, 04:19:31 am »

Here is mine:

Code: Pascal [Select][+]

function IsAnagram_alpine(const S1, S2: String; IgnoreSpaces: Boolean = True;
  ExceptionOnError: Boolean = False): Boolean;
const
  M: array[0..127] of SmallInt = (
    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,
    65{A}, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82,
    83, 84, 85, 86, 87, 88, 89, 90{Z}, 91, 92, 93, 94, 95, 96, 65{a}, 66, 67,
    68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86,
    87, 88, 89, 90{z}, 97, 98, 99, 100, 101);
var
  I, L1, L2: SizeInt;
  F: array[0..104] of SmallInt;
  DW: array[0..36] of DWord absolute F[32];
  ZW: array[0..15] of DWord absolute F;
begin
  ZW[ 0] := 0;
  DW[ 0] := 0; DW[ 1] := 0; DW[ 2] := 0; DW[ 3] := 0; DW[ 4] := 0; DW[ 5] := 0;
  DW[ 6] := 0; DW[ 7] := 0; DW[ 8] := 0; DW[ 9] := 0; DW[10] := 0; DW[11] := 0;
  DW[12] := 0; DW[13] := 0; DW[14] := 0; DW[15] := 0; DW[16] := 0; DW[17] := 0;
  DW[18] := 0; DW[19] := 0; DW[20] := 0; DW[21] := 0; DW[22] := 0; DW[23] := 0;
  DW[24] := 0; DW[25] := 0; DW[26] := 0; DW[27] := 0; DW[28] := 0; DW[29] := 0;
  DW[30] := 0; DW[31] := 0; DW[32] := 0; DW[33] := 0; DW[34] := 0; DW[35] := 0;
  DW[36] := 0;
 
  I := 1;
  L1 := Length(S1);
  L2 := Length(S2);
 
  if L1 < L2 then
  begin
    while I <= L1 do
    begin
      Inc(F[M[Ord(S1[I])]]);
      Dec(F[M[Ord(S2[I])]]);
      Inc(I);
    end;
    while I <= L2 do
    begin
      Dec(F[M[Ord(S2[I])]]);
      Inc(I);
    end;
  end
  else
  begin
    while I <= L2 do
    begin
      Inc(F[M[Ord(S2[I])]]);
      Dec(F[M[Ord(S1[I])]]);
      Inc(I);
    end;
    while I <= L1 do
    begin
      Dec(F[M[Ord(S1[I])]]);
      Inc(I);
    end;
  end;
 
  if ExceptionOnError and (F[0] <> 0) then
    raise ERangeError.Create('Not an anagram.');
 
  if IgnoreSpaces then
    F[32] := 0;
 
  if (DW[ 0] <> 0) or (DW[ 1] <> 0) or (DW[ 2] <> 0) or (DW[ 3] <> 0) or
     (DW[ 4] <> 0) or (DW[ 5] <> 0) or (DW[ 6] <> 0) or (DW[ 7] <> 0) or
     (DW[ 8] <> 0) or (DW[ 9] <> 0) or (DW[10] <> 0) or (DW[11] <> 0) or
     (DW[12] <> 0) or (DW[13] <> 0) or (DW[14] <> 0) or (DW[15] <> 0) or
     (DW[16] <> 0) or (DW[17] <> 0) or (DW[18] <> 0) or (DW[19] <> 0) or
     (DW[20] <> 0) or (DW[21] <> 0) or (DW[22] <> 0) or (DW[23] <> 0) or
     (DW[24] <> 0) or (DW[25] <> 0) or (DW[26] <> 0) or (DW[27] <> 0) or
     (DW[28] <> 0) or (DW[29] <> 0) or (DW[30] <> 0) or (DW[31] <> 0) or
     (DW[32] <> 0) or (DW[33] <> 0) or (DW[34] <> 0) or (DW[35] <> 0) or
     (DW[36] <> 0)
  then
    Exit(False);
 
  Result := True;
end;
 

With a slight borrowing of BeniBela's up-casing trick.

Logged

"I'm sorry Dave, I'm afraid I can't do that."
—HAL 9000

Josh

Hero Member
Posts: 1344

Re: Contest: fastest IsAnagram function

« Reply #174 on: November 02, 2024, 04:38:39 am »

Hi Bart

Version 2 of my routine, should be faster, removed all the exits, so it flows better, maybe not the slowest

Code: Pascal [Select][+]

function IsAnAnagramJosh(const s1, s2: AnsiString; IgnoreSpaces: Boolean = True; ExceptionOnError: Boolean = False): boolean;  inline;
var
  //DEclaring initial values speeds up
  k:int32=0;
  Len_S1:int32=0;
  Len_S2:Int32=0;
  v:byte=0;
 
begin
  {$define UseInc}
 // {$define UseOrd}
  Len_S1:=Length(s1);
  Len_S2:=Length(s2);
  Result:=Not ((Not IgnoreSpaces and ((Len_S1<>Len_S2))) or (Len_S1 = 0) or (Len_S2 = 0));
  If Result Then
  begin
    for k:=1 to Len_S1 do
    begin
      v:={$ifdef useinc}Ord{$Else}Byte{$Endif}(S1[k]);
      if v in [josh_Arr_Start..josh_Arr_End] then {$ifdef useinc}inc(josh_FreqArray[josh_Map[v]]){$else}josh_FreqArray[josh_Map[v]]:=josh_FreqArray[josh_Map[v]]+1{$endif}
      else
      begin
        Result:=False;
        If ExceptionOnError then raise Exception.CreateFmt(josh_mess_s1,[k]);
        break;
      end;
    end;
    If Result Then
    Begin
      for k:=1 to Len_S2 do
      begin
        v:={$ifdef useinc}Ord{$Else}Byte{$Endif}(S2[k]);
        if v in [josh_Arr_Start..josh_Arr_End] then {$ifdef useinc}dec(josh_FreqArray[josh_Map[v]]){$else}josh_FreqArray[josh_Map[v]]:=josh_FreqArray[josh_Map[v]]-1{$endif}
        else
        begin
          Result:=False;
          If ExceptionOnError then raise Exception.CreateFmt(josh_mess_s2,[k]);
          break;
        end;
      end;
      If Result then
      begin
        if IgnoreSpaces then josh_FreqArray[josh_Arr_Start]:=0;
        for k:=josh_Arr_Start to $60 do     // space to Z
        begin
          if josh_FreqArray[k]<>0 then
          begin
            Result:=False;
            josh_FreqArray[k]:=0;
          end;
        end;
        if result then
        begin
          for k:=$7b to josh_Arr_End do      //{-⌂
          begin
            if josh_FreqArray[k]<>0 then
            begin
              Result:=False;
              josh_FreqArray[k]:=0;
            end;
          end;
        end;
      end;
    end;
  end;
end;         
 

Logged

The best way to get accurate information on the forum is to post something wrong and wait for corrections.

BeniBela

Hero Member
Posts: 920

Re: Contest: fastest IsAnagram function

« Reply #175 on: November 02, 2024, 03:26:29 pm »

Quote from: Bart on October 31, 2024, 06:03:28 pm

Indeed.

Code: [Select]
Testing speed Bart : 375 Bart2 : 313 Warfly : 297 Fibonacci : Failed validity test ASerge : 234 Zvoni : Failed validity test Zvoni2 : Failed validity test Alligator : Failed validity test SilverCoder : 265 AVK : 125 Paweld : 250 BrunoK : 235 Delphius : 234 Benibela : 156 Josh : 391 Nek : Failed validity test Martin : Failed validity test Dummy : Failed validity test
Bart

you have posted this three times, and each time all entries become faster?

Quote from: BrunoK on November 01, 2024, 09:11:50 pm

Code: Text [Select][+][-]
Benibela_K IgnoreSpaces | 4.692 ms | result 0
Benibela IgnoreSpaces | 6.911 ms | result 0

what is a Benibela_K?

Logged

https://www.benibela.de/index_en.html
https://github.com/benibela

BrunoK

Hero Member
Posts: 623
Retired programmer

Re: Contest: fastest IsAnagram function

« Reply #176 on: November 02, 2024, 05:13:19 pm »

Quote from: BeniBela on November 02, 2024, 03:26:29 pm

what is a Benibela_K?

Infantile modification with

Code: Pascal [Select][+]

if (length(s1) < 255) and (length(s2) < 255) then begin
    countLittle(F1l, S1);
    if not isinvalid then
      countLittle(F2l, S2);

Logged

Bart

Hero Member
Posts: 5465

Re: Contest: fastest IsAnagram function

« Reply #177 on: November 02, 2024, 05:46:08 pm »

Quote from: BeniBela on November 02, 2024, 03:26:29 pm

you have posted this three times, and each time all entries become faster?

As explained before speed runs can vary up to 15% (maybe even more), most likely depending on the stat of my computer when I run the test.
Some entries which are close to eachother mat swap places (when ranked).

Bart

Logged

Bart

Hero Member
Posts: 5465

Re: Contest: fastest IsAnagram function

« Reply #178 on: November 02, 2024, 05:49:54 pm »

Tested with new code from Alpine and updated code from Josh.

Code: [Select]

Testing speed
Bart           :   359
Bart2          :   297
Warfly         :   297
Fibonacci      : Failed validity test
ASerge         :   235
Zvoni          : Failed validity test
Zvoni2         : Failed validity test
Alligator      : Failed validity test
SilverCoder    :   297
AVK            :    94
Paweld         :   250
BrunoK         :   250
Delphius       :   234
Benibela       :   141
Josh           :   281
Nek            : Failed validity test
Alpine         : Failed validity test
Martin         : Failed validity test
Dummy          : Failed validity test

@alpine: sorry, but your code fails.

Code: [Select]

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

Bart

Logged

alpine

Hero Member
Posts: 1289

Re: Contest: fastest IsAnagram function

« Reply #179 on: November 02, 2024, 06:11:36 pm »

@Bart
I will fix it, of course, but since I've joined a bit late, can't I have a test bench source in some form. It is hard to orient in such a big topic... thanks!

Logged

"I'm sorry Dave, I'm afraid I can't do that."
—HAL 9000

Lazarus

Bookstore

Search

Recent

Author Topic: Contest: fastest IsAnagram function (Read 9103 times)

avk

Re: Contest: fastest IsAnagram function

Bart

Re: Contest: fastest IsAnagram function

ALLIGATOR

Re: Contest: fastest IsAnagram function

Bart

Re: Contest: fastest IsAnagram function

ALLIGATOR

Re: Contest: fastest IsAnagram function

avk

Re: Contest: fastest IsAnagram function

BrunoK

Re: Contest: fastest IsAnagram function

Bart

Re: Contest: fastest IsAnagram function

alpine

Re: Contest: fastest IsAnagram function

Josh

Re: Contest: fastest IsAnagram function

BeniBela

Re: Contest: fastest IsAnagram function

BrunoK

Re: Contest: fastest IsAnagram function

Bart

Re: Contest: fastest IsAnagram function

Bart

Re: Contest: fastest IsAnagram function

alpine

Re: Contest: fastest IsAnagram function

	Computer Math and Games in Pascal (preview)
	Lazarus Handbook