Test sorting algorithms

[bplus]

Here I try your routine @eoredson with my setup changing your array name to sa$ and your p to p$ it works for 100, 1000, 10,000 but really really bogs down starting at 100,000

Code: (Select All)

DefLng A-Z
Const nItems = 100000
ReDim Shared sa$(1 To nItems) 'setup with string array sa$() shared so dont have to pass as parameter
For x = 1 To nItems ' make a random list to sort
    b$ = ""
    r = (Rnd * 5) \ 1 + 2
    For i = 0 To r
        b$ = b$ + Mid$("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789.?", (Rnd * 64) \ 1 + 1, 1)
    Next
    sa$(x) = b$
    Print b$,
Next
Print
Print "Press any to sort"
Sleep
t## = Timer(.01)
'QSort 1, nItems
QuickSort 1, nItems
time## = Timer(.01) - t##
Cls
For i = 1 To nItems
    Print sa$(i),
Next
Print
Print "time:"; time##


' modified for QB64 from JB
' This is the best all purpose sort routine around, don't worry how it works, it just does!
' To use this sub rountine store all the string values you want to sort into sa$() array
' call Qsort with Start = 1 and Finish = number of Items in your array
Sub QSort (Start, Finish) 'sa$ needs to be   DIM SHARED !!!!     array
    Dim i As Long, j As Long, x$
    i = Start
    j = Finish
    x$ = sa$(Int((i + j) / 2))
    While i <= j
        While sa$(i) < x$
            i = i + 1
        Wend
        While sa$(j) > x$
            j = j - 1
        Wend
        If i <= j Then
            Swap sa$(i), sa$(j)
            i = i + 1
            j = j - 1
        End If
    Wend
    If j > Start Then QSort Start, j
    If i < Finish Then QSort i, Finish
End Sub

Sub QuickSort (L, H)
    Dim r As Long, p As Long
    Dim i As Long, j As Long
    If Qexit Then ' recursively exit QuickSort
        Exit Sub
    End If
    If L < H Then
        If H - L = 1 Then
            If sa$(L) > sa$(H) Then
                Swap sa$(L), sa$(H)
            End If
        Else
            r = Int(Rnd * (H - L + 1)) + L
            Swap sa$(H), sa$(r)
            p$ = sa$(H)
            Do
                If InKey$ = Chr$(27) Then Qexit = -1: Exit Sub
                i = L
                j = H
                Do While (i < j) And (sa$(i) <= p$)
                    i = i + 1
                Loop
                Do While (j > i) And (sa$(j) >= p$)
                    j = j - 1
                Loop
                If i < j Then
                    Swap sa$(i), sa$(j)
                End If
            Loop While i < j
            Swap sa$(i), sa$(H)
            If (i - L) < (H - i) Then
                Call QuickSort(L, i - 1)
                Call QuickSort(i + 1, H)
            Else
                Call QuickSort(i + 1, H)
                Call QuickSort(L, i - 1)
            End If
        End If
    End If
End Sub