QB64 Phoenix Edition
Alphabetical sort of characters within a string. - Printable Version

+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Help Me! (https://qb64phoenix.com/forum/forumdisplay.php?fid=10)
+---- Thread: Alphabetical sort of characters within a string. (/showthread.php?tid=2620)

Pages: 1 2 3 4 5 6 7

Alphabetical sort of characters within a string. - Circlotron - 04-24-2024

I want to alphabetically sort the characters of a single word string. The only way i can think of so far is to get each character individually and make each one a single character variable, check the ASC value and bubble sort them with a SWAP function. Is there a better way?

RE: Alphabetical sort of characters within a string. - bplus - 04-24-2024

(04-24-2024, 12:25 PM)Circlotron Wrote: I want to alphabetically sort the characters of a single word string. The only way i can think of so far is to get each character individually and make each one a single character variable, check the ASC value and bubble sort them with a SWAP function. Is there a better way?

another more direct way is to use my anaCode$ function, it turns any word into a sorted listing of letters and their counts in a word that way you can find the anagrams of a word from a dictionary listing of all words

i added a decoder so you can see the alpha breakdown of letters in a word
Code: (Select All)
_Title "AnaCode$ function" ' b+ 2022-11-17 mod 2024-04-24 decodeAnacode sub
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$(test$(i)),
    decodeAnacode AnaCode$(test$(i))
Next

Function AnaCode$ (wrd$) ' anaCode$ converts word to an Anagram pattern
    ' number of A's in first, number of B's in 2nd, number of C's in third
    Dim L(26)
    w$ = UCase$(wrd$)
    For i = 1 To Len(wrd$)
        p = Asc(w$, i) - 64 ' A=1, B=2...
        L(p) = L(p) + 1
    Next
    For i = 1 To 26
        rtn$ = rtn$ + _Trim$(Str$(L(i)))
    Next
    AnaCode$ = rtn$
End Function

Sub decodeAnacode (Coded$)
    For i = 1 To 26
        n$ = Mid$(Coded$, i, 1)
        If n$ <> "0" Then Print Chr$(i + 64) + "-" + n$ + " ";
    Next
    Print
End Sub


RE: Alphabetical sort of characters within a string. - euklides - 04-24-2024

Something like this ??

Code: (Select All)
'sorting alphabetically letters from a word

Dim CHARLET$(100)
A$ = "uncopyrightable "

For x = 1 To Len(A$): CHARLET$(x) = Mid$(A$, x, 1): Next

flag: f = 0
For y = 1 To Len(A$) - 1
     If CHARLET$(y) > CHARLET$(y + 1) Then Swap CHARLET$(y), CHARLET$(y + 1): f = 1
Next y: If f > 0 Then GoTo flag

B$ = "": For y = 1 To Len(A$): B$ = B$ + CHARLET$(y): Next y

Print A$ + "    --------->  " + B$

Input k$


RE: Alphabetical sort of characters within a string. - euklides - 04-24-2024

Code: (Select All)
'an other way

A$ = "uncopyrightable "
B$ = A$

Flag: F = 0
For x = 1 To Len(B$) - 1
    L1$ = Mid$(B$, x, 1): L2$ = Mid$(B$, x + 1, 1)
    If L1$ > L2$ Then Mid$(B$, x, 1) = L2$: Mid$(B$, x + 1, 1) = L1$: F = 1
Next: If F > 0 Then GoTo Flag
Print A$ + "    --------->  " + B$

Input k$


RE: Alphabetical sort of characters within a string. - Dimster - 04-24-2024

If you didn't want to use a sort routine then I think you are correct, you would need each letter to be its own variable and force the combinations which you are looking for. A Select Case could help in the forced combinations. Here is an example of what I mean. Just an example of the concept because you will see this routine comes up with multiple duplications which needs to be addressed and corrected but you get the idea.

Code: (Select All)
Screen _NewImage(1000, 500, 32)

A$ = "A": B$ = "B": C$ = "C": D$ = "D"
Main$ = A$ + B$ + C$ + D$
Print Main$
For a = 1 To 4: Main$ = B$ + C$ + D$ + A$: Next
Print Main$
For b = 1 To 4: Main$ = C$ + D$ + A$ + B$: Next
Print Main$
For c = 1 To 4: Main$ = D$ + A$ + B$ + C$: Next
Print Main$
For d = 1 To 4: Main$ = A$ + B$ + C$ + D$: Next
Print Main$


For a = 1 To 4
    SC = a

    Select Case SC
        Case a
            Main$ = A$ + B$ + C$ + D$
            Print Main$; ":";
        Case b
            Main$ = A$ + B$ + D$ + C$
            Print Main$; ":";
        Case c
            Main$ = A$ + C$ + B$ + D$
            Print Main$; ":";
        Case d
            Main$ = A$ + C$ + D$ + B$
            Print Main$; ":";

    End Select




    For b = 1 To 4
        SC = b
        Select Case SC
            Case a
                Main$ = B$ + A$ + C$ + D$
                Print Main$; ":";
            Case b
                Main$ = B$ + A$ + D$ + C$
                Print Main$; ":";
            Case c
                Main$ = B$ + D$ + A$ + C$
                Print Main$; ":";
            Case d
                Main$ = B$ + D$ + C$ + A$
                Print Main$; ":";


        End Select



        For c = 1 To 4
            SC = c
            Select Case SC
                Case a
                    Main$ = C$ + A$ + B$ + D$
                    Print Main$; ":";
                Case b
                    Main$ = C$ + A$ + D$ + B$
                    Print Main$; ":";
                Case c
                    Main$ = C$ + D$ + A$ + B$
                    Print Main$; ":";
                Case c
                    Main$ = C$ + D$ + B$ + A$
                    Print Main$; ":";

            End Select



            For d = 1 To 4
                SC = d
                Select Case SC
                    Case a
                        Main$ = D$ + A$ + B$ + C$
                        Print Main$; ":";
                    Case b
                        Main$ = D$ + A$ + C$ + B$
                        Print Main$; ":";
                    Case c
                        Main$ = D$ + C$ + A$ + B$
                        Print Main$; ":";
                    Case d
                        Main$ = D$ + C$ + B$ + C$
                        Print Main$; ":";
                End Select
            Next
        Next
    Next
Next


RE: Alphabetical sort of characters within a string. - RhoSigma - 04-24-2024

Code: (Select All)
inpu$ = "fhgizbtoekivrrthzuowitorehvtg"



PRINT inpu$

PRINT SortLetters$(inpu$)

END



'=====================================================================

FUNCTION SortLetters$ (src$)

'--- preparations ---

sLen& = LEN(src$)

outp$ = SPACE$(sLen&)

REDIM arr%(1 TO sLen&)

'--- letters (ASCII) to array ---

FOR i& = 1 TO sLen&

    arr%(i&) = ASC(src$, i&)

NEXT i&

'--- quicksort array ---

IntQuickSort arr%(), 1, sLen&

'--- sorted array back to string ---

FOR i& = 1 TO sLen&

    ASC(outp$, i&) = arr%(i&)

NEXT i&

'--- cleanup & set result ---

ERASE arr%

SortLetters$ = outp$

END FUNCTION



'=====================================================================

SUB IntQuickSort (IntArray%(), lb&, ub&)

lIdx& = lb&: rIdx& = ub&

IF (ub& - lb&) > 0 THEN

    piv& = (lb& + ub&) / 2

    WHILE (lIdx& <= piv&) AND (rIdx& >= piv&)

        WHILE (IntArray%(lIdx&) < IntArray%(piv&)) AND (lIdx& <= piv&)

            lIdx& = lIdx& + 1

        WEND

        WHILE (IntArray%(rIdx&) > IntArray%(piv&)) AND (rIdx& >= piv&)

            rIdx& = rIdx& - 1

        WEND

        SWAP IntArray%(lIdx&), IntArray%(rIdx&)

        lIdx& = lIdx& + 1

        rIdx& = rIdx& - 1

        IF (lIdx& - 1) = piv& THEN

            rIdx& = rIdx& + 1

            piv& = rIdx&

        ELSEIF (rIdx& + 1) = piv& THEN

            lIdx& = lIdx& - 1

            piv& = lIdx&

        END IF

    WEND

    IntQuickSort IntArray%(), lb&, piv& - 1

    IntQuickSort IntArray%(), piv& + 1, ub&

END IF

END SUB


RE: Alphabetical sort of characters within a string. - bplus - 04-24-2024

i am saying no sorting is needed just count the letters of a word into a string the count for a's is first, b's is 2nd, c's 3rd... you get a coded string with the counts sorted a to z

i modified my anaCode$ to skip the string concatenation to speed up processing;
Code: (Select All)
_Title "AnaCode$ function" ' b+ 2022-11-17 mod 2024-04-24 decodeAnacode sub
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$(test$(i)),
    decodeAnacode AnaCode$(test$(i))
Next

Function AnaCode$ (wrd$) ' anaCode$ converts word to an Anagram pattern
    ' number of A's in first, number of B's in 2nd, number of C's in third
    s$ = String$(26, "0")
    w$ = UCase$(wrd$)
    For i = 1 To Len(wrd$)
        p = Asc(w$, i) - 64 ' A=1, B=2...
        Mid$(s$, p, 1) = _Trim$(Str$(Val(Mid$(s$, p, 1)) + 1))
    Next
    AnaCode$ = s$
End Function

Sub decodeAnacode (Coded$)
    For i = 1 To 26
        n$ = Mid$(Coded$, i, 1)
        If n$ <> "0" Then Print Chr$(i + 64) + "-" + n$ + " ";
    Next
    Print
End Sub

this code makes only one pass through the word, no sort routine on letters could be faster!

btw i call my code 'ana' because all anagrams of a word code to the same sequence and counts of letters.

RE: Alphabetical sort of characters within a string. - SMcNeill - 04-24-2024

Code: (Select All)
Print OrderIt("apple")

Print OrderIt("cheeseburger")



Function OrderIt$ (word$)

    Dim temp(255) As _Byte

    For i = 1 To Len(word$)

        a = Asc(word$, i)

        temp(a) = temp(a) + 1

    Next

    For j = 0 To 255

        o$ = o$ + String$(temp(j), j)

    Next

    OrderIt$ = o$

End Function

And that's all there is to it!  Wink


Edit: @bplus I bet this is faster than yours, as all it does is create a simple array and then directly stores the values in that array. No string counting, positioning, or manipulation needed here! Jst count, then build. Smile

RE: Alphabetical sort of characters within a string. - bplus - 04-24-2024

OK i was almost there with my first anacode$ post just replace one line
Code: (Select All)
_Title "AnaCode$ function" ' b+ 2022-11-17 mod 2024-04-24
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$(test$(i))
Next

Function AnaCode$ (wrd$) ' anaCode$ converts word to an Anagram pattern
    ' number of A's in first, number of B's in 2nd, number of C's in third
    Dim L(26)
    w$ = UCase$(wrd$)
    For i = 1 To Len(wrd$)
        p = Asc(w$, i) - 64 ' A=1, B=2...
        L(p) = L(p) + 1
    Next
    For i = 1 To 26
        'rtn$ = rtn$ + _Trim$(Str$(L(i)))  ' replace with next line
        rtn$ = rtn$ + String$(L(i), Chr$(i + 64))
    Next
    AnaCode$ = rtn$
End Function

we have practically the same thing.

RE: Alphabetical sort of characters within a string. - Pete - 04-25-2024

A simply way to get the letters in a word or phrase sorted in alphabetical order...

Code: (Select All)
a$ = "uncopyrightable"

For i = 1 To 26

    If InStr(LCase$(a$), Chr$(96 + i)) Then Print Chr$(96 + i);

Next


If you'd like to see how many times a letter occurred, it's just a little more code...

Code: (Select All)
a$ = "lots of letters repeated"

For i% = 1 To 26

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

    If seed% Then

        Do

            If InStr(seed%, LCase$(a$), Chr$(96 + i%)) Then

                Print Chr$(96 + i%);

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

            Else

                Exit Do

            End If

        Loop

    End If

Next

Pete