Load Sort

[bplus]

here is load sort setup to compare with gnome sort PLUS a couple of other sorts for collectors to compare

Code: (Select All)

Option _Explicit
_Title "Gnome Sort vrs Load Sort" ' b+ 2024-04-28
Randomize Timer ' so we have a different array each time we compare

DefLng A-Z
Const nItems = 25000
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 Load Sort"
Sleep
Cls
t## = Timer(.001)
ReDim loadMe$(1 To 1) ' match lower bound of sa$
For i = 1 To UBound(sa$)
    loadSort sa$(i), loadMe$()
Next
qtime## = Timer(.001) - t##
For i = 1 To 10
    Print loadMe$(i),
Next
Print: Print
For i = nItems - 9 To nItems
    Print loadMe$(i),
Next
Print: Print
Print "   Load Sort time:"; qtime##
Print
Print "   Press any to Gnome Sort with array copy, zzz..."
Print
Print
Sleep
t## = Timer(.001)
gnomesort 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 "   Gnome Sort time:"; ctime##
Print
If ctime## < qtime## Then Print "   Gnome wins!" Else Print "   Load Sort wins!"

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

Sub gnomesort (array$())
    'sort a one dimensional array of any size using gnomesort
    'https://en.wikipedia.org/wiki/Gnome_sort
    Dim As Long i, j
    i = LBound(array$) + 1 'find the lowest element in the array and add 1 for the sorting routine
    j = i + 1
    While i <= UBound(array$)
        If array$(i - 1) <= array$(i) Then
            i = j
            j = j + 1
        Else If array$(i - 1) > array$(i) Then
                Swap array$(i - 1), array$(i)
                i = i - 1
                If i = LBound(array$) Then
                    i = j
                    j = j + 1
                End If
            End If
        End If
    Wend
End Sub

'this requires a separate dynamic array (used redim instead of dim) to load and sort array
Sub loadSort (insertN As String, dynArr() As String) '  version 2024-04-29
    'note this leaves dynArr(0) empty! so ubound of array is also number of items in list
    Dim ub, j, k

    ub = UBound(dynArr)
    If LBound(dynarr) = ub And dynArr(ub) = "" Then ' array not started yet
        dynArr(ub) = insertN
    Else
        ReDim _Preserve dynArr(LBound(dynArr) To ub + 1) As String
        For j = 1 To ub
            If insertN < dynArr(j) Then '  GT to LT according to descending or ascending sort
                For k = ub + 1 To j + 1 Step -1
                    dynArr(k) = dynArr(k - 1)
                Next
                Exit For
            End If
        Next
        dynArr(j) = insertN
    End If
End Sub