04-27-2024, 11:06 PM
+1 steve did it again
compare steveCode to peteCode
to judge the speed of the routines ONLY, i leveled the playing field and used the same file access method.
taking steves point all are opened for binary access, don't worry steve yours still comes out ahead lol, but isn't it interesting with new file access petecode2 is doing allot better compared to petecode3! (at least on my crazy old system.)
Here is test code I used (same WORDS.txt file as in zip)
i changed the limit = number of times the file is accessed for each test for the following snapshots of results
limit = 1
limit = 5
limit = 10
limit = 25
compare steveCode to peteCode
Code: (Select All)
Function SteveCode$ (awrd$)
Static t As String * 30 ' ,<<< setup for time saver using string instead of array
Dim As Long i, seed, j, l
Dim wrd$
wrd$ = UCase$(awrd$) ' ,<<< to make fair i (bplus) added this to everyone's version
l = Len(wrd$)
For i = 65 To 90
seed = InStr(seed, wrd$, Chr$(i))
While seed
j = j + 1
Asc(t, j) = i ' <<<<<<<<<<<<<<<<<<<<<<< here is time saver +1
seed = InStr(seed + 1, wrd$, Chr$(i))
Wend
If seed >= l Then Exit For
Next
SteveCode$ = Left$(t, l)
End Function
Function petecode2$ (la$)
Dim rtn$, i%, seed%, j%, a$
a$ = UCase$(la$)
rtn$ = Space$(Len(a$))
For i% = 65 To 90
seed% = InStr(a$, Chr$(i%))
While seed%
j% = j% + 1
Mid$(rtn$, j%) = Chr$(i%)
seed% = InStr(seed% + 1, a$, Chr$(i%))
Wend
Next
petecode2$ = _Trim$(rtn$)
End Functionto judge the speed of the routines ONLY, i leveled the playing field and used the same file access method.
taking steves point all are opened for binary access, don't worry steve yours still comes out ahead lol, but isn't it interesting with new file access petecode2 is doing allot better compared to petecode3! (at least on my crazy old system.)
Here is test code I used (same WORDS.txt file as in zip)
Code: (Select All)
Option _Explicit
_Title "anaCode3$ versus peteCode3$ with STEVE the winner" ' b+ 2024-04-26 speed test, which Steve obviously wins. Big Grin
' anaCode$ returned to original format of len = 26 letter counts but improved?
' this is most useful to use with games using letters from words
' anacode3$ is to compare apples to apples in the function return format
' aha, i cracked petecode2() time!
' now with steveCode
Dim limit: limit = 25 ' number of times to open, run file then close
Dim a$(25000), p$(25000), s$(25000)
'''' check i made modifications correctly
'Dim test$(9)
'Dim As Integer i
'test$(0) = "grmaana"
'test$(1) = "angiogram"
'test$(2) = "naagrma"
'test$(3) = "telgram"
'test$(4) = "gramana"
'test$(5) = "gram"
'test$(6) = "nag"
'test$(7) = "tag"
'test$(8) = "am"
'test$(9) = "grip"
'For i = 0 To 9
' Print test$(i), petecode2$(test$(i)), petecode3$(test$(i))
'Next
'End
'''' ok looks right
Dim i As Integer, j As Integer
Dim start#, w$, ana3Time#, pete2Time#, altAnatime#, pete3time#, steveTime#
start# = Timer(.001)
For i = 1 To limit
j = 0
Open "WORDS.txt" For Binary As #1
While Not EOF(1)
Line Input #1, w$
j = j + 1
p$(j) = petecode2$(w$)
Wend
Close
Next
pete2Time# = Timer(.001) - start#
start# = Timer(.001)
For i = 1 To limit
j = 0
Open "WORDS.txt" For Binary As #1
While Not EOF(1)
Line Input #1, w$
j = j + 1
p$(j) = petecode3$(w$)
Wend
Close
Next
pete3time# = Timer(.001) - start#
start# = Timer(.001)
For i = 1 To limit
j = 0
Open "WORDS.txt" For Binary As #1
While Not EOF(1)
Line Input #1, w$
j = j + 1
a$(j) = altAnaCode$(w$)
Wend
Close
Next
altAnatime# = Timer(.001) - start#
start# = Timer(.001)
For i = 1 To limit
j = 0
Open "WORDS.txt" For Binary As #1
While Not EOF(1)
Line Input #1, w$
j = j + 1
a$(j) = AnaCode3$(w$)
Wend
Close
Next
ana3Time# = Timer(.001) - start#
start# = Timer(.001)
For i = 1 To limit
j = 0
Open "WORDS.txt" For Binary As #1
While Not EOF(1)
Line Input #1, w$
j = j + 1
s$(j) = SteveCode$(w$)
Wend
Close
Next
steveTime# = Timer(.001) - start#
Print "Anacode3 Time ="; ana3Time#, "PeteCode3 Time ="; pete3time#
Print "altAnaCode$ time ="; altAnatime#, "PeteCode2 Time ="; pete2Time#
Print "steveCode$ Time ="; steveTime#
Print "DIFF CHECK anaCcode3 versus PeteCode3"
For i = 1 To j ' checking for differences between array values
If a$(i) <> p$(i) Then Print a$(i), p$(i)
If a$(i) <> s$(i) Then Print a$(i), s$(i)
Next
Print "END OF DIFF CHECK"
Print: Print " Check tail end of arrays:"
For i = j - 15 To j
Print a$(i), p$(i), s$(i)
Next
' back to original form of anacode using counts of each letter 1 to 26
' this limits numbers of repeated letters to 9 max
' this code also assumes all letters but need not be assumed capitals
Function AnaCode$ (wrd$) ' anaCode$ converts word to an Anagram pattern
' are assuming wrd$ is all letters
Dim s$, w$
Dim As Integer i, p
s$ = String$(26, "0") ' number of A's in first, number of B's in 2nd, number of C's in third
w$ = UCase$(wrd$) ' don't assume all caps as expected
For i = 1 To Len(wrd$)
p = Asc(w$, i) - 64 ' A=1, B=2...
Mid$(s$, p, 1) = _Trim$(Str$(Asc(s$, p) - 47)) ' finally!! better
Next
AnaCode$ = s$
End Function
Function altAnaCode$ (wrd$) ' anaCode$ converts word to an Anagram pattern
Dim As Integer L(65 To 90), i, p
Dim t$(65 To 90), w$
w$ = UCase$(wrd$) ' don't assume all caps as expected
For i = 1 To Len(w$)
p = Asc(w$, i) ' A=1, B=2...
L(p) = L(p) + 1
Next
For i = 65 To 90
t$(i) = LTrim$(Str$(L(i)))
Next
altAnaCode$ = bind$(t$())
End Function
' return sorted anagram code string for any word, call ucase$(wrd$) for all caps
Function AnaCode2$ (wrd$) ' anaCode$ converts word to an Anagram pattern
' wrd$ is assumed to be in all capitals!!!
' number of A's in first, number of B's in 2nd, number of C's in third
Dim As Integer L(65 To 90), i, p
Dim rtn$, w$
w$ = UCase$(wrd$) ' don't assume all caps as expected
For i = 1 To Len(w$)
p = Asc(w$, i) ' A=1, B=2...
L(p) = L(p) + 1
Next
For i = 65 To 90
If L(i) Then rtn$ = rtn$ + String$(L(i), i)
Next
AnaCode2$ = rtn$
End Function
Function AnaCode3$ (wrd$) ' anaCode$ converts word to an Anagram pattern
' wrd$ is assumed to be in all capitals!!!
' number of A's in first, number of B's in 2nd, number of C's in third
Dim As Integer L(65 To 90), i, p
Dim w$
w$ = UCase$(wrd$) ' don't assume all caps as expected
For i = 1 To Len(w$)
p = Asc(w$, i) ' A=1, B=2...
L(p) = L(p) + 1
Next
Dim t$(65 To 90)
For i = 65 To 90
If L(i) Then t$(i) = String$(L(i), i)
Next
AnaCode3$ = bind$(t$())
End Function
Function SteveCode$ (awrd$)
Static t As String * 30
Dim As Long i, seed, j, l
Dim wrd$
wrd$ = UCase$(awrd$) ' to make fair i (bplus) added this to everyone's version
l = Len(wrd$)
For i = 65 To 90
seed = InStr(seed, wrd$, Chr$(i))
While seed
j = j + 1
Asc(t, j) = i ' <<<<<<<<<<<<<<<<<<<<<<< here is time saver +1
seed = InStr(seed + 1, wrd$, Chr$(i))
Wend
If seed >= l Then Exit For
Next
SteveCode$ = Left$(t, l)
End Function
Function petecode2$ (la$)
Dim rtn$, i%, seed%, j%, a$
a$ = UCase$(la$)
rtn$ = Space$(Len(a$))
For i% = 65 To 90
seed% = InStr(a$, Chr$(i%))
While seed%
j% = j% + 1
Mid$(rtn$, j%) = Chr$(i%)
seed% = InStr(seed% + 1, a$, Chr$(i%))
Wend
Next
petecode2$ = _Trim$(rtn$)
End Function
Function petecode3$ (la$)
Dim i%, seed%, j%, a$
Dim t$(1 To Len(la$))
a$ = UCase$(la$)
For i% = 65 To 90
seed% = InStr(a$, Chr$(i%))
While seed%
j% = j% + 1
t$(j%) = Chr$(i%)
seed% = InStr(seed% + 1, a$, Chr$(i%))
Wend
Next
petecode3$ = bind$(t$())
End Function
Function bind$ (arr$())
Dim As Long lb, ub, i, size, p
Dim rtn$
lb = LBound(arr$)
ub = UBound(arr$)
For i = lb To ub
size = size + Len(arr$(i))
Next
rtn$ = Space$(size)
p = 1
For i = lb To ub
Mid$(rtn$, p) = arr$(i)
p = p + Len(arr$(i))
Next
bind$ = rtn$
End Functioni changed the limit = number of times the file is accessed for each test for the following snapshots of results
limit = 1
limit = 5
limit = 10
limit = 25
b = b + ...