devxlogo

Ternary QuickSort – A modification of QuickSort

Ternary QuickSort – A modification of QuickSort

' Ternary QuickSort.  See the summary of QuickSort for background before ' reading this one.  Ternary QuickSort (also called MultiKey QuickSort) differs ' from the original QuickSort by examining keys one byte at a time (like ' RadixSort), and by handling keys in three categories -- less than pivot,'  equal to pivot, and more than pivot -- instead of two.  (Separate handling ' of equal keys is why this sort is stable while ordinary QuickSort is not.)  ' As in QuickSort, the left and right sublists are processed recursively until ' they are short enough for InsertionSort.  The equal-to-pivot sublist is also ' handled recursively, except that a pointer indicating the "depth" of the byte ' to be examined is advanced to the next position before the call.  Since ' sublists handed off to InsertionSort consist of keys whose first bytes are ' identical up to DEPTH - 1, we use a special version of InsertionSort that ' compares keys only from DEPTH onward.'' Needs no extra arrays, but uses some stack space for recursion.  In practice ' in VBA, I don't find this sort to be as fast as the original QuickSort,'  but results may differ in languages that offer faster access to bytes within ' strings.  This algorithm is definitely oriented toward strings; see comments ' under MSD Radix Sort on possible adaptation to integers and longs.'' Reference:  Jon Bentley and Robert Sedgewick, "Fast Algorithms for Sorting ' and Searching Strings", Proceedings of the 8th Annual ACM-SIAM Symposium on ' Discrete Algorithms, January 1997.  See also http://www.cs.princeton.edu/~rs/' strings/.'' Speed:  TernaryQuickSort sorts 500,000 random strings in 39 sec; sorts 100186 ' library call numbers in 14 sec; sorts 25479 dictionary words in 1.8 sec ' (random order), 1.9 sec (presorted) or 1.8 sec (reverse sorted).  Timed in ' Excel 2001 on an 800 mhz PowerBook.'' Bottom line:  a stable version of QuickSort good for strings,'  but not (at least in VBA) as fast as the original.' Usage:  Dim S1(L To R) As StringsDim B1(1 To nChars) As ByteDim P1(L To R) As LongFor I = L To R    S1(I) = GetRandomString()Next IStrsToBytes S1, L, R, B1, P1        'a routine that stores the strings in 0-                                    ' terminated byte                            'arrays with P1() holding pointers to the first                             ' byte of                            'each stringTernaryQuickSort L, R, B1, P1' CODE:Sub TernaryQuickSort(L As Long, R As Long, B() As Byte, P() As Long)    TernQuick L, R, B, P, 0End SubSub TernQuick(L As Long, R As Long, B() As Byte, P() As Long, _    ByVal DEPTH As Integer)    Dim TMP As Long    Dim I As Long    Dim J As Long    Dim pMED As Long    Dim Pivot As Integer    Dim OuterL As Long    Dim InnerL As Long    Dim InnerR As Long    Dim OuterR As Long    Dim DIF As Long    Dim N As Long    Dim SwapN As Long    Dim NLO As Long    Dim NHI As Long    Dim NEQ As Long    N = 1 + R - L    'Short sublists will be handled by lower overhead InsertionSort.    If N > 10 Then    'Get a pivot value from the median of three or nine keys.        pMED = BGetMed(B, P, L, N, DEPTH)    'Swap the median into the leftmost position.        TMP = P(L)        P(L) = P(pMED)        P(pMED) = TMP    'Our pivot will be the byte value at DEPTH.        Pivot = B(P(L) + DEPTH)    'Set up two pointers on the left and two on the right.        OuterL = L        InnerL = OuterL        OuterR = R        InnerR = OuterR        Do        'Look for a lefthand key/pointer to swap.            Do While InnerL 'DIF is the key's byte minus the Pivot byte.                DIF = B(P(InnerL) + DEPTH) - Pivot         'If the key's byte is greater, we've found a pointer to swap to the          ' right side.                If DIF > 0 Then Exit Do         'If our byte is equal to the Pivot byte, we swap it to the extreme          ' left end.                If DIF = 0 Then                    TMP = P(OuterL)                    P(OuterL) = P(InnerL)                    P(InnerL) = TMP                    OuterL = OuterL + 1                End If         'If our byte is less than Pivot, we just scan over it.                InnerL = InnerL + 1            Loop        'Now look for a righthand key/pointer to swap.            Do While InnerL 'If the key's byte is less, we've found a pointer to swap to the left          ' side.                If DIF 'If our byte is equal to the Pivot byte, we swap it to the extreme          ' right end.                If DIF = 0 Then                    TMP = P(OuterR)                    P(OuterR) = P(InnerR)                    P(InnerR) = TMP                    OuterR = OuterR - 1                End If                InnerR = InnerR - 1            Loop        'If the inner pointers have crossed, we're done.            If InnerL > InnerR Then Exit Do        'Otherwise, we do the left/right swap we just set up.            TMP = P(InnerL)            P(InnerL) = P(InnerR)            P(InnerR) = TMP            InnerL = InnerL + 1            InnerR = InnerR - 1        Loop    'We've arranged pointers to equal bytes on the far left and right,    '  pointers to lower bytes     'on the inner left, and pointers to higher bytes on the inner right.  Now     ' we will swap the     'equals to the center, between the lowers and the highers.        NLO = InnerL - OuterL        NHI = OuterR - InnerR        NEQ = N - (NLO + NHI)        If OuterL - L 'Move the lefthand equals to center.        Do While SwapN > 0            TMP = P(I)            P(I) = P(J)            P(J) = TMP            I = I + 1            J = J + 1            SwapN = SwapN - 1        Loop        If R - OuterR 'Move the righthand equals to center.        Do While SwapN > 0            TMP = P(I)            P(I) = P(J)            P(J) = TMP            I = I + 1            J = J + 1            SwapN = SwapN - 1        Loop    'If there are more bytes, we increment DEPTH and recurse on the equals.        If B(P(L+NLO) + DEPTH)  0 Then TernQuick L+NLO, L+NLO+NEQ-1, B, P, _            DEPTH+1    'Now we recurse on the lowers and highers; we do the shorter sublist first     ' to hold stack     'depth to log N.        If NLO 'A special version of InsertionSort that compares keys starting at depth     ' (since the    'sublists we hand off to it will have identical prefixes.        DeepInsertS B, P, L, N, DEPTH    End IfEnd SubFunction BGetMed(B() As Byte, P() As Long, L As Long, N As Long, _    DEPTH As Integer) As Long    Dim D As Long    Dim PL As Long    Dim PM As Long    Dim PN As Long        PL = L        PN = L + N - 1        PM = (PL + PN)  2        If N > 30 Then            D = N  8            PL = BMed3(B, P, PL, PL + D, PL + 2 * D, DEPTH)            PM = BMed3(B, P, PM - D, PM, PM + D, DEPTH)            PL = BMed3(B, P, PN - 2 * D, PN - D, PN, DEPTH)        End If        BGetMed = BMed3(B, P, PL, PM, PN, DEPTH)End FunctionFunction BMed3(B() As Byte, P() As Long, I As Long, J As Long, K As Long, _    DEPTH As Integer) As Long    Dim CI As Byte    Dim CJ As Byte    Dim CK As Byte        CI = B(P(I) + DEPTH)    CJ = B(P(J) + DEPTH)    CK = B(P(K) + DEPTH)    If (CI = CJ And CJ >= CK) Then        BMed3 = J    ElseIf (CJ = CI And CI >= CK) Then        BMed3 = I    ElseIf (CI = CK And CK >= CJ) Then        BMed3 = K    End IfEnd FunctionSub DeepInsertS(B() As Byte, P() As Long, L As Long, N As Long, D As Integer)    Dim LP As Long    Dim RP As Long    Dim TMP As Long    Dim I As Long    Dim J As Long        For RP = L + 1 To L + N - 1        TMP = P(RP)        For LP = RP To L + 1 Step -1            I = TMP + D            J = P(LP - 1) + D            Do While B(I) = B(J)                If B(I) = 0 Or B(J) = 0 Then Exit Do                I = I + 1                J = J + 1            Loop            If CInt(B(I)) - CInt(B(J)) 

devx-admin

Share the Post: