Thread Rating:
  • 1 Vote(s) - 5 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Alphabetical sort of characters within a string.
#42
looks like peteCode2$() is fastest sorter of letters in a word. anacode2$ was worse using mid$ = trick to save time, did improve orig 26 digit version of anaCode$ to be used in apps that look for words in the letters of bigger word.

Code: (Select All)
Option _Explicit
_Title "anaCode2$ versus peteCode2$ with dictionary 2" ' b+ 2024-04-25 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

' anacode2$ is to compare apples to apples in the function return format

' looks like peteCode2$ has the fastest letter sorter for words

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

'''' check i made modifications correctly
'Dim test$(9)
'Dim As Integer i
'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), AnaCode2$(test$(i)), petecode2$(test$(i))
'Next
'End
''''  ok looks right

Dim i As Integer, j As Integer
Dim start#, w$, ana2Time#, peteTime#, anatime#

start# = Timer(.01)
For i = 1 To 5
    j = 0
    Open "WORDS.txt" For Input As #1
    While Not EOF(1)
        Input #1, w$
        j = j + 1
        p$(j) = petecode2$(w$)
    Wend
    Close
Next
peteTime# = Timer(.01) - start#

start# = Timer(.01)
For i = 1 To 5
    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 5
    j = 0
    Open "WORDS.txt" For Input As #1
    While Not EOF(1)
        Input #1, w$
        j = j + 1
        a$(j) = AnaCode2$(w$)
    Wend
    Close
Next
ana2Time# = Timer(.01) - start#


Print "Anacode2 Time ="; ana2Time#, "PeteCode2 Time ="; peteTime#
Print "Original anaCode$ time ="; anatime#

Print "DIFF CHECK anaCcode2 versus PeteCode2"
For i = 1 To j ' 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

' back to original form of anacode using counts of each letter 1 to 26
' this limits numbers of repeated letters to 9 max
' this code also assumes all letters but need not be assumed capitals
Function AnaCode$ (wrd$) ' anaCode$ converts word to an Anagram pattern
    ' are assuming wrd$ is all letters
    Dim s$, w$
    Dim As Integer i, p
    s$ = String$(26, "0") ' number of A's in first, number of B's in 2nd, number of C's in third
    w$ = UCase$(wrd$) ' don't assume all caps  as expected
    For i = 1 To Len(wrd$)
        p = Asc(w$, i) - 64 ' A=1, B=2...
        Mid$(s$, p, 1) = _Trim$(Str$(Asc(s$, p) - 47)) ' finally!! better
    Next
    AnaCode$ = s$
End Function

' return sorted anagram code string for any word, call ucase$(wrd$) for all caps
Function AnaCode2$ (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$, w$
    w$ = UCase$(wrd$) ' don't assume all caps  as expected
    For i = 1 To Len(w$)
        p = Asc(w$, 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)
    Next
    AnaCode2$ = rtn$
End Function

Function petecode2$ (la$)
    Dim rtn$, i%, seed%, j%, a$
    a$ = UCase$(la$)
    rtn$ = Space$(Len(a$))
    For i% = 65 To 90
        seed% = InStr(a$, Chr$(i%))
        While seed%
            j% = j% + 1
            Mid$(rtn$, j%) = Chr$(i%)
            seed% = InStr(seed% + 1, a$, Chr$(i%))
        Wend
    Next
    petecode2$ = _Trim$(rtn$)
End Function

   
b = b + ...
Reply


Messages In This Thread
RE: Alphabetical sort of characters within a string. - by bplus - 04-26-2024, 11:12 PM



Users browsing this thread: 4 Guest(s)