Function: Return a sorted string

[DroopyPawn]

I need a function that will return a string with the characters sorted.
For example, if I send the function "exam" it should return "aemx".
Does this already exist in VB6?

[Ellis Dee]

No, it doesn't.

Does case matter?

[DroopyPawn]

This is what I did and it works but I feel like I'm missing something simple.

Public Function SortWord(w$)
'This function receives a word and returns the word with the letters sorted
    Dim inner As Integer, outer As Integer, ln As Integer, tmp$, c$(1 To 20), i As Integer
    ln = Len(w$)
    For i = 1 To ln
        c$(i) = Mid$(w$, i, 1)
    Next i
    
    For outer = 1 To ln
        For inner = 1 To ln
            If c$(outer) < c$(inner) Then
                tmp$ = c$(outer)
                c$(outer) = c$(inner)
                c$(inner) = tmp$
            End If
        Next inner
    Next outer
    
    tmp$ = ""
    For i = 1 To Len(w$)
        tmp$ = tmp$ + c$(i)
    Next i
    
    SortWord = tmp$
End Function

[Ellis Dee]

If you expect the strings to be small, like say less than 100 characters, insertion sort is probably fine.

Public Function SortString(pstrString As String) As String
    Dim strArray() As String
    Dim i As Long
    
    ReDim strArray(Len(pstrString) - 1)
    For i = 1 To Len(pstrString)
        strArray(i - 1) = Mid$(pstrString, i, 1)
    Next
    InsertionSort1 strArray
    SortString = Join(strArray, "")
End Function

Public Sub InsertionSort1(ByRef pvarArray As Variant)
    Dim i As Long
    Dim j As Long
    Dim iMin As Long
    Dim iMax As Long
    Dim varSwap As Variant
    
    iMin = LBound(pvarArray) + 1
    iMax = UBound(pvarArray)
    For i = iMin To iMax
        varSwap = pvarArray(i)
        For j = i To iMin Step -1
            If varSwap < pvarArray(j - 1) Then pvarArray(j) = pvarArray(j - 1) Else Exit For
        Next j
        pvarArray(j) = varSwap
    Next i
End Sub

If the strings could be very long, it would be much more efficient to use counting sort.

[Ellis Dee]

Here's a quick pass at counting sort. It works, but it's case sensitive, and it can't be made to ignore case by simply putting it in a module with Option Compare Text. (The above solution with insertion sort can.)

Public Function SortString(pstrString As String) As String
    Dim lngCount(255) As Long
    Dim bytArray() As Byte
    Dim i As Long
    Dim j As Long
    Dim k As Long
    
    bytArray = StrConv(pstrString, vbFromUnicode)
    For i = 0 To UBound(bytArray)
        lngCount(bytArray(i)) = lngCount(bytArray(i)) + 1
    Next
    i = 0
    For j = 0 To 255
        For k = 1 To lngCount(j)
            bytArray(i) = j
            i = i + 1
        Next
    Next
    SortString = StrConv(bytArray, vbUnicode)
End Function

As you might notice, there isn't a single comparison in this code. That's because counting sort isn't a comparison algorithm, meaning it isn't constrained by the limits for them. Given a sufficiently large string, this will blow the fastest comparison sorts like quicksort out of the water.

[DroopyPawn]

My code will not need to sort more than 10 or 11 characters most likely. So which one would be best? Or does it even matter on something that small?

[Ellis Dee]

For 10 or 11 elements, it doesn't really matter. Conventional wisdom is that insertion sort is best for small lists, so may as well go with that. Unless you're sending thousands of strings to be sorted in a loop, the difference between the best and worst algorithm won't be measurable.

That counting sort I posted isn't so hot because it uses ASCII order, which to a large extent is random. Here's a better one, though the added overhead probably makes it none too fast for such short strings. For a billion or so characters, this may be as fast as it gets:

Public Function SortString(ByVal pstrString As String) As String
    Const CharMap = """ !#$&#37;&()*,./:;?@[\]^ˆ_`{|}~&#161;&#166;&#168;&#175;&#180;&#184;&#191;˜‘’‚“”„‹›+<=>&#177;&#171;&#187;&#215;&#247;&#162;&#163;&#164;&#165;&#167;&#169;&#172;&#174;&#176;&#181;&#182;&#183;†‡•…‰€0&#188;&#189;&#190;1&#185;2&#178;3&#179;456789Aa&#170;&#193;&#225;&#192;&#224;&#194;&#226;&#196;&#228;&#195;&#227;&#197;&#229;&#198;&#230;BbCc&#199;&#231;Dd&#208;&#240;Ee&#201;&#233;&#200;&#232;&#202;&#234;&#203;&#235;FfƒGgHhIi&#205;&#237;&#204;&#236;&#206;&#238;&#207;&#239;JjKkLlMmNn&#209;&#241;Oo&#186;&#211;&#243;&#210;&#242;&#212;&#244;&#214;&#246;&#213;&#245;&#216;&#248;ŒœPpQqRrSsŠš&#223;Tt&#222;&#254;™Uu&#218;&#250;&#217;&#249;&#219;&#251;&#220;&#252;VvWwXxYy&#221;&#253;Ÿ&#255;ZzŽž"
    Dim lngCount() As Long
    Dim lngIndex As Long
    Dim i As Long
    Dim j As Long
    Dim k As Long
    
    ReDim lngCount(Len(CharMap))
    For i = 1 To Len(pstrString)
        lngIndex = InStr(CharMap, Mid$(pstrString, i, 1))
        lngCount(lngIndex) = lngCount(lngIndex) + 1
    Next
    i = 0
    For j = 1 To Len(CharMap)
        For k = 1 To lngCount(j)
            i = i + 1
            Mid$(pstrString, i, 1) = Mid$(CharMap, j, 1)
        Next
    Next
    SortString = pstrString
End Function

It's still not ideal because it doesn't handle 40 or so unprintable characters. The most complete solution would be to create CharMap dynamically with all 255 chars, sort it with InsertionSort, and then run counting sort with that.

Obviously that's a huge amount of overhead, which is why I didn't bother posting it.

[DroopyPawn]

Thanks for the effort. I guess I'll just stick with what I wrote. I know it works fine.

[Ellis Dee]

I'd go with the insertion sort solution, but if you want to stick with what you have, the following changes will make it much, much faster:

    For outer = 1 To ln
        For inner = ln To outer Step -1
            If c$(outer) > c$(inner) Then
                tmp$ = c$(outer)
                c$(outer) = c$(inner)
                c$(inner) = tmp$
            End If
        Next inner
    Next outer