Posts: 19
Threads: 8
Joined: Aug 2022
Reputation:
1
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?
Posts: 3,961
Threads: 175
Joined: Apr 2022
Reputation:
219
(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
b = b + ...
Posts: 55
Threads: 4
Joined: Apr 2022
Reputation:
5
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$
Why not yes ?
Posts: 55
Threads: 4
Joined: Apr 2022
Reputation:
5
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$
Why not yes ?
Posts: 382
Threads: 56
Joined: Apr 2022
Reputation:
13
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
Posts: 210
Threads: 13
Joined: Apr 2022
Reputation:
52
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
Posts: 3,961
Threads: 175
Joined: Apr 2022
Reputation:
219
04-24-2024, 06:45 PM
(This post was last modified: 04-24-2024, 06:48 PM by bplus.)
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.
b = b + ...
Posts: 2,701
Threads: 327
Joined: Apr 2022
Reputation:
217
04-24-2024, 07:52 PM
(This post was last modified: 04-24-2024, 07:55 PM by SMcNeill.)
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! 
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. 
Posts: 3,961
Threads: 175
Joined: Apr 2022
Reputation:
219
04-24-2024, 11:24 PM
(This post was last modified: 04-24-2024, 11:26 PM by bplus.)
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.
b = b + ...
Posts: 2,169
Threads: 222
Joined: Apr 2022
Reputation:
103
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
Shoot first and shoot people who ask questions, later.
|
Alphabetical sort of characters within a string.
