Alphabetical sort of characters within a string.

[bplus]

One thing for certain: don't do the string work on blank strings.

For i = 65 To 90
IF L(i) > 0 THEN
rtn$ = rtn$ + String$(L(i), Chr$(i)) ' thanks steve for string$ idea
END IF
Next

And drop the CHR$:
rtn$ = rtn$ + String$(L(i), i)

+1 ok @SMcNeill that made a significant difference! did not know string$ could do either chr$ or asc

Code: (Select All)

_Title "anaCode$ versus peteCode$ with dictionary" ' b+ 2024-04-25 speed test

' anaCode$ much improved now

Dim a$(25000), p$(25000)

' check i made steve 2nd optimization correctly
'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
' ok looks right


Dim i As Integer, j As Integer

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) = AnaCode$(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
        p$(j) = peteCode$(w$)
    Wend
    Close
Next
petetime = Timer(.01) - start

Print "AnaTime ="; anatime, "PeteTime ="; petetime

For i = 1 To 25000 ' 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

' 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(65 To 90), i, p
    Dim rtn$
    For i = 1 To Len(wrd$)
        p = Asc(wrd$, 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) ' thanks steve for whole line here!!!
    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% = 65 To 90
        seed% = InStr(a$, Chr$(i%))
        While seed%
            rtn$ = rtn$ + Chr$(i%)
            seed% = InStr(seed% + 1, a$, Chr$(i%))
        Wend
    Next
    peteCode$ = rtn$
End Function