QuickSort—Exploiting the Principle of Exchanging Keys

' 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