ShellSort - A compact routine that sorts data in place

' ShellSort. A compact routine that sorts data in place (no extra memory
' needed) and runs in O(N (log N)^2) 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 CombSort) 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
' subsequently reduced until it equals 1 and the list is sorted. Two versions
' are given. pShellSortS is an indirect (pointerized) version for strings,
' which can be adapted to doubles by changing the declaration of A().
' ShellSortL is a direct version for longs, which can be adapted to integers.
'
' Speed: pShellSortS sorts 500,000 random strings in 115 sec; sorts 100186
' library call numbers in 18 sec; sorts 25479 dictionary words in 3.2 sec
' (random order), 0.83 sec (presorted) or 1.4 sec (reverse sorted). ShellSortL
' sorts 500,000 random longs in 67 seconds. Timed in Excel 2001 on an 800 mhz
' PowerBook.
'
' Bottom line: with O(N (log N)^2) behavior, there are better choices.
' 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
pShellSortS L, R, S1, P1
ShellSortL L, R, L1
' CODE:
Sub pShellSortS(L As Long, R As Long, A() As String, P() As Long)
Dim GAP As Long
Dim I As Long
Dim J As Long
Dim TMP As Long
GAP = 1
'Find largest possible GAP.
While GAP * 3 < R - L
GAP = GAP * 3 + 1
Wend
While GAP > 0
For I = GAP + 1 To R
'Start with a right hand pointer.
TMP = P(I)
J = I
'Compare it leftward at intervals of GAP.
Do While J > GAP
'If the left pointer's value is higher, shift it right & go left
' another GAP.
If A(P(J - GAP)) > A(TMP) Then
P(J) = P(J - GAP)
J = J - GAP
Else
Exit Do
End If
Loop
'The right pointer's value was equal or higher, so insert it here.
P(J) = TMP
Next I
'Shrink the GAP until it reaches 1.
GAP = GAP / 3
Wend
End Sub
Sub ShellSortL(L As Long, R As Long, A() As Long)
Dim GAP As Long
Dim I As Long
Dim J As Long
Dim TMP As Long
GAP = 1
While GAP * 3 < R - L
GAP = GAP * 3 + 1
Wend
While GAP > 0
For I = GAP + 1 To R
TMP = A(I)
J = I
Do While J > GAP
If A(J - GAP) > TMP Then
A(J) = A(J - GAP)
J = J - GAP
Else
Exit Do
End If
Loop
A(J) = TMP
Next I
GAP = GAP / 3
Wend
End Sub