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