Alphabetical sort of characters within a string.

[bplus]

rerun

Code: (Select All)

_Title "anaCode$ versus peteCode$ with dictionary" ' b+ 2024-04-25 speed test
Dim a$(25000), p$(25000)
Dim i As Integer
start = Timer(.01)
For i = 1 To 25
    Open "WORDS.txt" For Input As #1
    While Not EOF(1)
        Input #1, w$
        a$(i) = AnaCode$(w$)
    Wend
    Close
Next
anatime = Timer(.01) - start
start = Timer(.01)
For i = 1 To 25
    Open "WORDS.txt" For Input As #1
    While Not EOF(1)
        Input #1, w$
        p$(i) = peteCode$(w$)
    Wend
    Close
Next
petetime = Timer(.01) - start
Print anatime, petetime
For i = 1 To 25000
    If a$(i) <> p$(i) Then Print a$(i), p$(i)
Next
Print "END OF DIFF CHECK"



' return sorted ancagram code string for any word, call ucase$(wrd$) for all caps
Function AnaCode$ (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(26), i, p
    Dim rtn$
    For i = 1 To Len(wrd$)
        p = Asc(wrd$, i) - 64 ' A=1, B=2...
        L(p) = L(p) + 1
    Next
    For i = 1 To 26
        rtn$ = rtn$ + String$(L(i), Chr$(i + 64)) ' thanks steve for string$ idea
    Next
    AnaCode$ = rtn$
End Function

Function peteCode$ (a$) 'converts word to an Anagram pattern
    ' a$ is assumed to be all caps call ucase$(a$) if not
    Dim i%, seed%, rtn$
    For i% = 1 To 26
        seed% = InStr(a$, Chr$(64 + i%))
        While seed%
            rtn$ = rtn$ + Chr$(64 + i%)
            seed% = InStr(seed% + 1, a$, Chr$(64 + i%))
        Wend
    Next
    peteCode$ = rtn$
End Function

peteCode slightly ahead, I am going to reverse positions and teach myself to use other shift key!
   

BTW my word file is old unixdict.txt file with all words uning non letters like numbers of single quote removed and words CAPITALIZED.