Test sorting algorithms

[bplus]

Something very slow about your QuickSort Eric

This demo sorts a million items in about 1 sec, your takes so long I gotta think somethings way off.

Code: (Select All)

DefLng A-Z
Const nItems = 1000000
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
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