CombSort - A compact routine that sorts data in place

' CombSort.  A compact routine that sorts data in place (no extra memory needed)
'  and runs in approximately O(N log N) time.  Not stable (does not preserve 
' original order of records with equal keys).  Like InsertionSort,
'  works by taking a key from the right side of the list and comparing it with 
' keys to the left until the correct position is found to insert it.  Differs 
' from InsertionSort (and resembles ShellSort) by moving leftward by interval 
' GAP instead of one key at a time.  GAP is initially large (to move keys close 
' to their final position rapidly) and is repeatedly reduced until it equals 1 
' and the list is sorted.  Rare sequences of keys may not fit the series of GAP 
' values, leading to slow sorting.  Two versions are given.  pCombSortS is an 
' indirect (pointerized) version for strings, which can be adapted to doubles 
' by changing the declaration of A().  CombSortL is a direct version for longs,
'  which can be adapted to integers.
'
' Reference:  Stephen Lacy and Richard Box, "A Fast, Easy Sort", Byte,
'  April 1991, p.315 ff.
'
' Speed:  pCombSortS sorts 500,000 random strings in 100 sec; sorts 100186 
' library call numbers in 16.5 sec; sorts 25479 dictionary words in 3.5 sec 
' (random order), 2.7 sec (presorted) or 2.9 sec (reverse sorted).  CombSortL 
' sorts 500,000 random longs in 52 seconds.  Timed in Excel 2001 on an 800 mhz 
' PowerBook.
'
' Bottom line:  about as fast as HeapSort, but lacks HeapSort's guarantee of O
' (NlogN) worst case speed.

' Usage:  

Dim S1(L To R) As String
Dim P1(L To R) As Long
Dim L1(L To R) As Long
 
For I = L To R
    S1(I) = GetRandomString()
    P1(I) = I
    L1(I) = GetRandomLong()
Next I

pCombSortS L, R, S1, P1
CombSortL L, R, L1

' CODE:

Sub CombSortS(L As Long, R As Long, A() As String, P() As Long)
    Dim GAP As Long
    Dim SWAPPED As Boolean
    Dim I As Long
    Dim J As Long
    Dim TMP As Long

    'Initialize GAP to length of list.
    GAP = CLng(1 + R - L)
    Do
    'For each pass, divide GAP by 1.3.
        GAP = (10 * GAP) \ 13
    'The most efficient series of final GAP values starts with 11.
        If GAP = 0 Then
            GAP = 1
        ElseIf GAP = 9 Or GAP = 10 Then
            GAP = 11
        End If
    'Use SWAPPED to tell whether we made a pass without any exchanges.
        SWAPPED = False
    'Compare and possibly swap values/pointers separated by GAP.
        For I = L To R - GAP
            J = I + GAP
            If A(P(I)) > A(P(J)) Then
                TMP = P(I)
                P(I) = P(J)
                P(J) = TMP
                SWAPPED = True
            End If
        Next I
    'If GAP = 1 and we didn't move anything, we're done.
    Loop While SWAPPED Or GAP > 1
End Sub

Sub CombSortL(L As Long, R As Long, A() As Long)
    Dim GAP As Long
    Dim SWAPPED As Boolean
    Dim I As Long
    Dim J As Long
    Dim TMP As Long

    GAP = CLng(1 + R - L)
    Do
        GAP = (10 * GAP) \ 13
        If GAP = 0 Then
            GAP = 1
        ElseIf GAP = 9 Or GAP = 10 Then
            GAP = 11
        End If
        SWAPPED = False
        For I = L To R - GAP
            J = I + GAP
            If A(I) > A(J) Then
                TMP = A(I)
                A(I) = A(J)
                A(J) = TMP
                SWAPPED = True
            End If
        Next I
    Loop While SWAPPED Or GAP > 1
End Sub