VB6: Sorting algorithms (sort array, sorting arrays)

[Ellis Dee]

Shaker sort

Stable: Yes
In-Place: Yes
Online: No
Recursive: No
Grade: B

Shaker sort is a gap-based bubble sort with a twist. Most gap sorts -- shell sort, comb sort, et al. -- begin with a large gap and gradually shrink it down to one. By the time the gap reaches one, the list should be mostly ordered so the final pass should be efficient.

Like other gap sorts, shaker sort begins with a large gap which gradually shrinks. However, once the gap reaches one, the gap gets expanded again before shrinking back toward one. The expanding and contracting gap sizes constitute the "shaking" part of shaker sort. Each additional expansion is smaller and smaller until it eventually resolves to one, when no further expansion is done. At this point the list is almost certain to be nearly sorted, so the final bubble sort pass is very efficient.

Public Function ShakerSort1(ByRef pvarArray As Variant)
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim iMin As Long
    Dim iMax As Long
    Dim varSwap As Variant
    Dim blnSwapped As Boolean
    
    iMin = LBound(pvarArray)
    iMax = UBound(pvarArray)
    i = (iMax - iMin) \ 2 + iMin
    Do While i > iMin
        j = i
        Do While j > iMin
            For k = iMin To i - j
                If pvarArray(k) > pvarArray(k + j) Then
                    varSwap = pvarArray(k)
                    pvarArray(k) = pvarArray(k + j)
                    pvarArray(k + j) = varSwap
                End If
            Next
            j = j \ 2
        Loop
        i = i \ 2
    Loop
    iMax = iMax - 1
    Do
        blnSwapped = False
        For i = iMin To iMax
            If pvarArray(i) > pvarArray(i + 1) Then
                varSwap = pvarArray(i)
                pvarArray(i) = pvarArray(i + 1)
                pvarArray(i + 1) = varSwap
                blnSwapped = True
            End If
        Next i
        If blnSwapped Then
            blnSwapped = False
            iMax = iMax - 1
            For i = iMax To iMin Step -1
                If pvarArray(i) > pvarArray(i + 1) Then
                    varSwap = pvarArray(i)
                    pvarArray(i) = pvarArray(i + 1)
                    pvarArray(i + 1) = varSwap
                    blnSwapped = True
                End If
            Next i
            iMin = iMin + 1
        End If
    Loop Until Not blnSwapped
End Function