Alphabetical sort of characters within a string.

[Steffan-68]

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.