Alphabetical sort of characters within a string.

[bplus]

here are the 2 test routines written as functions check my optimizing

Code: (Select All)

_Title "anaCode$ versus peteCode$" ' b+ 2022-11-17 mod 2024-04-24 decodeAnacode sub
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), AnaCode$(UCase$(test$(i))), peteCode$(UCase$(test$(i)))
Next

' return sorted anagram 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