Alphabetical sort of characters within a string.

[bplus]

@bplus @bplus @bplus @bplus

THIS IS HOW IT SHOULD BE DONE!!!

Code: (Select All)

Type AnaType

    word As String

    sorted As String

End Type



dict$ = _ReadFile$("WORDS.txt")

Dim words(25000) As AnaType, tempsort(22) As String

For i = 1 To 22: tempsort(i) = Space$(i): Next



startPos = 1: endPos = 1: count = 1: l = Len(dict$)

t# = Timer(0.001)

While startPos <= l

    count = count + 1

    p = InStr(startPos, dict$, Chr$(13))

    word$ = Mid$(dict$, startPos, p - startPos)



    startPos = p + 2

    ReDim temp(65 To 90)

    l1 = Len(word$)

    For i = 1 To l1

        a = Asc(word$, i)

        temp(a) = temp(a) + 1

    Next

    p = 1

    For i = 65 To 90

        For j = 1 To temp(i)

            Asc(tempsort(l1), p) = i

            p = p + 1

        Next

    Next

    words(count).word = word$

    words(count).sorted = tempsort(l1)

Wend

t1# = Timer(0.001)



Print Using "###.### seconds to generate and sort dictionary and anagram listings"; t1# - t#



For i = 1 To 20

    Print words(i).word, words(i).sorted

Next

uh @SMcNeill your steveCode2$ would be way faster than this, might be something had you sorted the coded words.

Code: (Select All)

Type AnaType
    word As String
    sorted As String
End Type

dict$ = _ReadFile$("WORDS.txt")
Dim words(25000) As AnaType

startPos = 1: count = 1: l = Len(dict$)
t# = Timer(0.001)
While startPos <= l
    count = count + 1
    p = InStr(startPos, dict$, Chr$(13))
    words(count).word = Mid$(dict$, startPos, p - startPos)
    words(count).sorted = SteveCode2$(words(count).word)
    startPos = p + 2
Wend
t1# = Timer(0.001)

Print Using "###.### seconds to generate anagram listings"; t1# - t#
Print "Use u key to go up..."
For i = 1 To count ' orig to 20
    Print words(i).word; Tab(30); words(i).sorted
    If i Mod 20 = 0 Then
        Print "zzz..."
        k$ = InKey$
        While Len(k$) = 0: k$ = InKey$: _Limit 30: Wend
        If k$ = "u" And (i >= 21) Then i = i - 40
        Cls
        Print "Use u key to go up...": Print
    End If
Next

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

   

as is, check this out for time comparison with my latest altAnaCode:

Code: (Select All)

Type AnaType
    word As String
    sorted As String
End Type

dict$ = _ReadFile$("WORDS.txt")
Dim words(25000) As AnaType

startPos = 1: count = 1: l = Len(dict$)
t# = Timer(0.001)
While startPos <= l
    count = count + 1
    p = InStr(startPos, dict$, Chr$(13))
    words(count).word = Mid$(dict$, startPos, p - startPos)
    words(count).sorted = altAnaCode2$(words(count).word)
    startPos = p + 2
Wend
t1# = Timer(0.001)

Print Using "###.### seconds to generate anagram listings"; t1# - t#
Print "Use u key to go up..."
For i = 1 To count ' orig to 20
    Print words(i).word; Tab(30); words(i).sorted
    If i Mod 20 = 0 Then
        Print "zzz..."
        k$ = InKey$
        While Len(k$) = 0: k$ = InKey$: _Limit 30: Wend
        If k$ = "u" And (i >= 21) Then i = i - 40
        Cls
        Print "Use u key to go up...": Print
    End If
Next

Function altAnaCode2$ (wrd$) ' anaCode$ converts word to an Anagram pattern
    ' are assuming wrd$ is all letters
    Dim s$
    Dim As Integer i, p
    s$ = String$(26, "0") ' string holds final counts
    'w$ = UCase$(wrd$) ' don't assume all caps  as expected
    For i = 1 To Len(wrd$)
        p = Asc(wrd$, i) - 64
        Asc(s$, p) = Asc(s$, p) + 1
    Next
    altAnaCode2$ = s$
End Function

   

i win until steve pulls out his mem tricks LOL