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)) 

devxblackblue

About Our Editorial Process

At DevX, we’re dedicated to tech entrepreneurship. Our team closely follows industry shifts, new products, AI breakthroughs, technology trends, and funding announcements. Articles undergo thorough editing to ensure accuracy and clarity, reflecting DevX’s style and supporting entrepreneurs in the tech sphere.

See our full editorial policy.

About Our Journalist