Alphabetical sort of characters within a string.

[SMcNeill]

Ha!  After a little optimization and some good old fashioned "What the hell did ya do there???" coding, the results for speed have completely swapped!

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 2

    Open "Scrabble WordList 2006.txt" For Binary As #1

    While Not EOF(1)

        Line Input #1, w$

        a$(i) = AnaCode$(w$)

    Wend

    Close

Next

anatime = Timer(.01) - start

start = Timer(.01)

For i = 1 To 2

    Open "Scrabble WordList 2006.txt" For Binary As #1

    While Not EOF(1)

        Line 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(65 To 91), i, p

    Dim rtn$

    For i = 1 To Len(wrd$)

        p = Asc(wrd$, i)

        L(p) = L(p) + 1

    Next

    l = 1

    rtn$ = wrd$ 'to set proper length for rtn$

    For i = 65 To 91

        If L(i) Then 'only do the string junk if a letter exists

            Mid$(rtn$, l) = String$(L(i), i) ' thanks steve for string$ idea -- You're welcome... Here's another idea:  don't add strings as that's slow too.

            l = l + L(i)

        End If

    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 91

        seed% = InStr(a$, Chr$(i%))

        While seed%

            rtn$ = rtn$ + Chr$(i%)

            seed% = InStr(seed% + 1, a$, Chr$(i%))

        Wend

    Next

    peteCode$ = rtn$

End Function

I didn't have your word list, so I substituted one of my own, which I think most folks around here should have a copy of. 

---

And in other news::

---

and the results are in, Petecode$ just edges out Anacode$

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) = AnaCode$(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

Note that the code you've shared above runs the same subroutine for BOTH timers.  You never actually call peteCode anywhere...