Alphabetical sort of characters within a string.

[SMcNeill]

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), s$(25000)



Dim i As Integer, j As Integer

Dim start#, w$, anatime#, steveTime#



start# = Timer(.001)

For i = 1 To 25

    j = 0

    Open "WORDS.txt" For Binary As #1

    While Not EOF(1)

        Line Input #1, w$

        j = j + 1

        a$(j) = SteveCode2$(w$)

    Wend

    Close

Next

anatime# = Timer(.001) - start#





start# = Timer(.001)

For i = 1 To 25

    j = 0

    Open "WORDS.txt" For Binary As #1

    While Not EOF(1)

        Line Input #1, w$

        j = j + 1

        s$(j) = SteveCode$(w$)

    Wend

    Close

Next

steveTime# = Timer(.001) - start#



Print "SteveCode2$ time ="; anatime#

Print "steveCode$ Time ="; steveTime#



Print "DIFF CHECK"

For i = 1 To j ' checking for differences between array values

    If a$(i) <> s$(i) Then Print a$(i), s$(i)

Next

Print "END OF DIFF CHECK"



Print: Print " Check tail end of arrays:"

For i = j - 15 To j

    Print a$(i), s$(i)

Next







Function SteveCode$ (wrd$)

    Static t As String * 30

    Dim As Long i, seed, j, l

    l = Len(wrd$)

    For i = 65 To 90

        seed = InStr(seed, wrd$, Chr$(i))

        While seed

            j = j + 1

            Asc(t, j) = i

            seed = InStr(seed + 1, wrd$, Chr$(i))

        Wend

        If seed >= l Then Exit For

    Next

    SteveCode$ = Left$(t, l)

End Function





Function SteveCode2$ (wrd$)

    Dim As Integer L(65 To 90), i, p, j

    Dim rtn$

    For i = 1 To Len(wrd$)

        p = Asc(wrd$, i)

        L(p) = L(p) + 1

    Next

    rtn$ = wrd$

    p = 1

    For i = 65 To 90

        For j = 1 To L(i)

            Asc(rtn$, p) = i

            p = p + 1

        Next

    Next

    SteveCode2$ = rtn$

End Function

And, with a little more tweaking, we shave off another second for our times. 

3.9 Seconds vs 4.9 (almost 5 seconds).