Binaryworld - ShellSort - A compact routine that sorts data in place ... [ VB -> Datastructure ]

' 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