Binaryworld - QuickSort - Exploiting the principle of exchanging keys ... [ VB -> Datastructure ]

' QuickSort. QuickSort, CombSort and ShellSort all exploit the principle of
' exchanging keys that are far apart in the list rather than adjacent.
' QuickSort does this most elegantly and rapidly. The approach is to choose a
' "pivot" value (ideally, the median key) and then to work from each end of the
' list toward the middle. A key at each end is compared to the pivot and
' nothing is done if the left key is less than the pivot or the right key is
' greater. When a left key greater than the pivot and a right key less than
' the pivot have been found, those keys (or their pointers) are swapped,
' and the process continues until the left and right pointers cross. We then
' recursively call QuickSort on the left and right sublists until the lists are
' small (and delegate final sorting to low overhead InsertionSort).
'
' QuickSort does not need any auxiliary arrays, but uses a modest amount of
' stack space for recursion. It is not stable (although its descendent Ternary
' QuickSort is). On average, it is the fastest of the O(N log N) sorts,
' but it suffers from rare "worst case" behavior where certain input orders of
' keys cause speed to deteriorate to O(N^2). Naive implementations of
' QuickSort that choose the middle key for pivot exhibit O(N^2) behavior on
' sorted lists. The version of QuickSort presented here makes worst case
' behavior very unlikely by choosing the median of the first,
' last and middle keys as pivot. Two versions are provided. pQuickSortS is
' set up for strings and can be adapted to doubles by changing the declaration
' of array A(). QuickSortL is set up for longs, or A() can be redeclared for
' integers.
'
' Reference: Robert Sedgewick, "Implementing Quicksort Programs",
' Comm. of the ACM 21(10):847-857 (1978).
'
' Speed: pQuickSortS sorts 500,000 random strings in 30.3 sec; sorts 100186
' library call numbers in 11.3 sec; sorts 25479 dictionary words in 2.0 sec
' (random order), 1.3 sec (presorted) or 1.8 sec (reverse sorted). QuickSortL
' sorts 500,000 random longs in 56 seconds. Timed in Excel 2001 on an 800 mhz
' PowerBook.
'
' Bottom line: contends with RadixSort for fastest; better adapted than Radix
' for non-string data, but not stable.

' 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

pQuickSortS L, R, S1, P1
QuickSortL L, R, L1

' CODE:

Sub pQuickSortS(L As Long, R As Long, A() As String, P() As Long)
  'We put "sentinel" values flanking the real keys to avoid an extra test in
  ' the inner loop.
  A(L - 1) = MinStr
  A(R + 1) = MaxStr
  'We mostly sort the list with QuickSort.
  pQuickS L, R, A(), P
  'Then we finish up with low overhead InsertionSort
  pInsertS L, R, A(), P
End Sub

Sub pQuickS(L As Long, R As Long, A() As String, P() As Long)
  Dim MED As Long
  Dim LP As Long
  Dim RP As Long
  Dim Pivot As String
  Dim TMP As Long

  'Sublists <= 12 keys will be finished by running the whole list once thru
  ' InsertionSort.
  If R - L > 12 Then
  'Get the median pointer...
    MED = (L + R) \ 2
  'and swap it to the leftmost position.
    TMP = P(MED)
    P(MED) = P(L)
    P(L) = TMP
  'Now compare the leftmost, next leftmost & rightmost to choose a median of
  ' 3...
    If A(P(L + 1)) > A(P(R)) Then
      TMP = P(L + 1)
      P(L + 1) = P(R)
      P(R) = TMP
    End If
    If A(P(L)) > A(P(R)) Then
      TMP = P(L)
      P(L) = P(R)
      P(R) = TMP
    End If
    If A(P(L + 1)) > A(P(L)) Then
      TMP = P(L + 1)
      P(L + 1) = P(L)
      P(L) = TMP
    End If
  'and use its key as our pivot.
    Pivot = A(P(L))
  'Now work inward from each end.
    LP = L
    RP = R + 1
    Do
    'Scan right for a pointer whose key >= Pivot. In case Pivot is the
    ' largest key, we have
    'a sentinel value of MaxStr in A(R + 1) that will end a runaway loop.
    ' Using the sentinel
    'avoids having a second test in the inner loop,
    ' so it can be as fast as possible.
      Do
        LP = LP + 1
      Loop While A(P(LP)) < Pivot
    'Scan left for a pointer whose key <= Pivot. Again,
    ' we have a sentinel value of MinStr
    'in A(L - 1) to stop the loop if Pivot is the smallest value in the
    ' list.
       Do
        RP = RP - 1
      Loop While A(P(RP)) > Pivot
    'If the pointers have crossed we're done.
      If RP < LP Then Exit Do
    'Otherwise, swap the pair we've identified.
      TMP = P(LP)
      P(LP) = P(RP)
      P(RP) = TMP
    Loop
  'Swap the pointer of the Pivot value back into place.
    TMP = P(L)
    P(L) = P(RP)
    P(RP) = TMP
  'Sort the shorter sublist first so the recursion stack is limited to
  ' logarithmic depth.
    If (RP - 1) - L < R - LP Then
      pQuickS L, RP - 1, A, P
      pQuickS LP, R, A, P
    Else
      pQuickS LP, R, A, P
      pQuickS L, RP - 1, A, P
    End If
  End If
End Sub

Sub pInsertS(L As Long, R As Long, A() As String, P() As Long)
  Dim LP As Long
  Dim RP As Long
  Dim TMP As Long
  Dim T As String

  For RP = L + 1 To R
    TMP = P(RP)
    T = A(TMP)
    For LP = RP To L + 1 Step -1
      If T < A(P(LP - 1)) Then P(LP) = P(LP - 1) Else Exit For
    Next LP
    P(LP) = TMP
  Next RP
End Sub

Sub QuickSortL(L As Long, R As Long, A() As Long)
  A(L - 1) = MinStr
  A(R + 1) = MaxStr
  QuickL L, R, A
  InsertL L, R, A
End Sub

Sub QuickL(L As Long, R As Long, A() As Long)
  Dim MED As Long
  Dim LP As Long
  Dim RP As Long
  Dim Pivot As String
  Dim TMP As Long

  If R - L > 12 Then
    MED = (L + R) \ 2
    TMP = A(MED)
    A(MED) = A(L)
    A(L) = TMP
    If A(L + 1) > A(R) Then
      TMP = A(L + 1)
      A(L + 1) = A(R)
      A(R) = TMP
    End If
    If A(L) > A(R) Then
      TMP = A(L)
      A(L) = A(R)
      A(R) = TMP
    End If
    If A(L + 1) > A(L) Then
      TMP = A(L + 1)
      A(L + 1) = A(L)
      A(L) = TMP
    End If
    Pivot = A(L)
    LP = L
    RP = R + 1
    Do
      Do
        LP = LP + 1
      Loop While A(LP) < Pivot
      Do
        RP = RP - 1
      Loop While A(RP) > Pivot
      If RP < LP Then Exit Do
      TMP = A(LP)
      A(LP) = A(RP)
      A(RP) = TMP
    Loop
    TMP = A(L)
    A(L) = A(RP)
    A(RP) = TMP
    If (RP - 1) - L < R - LP Then
      QuickL L, RP - 1, A
      QuickL LP, R, A
    Else
      QuickL LP, R, A
      QuickL L, RP - 1, A
    End If
  End If
End Sub

Sub InsertL(L As Long, R As Long, A() As Long)
  Dim LP As Long
  Dim RP As Long
  Dim TMP As Long

  For RP = L + 1 To R
    TMP = A(RP)
    For LP = RP To L + 1 Step -1
      If TMP < A(LP - 1) Then A(LP) = A(LP - 1) Else Exit For
    Next LP
    A(LP) = TMP
  Next RP
End Sub