IsAnagram()

[RASHAD]

Code: Select all

Procedure.b IsAnagram(SourceString.s,DicoString.s)
  CreateRegularExpression(0, "[\AaA-zZ\z]")
  
  Dim Result$(0)
  a = ExtractRegularExpression(0, DicoString, result$())
  For k=0 To a-1
    Text$ = Text$ + Result$(k)
  Next
  
  a = ExtractRegularExpression(0, SourceString, result$())
  For k=0 To a-1
    Text2$ = Text2$ + Result$(k)
  Next
;         
  If Len(Text$) <> Len(Text2$)
    ProcedureReturn #False
  EndIf

  For i = 1 To Len(Text$)
   Text2$ = RemoveString(Text2$, Mid(Text$,i,1),0)
   ;Text2$ = RemoveString(Text2$, Mid(Text$,i,1),1)   For Case insensitive remove
  Next

  If Text2$ =""
      ProcedureReturn #True
  Else
      ProcedureReturn #False
  EndIf
EndProcedure


If IsAnagram("PURE BA@#$SIC","CUBE SAR!?IP")
  MessageRequester("Oh yeah","Both words are anagram")
Else
  MessageRequester("Nop !","There is no anagram")
EndIf

[wilbert]

Not the shortest code but I think it will do very well in a speed comparisson

Code: Select all

CompilerIf #PB_Compiler_Unicode
  #numChars = $FFFF
CompilerElse
  #numChars = $FF
CompilerEndIf

Global Dim charCount.u( #numChars )

Procedure IsAnagram(String1.s, String2.s)
  
  ; routine ignores characters with code below 65 (A)
  ; routine is case insensitive for character codes A - Z
  
  ; increase count for string1 characters
  
  Protected x.c, l.l = 0
  
  Protected *s.Character = @String1  
  Repeat
    x = *s\c
    *s + SizeOf(Character)
    If x > 64
      If x < 91
        x + 32
      EndIf
      charCount(x) + 1
      l + 1
    EndIf
  Until x = 0
  
  ; decrease count for string2 characters
  
  *s = @String2
  Repeat
    x.c = *s\c
    *s + SizeOf(Character)
    If x > 64
      If x < 91
        x + 32
      EndIf
      If charCount(x) = 0
        x = 0
        l = 1
      Else
        charCount(x) - 1
        l - 1
      EndIf
    EndIf
  Until x = 0
  
  ; reset count array
  
  *s = @String1
  Repeat
    x.c = *s\c
    *s + SizeOf(Character)
    charCount(x) = 0
  Until x = 0
  
  ProcedureReturn (Not l)
  
EndProcedure

Debug IsAnagram("EpURE", "UPREE")

If IsAnagram("PURE BASIC","CUBE SAR IP")
  MessageRequester("Oh yeah","Both words are anagram")
Else
  MessageRequester("Nop !","There is no anagram")
EndIf

[DarkDragon]

@Darkdragon: why isn't safe ? Sorry I don't understand.

Not because it doesn't work with unicode I hope (since I wrote it in the post).

Anyway:

Code: Select all

Procedure.i IsAnagram(a$, b$)
 CompilerIf #PB_Compiler_Unicode  
  #anagram_counter_size = 65536   
 CompilerElse
  #anagram_counter_size = 256  
 CompilerEndIf          
 Protected *a.Character, *b.Character, l, i 
 Protected Dim ac(#anagram_counter_size), Dim bc(#anagram_counter_size)
 
 l = Len(a$) : If l <> Len(b$) : ProcedureReturn 0 : EndIf 
 *a = @a$ : *b = @b$ 
 For i = 1 To l     
     ac(*a\c) + 1 : *a + SizeOf(Character)
     bc(*b\c) + 1 : *b + SizeOf(Character)
 Next 
 ProcedureReturn CompareMemory(@ac(), @bc(), #anagram_counter_size * SizeOf(Integer)) 
EndProcedure


a$ = "pure basic"
b$ = "preuabic s"
Debug IsAnagram(a$, b$)

Should work right ? Quite compact too

Yes now it should work right , but you only need

Protected Dim ac(#anagram_counter_size-1), Dim bc(#anagram_counter_size-1)

Because PureBasic would allocate 65537 elements instead of 65536 .

[luis]

Because PureBasic would allocate 65537 elements instead of 65536 .

Right, thanks, I have changed it

All this -1 stuff is really a pain in the BEEP !