05-30-2023, 07:06 PM
I thought johnno had a contender for QSort when I ran 1 Million Numbers on QB64, it beat my Strings Quick Sort test times, BUT! When I compare the exact same String arrays QSort clearly wins every time!
Here is my test code, both take the string array to sort as a parameter and QSort needs a high and low index, because it calls itself recursively:
I think I have Comb Sort generalized enough to be flexible to start with it's lower bound and end with it's upper bound.
Here is my test code, both take the string array to sort as a parameter and QSort needs a high and low index, because it calls itself recursively:
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
b = b + ...