Quick Sort for variable length strings

[bplus]

Here is Quick Sort versus Comb Demo with 1000000 randomly chosen "words" <<< this means they aren't actually all words you can find in a dictionary, they are made randomly from this:
b$ = b$ + Mid$("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789.?", (Rnd * 64) \ 1 + 1, 1))

Code: (Select All)

Option _Explicit
_Title "Comb Sort vrs Quick Sort" ' b+ 2023-05-30
Randomize Timer ' so we have a different array each time we compare

DefLng A-Z
Const nItems = 1000000
Dim sa$(1 To nItems) ' setup a string array sa$() to sort
Dim copy$(1 To nItems) ' make a copy of sa$() to compare another sort to
Dim As Long i, j ' indexes to array  for building and displaying the arrays
Dim As Long r '  a random posw integer = 2 to 6
Dim t##, qtime##, ctime##
Dim b$ ' building string
For i = 1 To nItems ' make a random list to sort
    b$ = ""
    r = (Rnd * 5) \ 1 + 2
    For j = 0 To r
        b$ = b$ + Mid$("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789.?", (Rnd * 64) \ 1 + 1, 1)
    Next
    sa$(i) = b$
    copy$(i) = b$
    Print b$,
Next
Print
Print "Press any to Quick Sort"
Sleep
Cls
t## = Timer(.001)
QuickSort 1, nItems, sa$()
qtime## = Timer(.001) - t##
For i = 1 To 10
    Print sa$(i),
Next
Print: Print
For i = nItems - 9 To nItems
    Print sa$(i),
Next
Print: Print
Print "   Quick Sort time:"; qtime##
Print
Print "   Press any to Comb Sort with array copy, zzz..."
Print
Print
Sleep
t## = Timer(.001)
CombSort copy$()
ctime## = Timer(.001) - t##
For i = 1 To 10
    Print copy$(i),
Next
Print: Print
For i = nItems - 9 To nItems
    Print copy$(i),
Next
Print: Print
Print "   Comb Sort time:"; ctime##
Print
If ctime## < qtime## Then Print "   Comb winds!" Else Print "   QSort wins again!"


Sub QuickSort (start As Long, finish As Long, arr$())
    Dim Hi As Long, Lo As Long, Middle$
    Hi = finish: Lo = start
    Middle$ = arr$((Lo + Hi) / 2) 'find middle of arr$
    Do
        Do While arr$(Lo) < Middle$: Lo = Lo + 1: Loop
        Do While arr$(Hi) > Middle$: Hi = Hi - 1: Loop
        If Lo <= Hi Then
            Swap arr$(Lo), arr$(Hi)
            Lo = Lo + 1: Hi = Hi - 1
        End If
    Loop Until Lo > Hi
    If Hi > start Then Call QuickSort(start, Hi, arr$())
    If Lo < finish Then Call QuickSort(Lo, finish, arr$())
End Sub

' trans from johnno ref: https://rcbasic.freeforums.net/thread/779/sort-algorithms
Sub CombSort (arr$())
    Dim As Long itemCount, start, fini, swaps, gap, i
    start = LBound(arr$)
    itemCount = UBound(arr$) - start + 1
    fini = start + itemCount - 1
    gap = itemCount
    While gap > 1 Or swaps <> 0
        gap = Int(gap / 1.25)
        If gap < 1 Then gap = 1
        swaps = 0
        For i = start To itemCount - gap
            If arr$(i) > arr$(i + gap) Then
                Swap arr$(i), arr$(i + gap)
                swaps = 1
            End If
        Next
    Wend
End Sub

To use Quick Sort include the Sub in your code, of course, then call
QuickSort Lbound(array$), UBound(array$), array$()

PS you can sort parts of the array as well, just use lowest place, to highest place but who does that?

Simple as that! @PhilOfPerth