Thread Rating:
  • 1 Vote(s) - 5 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Alphabetical sort of characters within a string.
#51
well i thought the newest petecode3$ was faster than anacode3$ but it's too close, depends on temperment of my system, kinda odd, even with 25 passes through the WORD.txt each test there is no consistent winner
   
   
   

here is everything in zip including the original unixdict.txt and the bas cleanup to WORDS.txt that my testing is using with the latest code test
Code: (Select All)
Option _Explicit
_Title "anaCode3$ versus peteCode3$ with WORDS.txt" ' b+ 2024-04-26 speed test

' 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!

Dim a$(25000), p$(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$, ana2Time#, peteTime#, anatime#, pete3time#

start# = Timer(.01)
For i = 1 To 25
    j = 0
    Open "WORDS.txt" For Input As #1
    While Not EOF(1)
        Input #1, w$
        j = j + 1
        p$(j) = petecode2$(w$)
    Wend
    Close
Next
peteTime# = Timer(.01) - start#

start# = Timer(.01)
For i = 1 To 25
    j = 0
    Open "WORDS.txt" For Input As #1
    While Not EOF(1)
        Input #1, w$
        j = j + 1
        p$(j) = petecode3$(w$)
    Wend
    Close
Next
pete3time# = Timer(.01) - start#

start# = Timer(.01)
For i = 1 To 25
    j = 0
    Open "WORDS.txt" For Input As #1
    While Not EOF(1)
        Input #1, w$
        j = j + 1
        a$(j) = altAnaCode$(w$)
    Wend
    Close
Next
anatime# = Timer(.01) - start#

start# = Timer(.01)
For i = 1 To 25
    j = 0
    Open "WORDS.txt" For Input As #1
    While Not EOF(1)
        Input #1, w$
        j = j + 1
        a$(j) = AnaCode3$(w$)
    Wend
    Close
Next
ana2Time# = Timer(.01) - start#


Print "Anacode3 Time ="; ana2Time#, "PeteCode3 Time ="; pete3time#
Print "altAnaCode$ time ="; anatime#, "PeteCode2 Time ="; peteTime#

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)
Next
Print "END OF DIFF CHECK"

Print: Print " Check tail end of arrays:"
For i = j - 15 To j
    Print a$(i), p$(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 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 Function


Attached Files
.zip   ana3 versus pete3.zip (Size: 155.04 KB / Downloads: 11)
b = b + ...
Reply
#52
(04-27-2024, 04:18 PM)bplus Wrote: well i thought the newest petecode3$ was faster than anacode3$ but it's too close, depends on temperment of my system, kinda odd, even with 25 passes through the WORD.txt each test there is no consistent winner




here is everything in zip including the original unixdict.txt and the bas cleanup to WORDS.txt that my testing is using with the latest code test
Code: (Select All)
Option _Explicit
_Title "anaCode3$ versus peteCode3$ with WORDS.txt" ' b+ 2024-04-26 speed test

' 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!

Dim a$(25000), p$(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$, ana2Time#, peteTime#, anatime#, pete3time#

start# = Timer(.01)
For i = 1 To 25
    j = 0
    Open "WORDS.txt" For Input As #1
    While Not EOF(1)
        Input #1, w$
        j = j + 1
        p$(j) = petecode2$(w$)
    Wend
    Close
Next
peteTime# = Timer(.01) - start#

start# = Timer(.01)
For i = 1 To 25
    j = 0
    Open "WORDS.txt" For Input As #1
    While Not EOF(1)
        Input #1, w$
        j = j + 1
        p$(j) = petecode3$(w$)
    Wend
    Close
Next
pete3time# = Timer(.01) - start#

start# = Timer(.01)
For i = 1 To 25
    j = 0
    Open "WORDS.txt" For Input As #1
    While Not EOF(1)
        Input #1, w$
        j = j + 1
        a$(j) = altAnaCode$(w$)
    Wend
    Close
Next
anatime# = Timer(.01) - start#

start# = Timer(.01)
For i = 1 To 25
    j = 0
    Open "WORDS.txt" For Input As #1
    While Not EOF(1)
        Input #1, w$
        j = j + 1
        a$(j) = AnaCode3$(w$)
    Wend
    Close
Next
ana2Time# = Timer(.01) - start#


Print "Anacode3 Time ="; ana2Time#, "PeteCode3 Time ="; pete3time#
Print "altAnaCode$ time ="; anatime#, "PeteCode2 Time ="; peteTime#

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)
Next
Print "END OF DIFF CHECK"

Print: Print " Check tail end of arrays:"
For i = j - 15 To j
    Print a$(i), p$(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 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 Function
So for me they are identical except for the decimal places.


   
   
   
Reply
#53
And now that @bplus has taken time to take a breath, I present to you guys the STEVECODE(tm)!!!

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!

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$, ana2Time#, peteTime#, anatime#, pete3time#, steveTime#

start# = Timer(.001)
For i = 1 To 25
    j = 0
    Open "WORDS.txt" For Input As #1
    While Not EOF(1)
        Input #1, w$
        j = j + 1
        p$(j) = petecode2$(w$)
    Wend
    Close
Next
peteTime# = Timer(.001) - start#

start# = Timer(.001)
For i = 1 To 25
    j = 0
    Open "WORDS.txt" For Input As #1
    While Not EOF(1)
        Input #1, w$
        j = j + 1
        p$(j) = petecode3$(w$)
    Wend
    Close
Next
pete3time# = Timer(.001) - start#

start# = Timer(.001)
For i = 1 To 25
    j = 0
    Open "WORDS.txt" For Input As #1
    While Not EOF(1)
        Input #1, w$
        j = j + 1
        a$(j) = altAnaCode$(w$)
    Wend
    Close
Next
anatime# = Timer(.001) - start#

start# = Timer(.001)
For i = 1 To 25
    j = 0
    Open "WORDS.txt" For Input As #1
    While Not EOF(1)
        Input #1, w$
        j = j + 1
        a$(j) = AnaCode3$(w$)
    Wend
    Close
Next
ana2Time# = Timer(.001) - start#

start# = Timer(.001)
For i = 1 To 25
    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 ="; ana2Time#, "PeteCode3 Time ="; pete3time#
Print "altAnaCode$ time ="; anatime#, "PeteCode2 Time ="; peteTime#
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



Function SteveCode$ (wrd$)
    Static t As String * 30
    Dim As Long i, seed, j, l
    l = Len(wrd$)
    For i = 65 To 90
        seed = InStr(seed, wrd$, Chr$(i))
        While seed
            j = j + 1
            Asc(t, j) = i
            seed = InStr(seed + 1, wrd$, Chr$(i))
        Wend
        If seed >= l Then Exit For
    Next
    SteveCode$ = Left$(t, l)
End Function



' 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 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 Function


Attached Files Image(s)
   
Reply
#54
+1 steve did it again

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 Function

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)
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 Function

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
   
b = b + ...
Reply
#55
Code: (Select All)
Option _Explicit
_Title "anaCode3$ versus peteCode3$ with WORDS.txt" ' b+ 2024-04-26 speed test

' 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!

Dim a$(25000), s$(25000)

Dim i As Integer, j As Integer
Dim start#, w$, anatime#, steveTime#

start# = Timer(.001)
For i = 1 To 25
    j = 0
    Open "WORDS.txt" For Binary As #1
    While Not EOF(1)
        Line Input #1, w$
        j = j + 1
        a$(j) = SteveCode2$(w$)
    Wend
    Close
Next
anatime# = Timer(.001) - start#


start# = Timer(.001)
For i = 1 To 25
    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 "SteveCode2$ time ="; anatime#
Print "steveCode$ Time ="; steveTime#

Print "DIFF CHECK"
For i = 1 To j ' checking for differences between array values
    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), s$(i)
Next



Function SteveCode$ (wrd$)
    Static t As String * 30
    Dim As Long i, seed, j, l
    l = Len(wrd$)
    For i = 65 To 90
        seed = InStr(seed, wrd$, Chr$(i))
        While seed
            j = j + 1
            Asc(t, j) = i
            seed = InStr(seed + 1, wrd$, Chr$(i))
        Wend
        If seed >= l Then Exit For
    Next
    SteveCode$ = Left$(t, l)
End Function


Function SteveCode2$ (wrd$)
    Dim As Integer L(65 To 90), i, p, j
    Dim rtn$
    For i = 1 To Len(wrd$)
        p = Asc(wrd$, i)
        L(p) = L(p) + 1
    Next
    rtn$ = wrd$
    p = 1
    For i = 65 To 90
        For j = 1 To L(i)
            Asc(rtn$, p) = i
            p = p + 1
        Next
    Next
    SteveCode2$ = rtn$
End Function


And, with a little more tweaking, we shave off another second for our times.  Big Grin

3.9 Seconds vs 4.9 (almost 5 seconds).
Reply
#56
back to using counting array ;-))
b = b + ...
Reply
#57
(04-27-2024, 11:21 PM)I think bplus Wrote: back to using counting array ;-))
I think about the only way to see much improvements at this point, would be to change the approach completely.  At the moment, you're reading one word, processing one word, and writing routines to only work with one word at a time.

A vast improvement would be to:
1) read the whole list and store it in an array once and be done with it.
2) UCASE$ that whole list, if desired, once and be done with it.
3) Process that whole array at once, rather than puttering over 1 word at a time.  I imagine we could save a lot of overhead allocating memory in the functions, then freeing it, over and over, if we just did it all at once.

Bonus speed if you read the list as FIXED LENGTH strings, using space (CHR$(32)) as the end of line characters, and then swap to making use of _MEM to process everything.
Reply
#58
array access instead of file access may tighten up the variances in times, that would be better test for timing i think.

goal is a generic subroutine to process the words letters into sorted list or string that could be used elsewhere, don't want to design the routine to one specific data set though a dictionary aint bad.

one use is for anagrams, another use for a list of words that can be made from a bigger word and another is like alchemy only one change or difference between one word and the next, word ladders i think it was called?

i've used anacode for a daily newspaper puzzle for unscrambling words and then forming the solution to a quote/joke about a cartoon picture that came with the puzzle.
the solution had to be made out of circled letters in the unscrambled words. really tricky if a scrambled word did have an anagram Smile
b = b + ...
Reply
#59
@bplus @bplus @bplus @bplus

THIS IS HOW IT SHOULD BE DONE!!!

Code: (Select All)
Type AnaType
    word As String
    sorted As String
End Type

dict$ = _ReadFile$("WORDS.txt")
Dim words(25000) As AnaType, tempsort(22) As String
For i = 1 To 22: tempsort(i) = Space$(i): Next

startPos = 1: endPos = 1: count = 1: l = Len(dict$)
t# = Timer(0.001)
While startPos <= l
    count = count + 1
    p = InStr(startPos, dict$, Chr$(13))
    word$ = Mid$(dict$, startPos, p - startPos)

    startPos = p + 2
    ReDim temp(65 To 90)
    l1 = Len(word$)
    For i = 1 To l1
        a = Asc(word$, i)
        temp(a) = temp(a) + 1
    Next
    p = 1
    For i = 65 To 90
        For j = 1 To temp(i)
            Asc(tempsort(l1), p) = i
            p = p + 1
        Next
    Next
    words(count).word = word$
    words(count).sorted = tempsort(l1)
Wend
t1# = Timer(0.001)

Print Using "###.### seconds to generate and sort dictionary and anagram listings"; t1# - t#

For i = 1 To 20
    Print words(i).word, words(i).sorted
Next


   
Reply
#60
just found a faster way to do altAnaCode that beats Stevecode2
limit = 10
   

ps you did it pretty well in Rosetta code .0001 secs something like that
https://rosettacode.org/wiki/Anagrams#QB64
just think what it might have been with quick sort LOL
b = b + ...
Reply




Users browsing this thread: 7 Guest(s)