QB64 Phoenix Edition
Test sorting algorithms - Printable Version

+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Utilities (https://staging.qb64phoenix.com/forumdisplay.php?fid=8)
+---- Thread: Test sorting algorithms (/showthread.php?tid=1659)

Test sorting algorithms - eoredson - 05-04-2023

I know how much time and effort there has been in discussing sorting algorithms,
but I wanted to post this program that tests 6 different sorting subroutines and their timings.

Erik.

RE: Test sorting algorithms - bplus - 05-04-2023

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


RE: Test sorting algorithms - bplus - 05-04-2023

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


RE: Test sorting algorithms - eoredson - 05-04-2023

Quote: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


I found the heap sort to be the fastest. It can sort 10,000,000 elements in just under 10 seconds.

Sorry for boring rehashed sort post.

Erik.