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