dcsimg
Login | Register   
LinkedIn
Google+
Twitter
RSS Feed
Download our iPhone app
TODAY'S HEADLINES  |   ARTICLE ARCHIVE  |   FORUMS  |   TIP BANK
Browse DevX
Sign up for e-mail newsletters from DevX

By submitting your information, you agree that devx.com may send you DevX offers via email, phone and text message, as well as email offers about other products and services that DevX believes may be of interest to you. DevX will process your information in accordance with the Quinstreet Privacy Policy.


Tip of the Day
Language: VB5, VB6
Expertise: Advanced
Jan 13, 2003

WEBINAR:

On-Demand

Building the Right Environment to Support AI, Machine Learning and Deep Learning


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

David B.
 
Comment and Contribute

 

 

 

 

 


(Maximum characters: 1200). You have 1200 characters left.

 

 

Sitemap
Thanks for your registration, follow us on our social networks to keep up-to-date