Page 2 of 2
Re: IsAnagram()
Posted: Mon Jul 25, 2011 10:50 pm
by 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
Re: IsAnagram()
Posted: Tue Jul 26, 2011 6:42 am
by 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
Re: IsAnagram()
Posted: Tue Jul 26, 2011 7:37 am
by DarkDragon
luis wrote:@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
.
Re: IsAnagram()
Posted: Tue Jul 26, 2011 11:15 am
by luis
DarkDragon wrote:
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 !