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 <= InnerR         '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 <= InnerR                DIF = B(P(InnerR) + DEPTH) - Pivot         'If the key's byte is less, we've found a pointer to swap to the left          ' side.                If DIF < 0 Then Exit Do         '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 < NLO Then SwapN = OuterL - L Else SwapN = NLO        I = L        J = InnerL - SwapN    '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 < NHI Then SwapN = R - OuterR Else SwapN = NHI        I = InnerL        J = R + 1 - SwapN    '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 < NHI Then            TernQuick L, L + NLO - 1, B, P, DEPTH            TernQuick L + NLO + NEQ, L + NLO + NEQ + NHI - 1, B, P, DEPTH        Else            TernQuick L + NLO + NEQ, L + NLO + NEQ + NHI - 1, B, P, DEPTH            TernQuick L, L + NLO - 1, B, P, DEPTH        End If    Else    '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) Or (CI >= CJ And CJ >= CK) Then        BMed3 = J    ElseIf (CJ <= CI And CI <= CK) Or (CJ >= CI And CI >= CK) Then        BMed3 = I    ElseIf (CI <= CK And CK <= CJ) Or (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)) < 0 Then P(LP) = P(LP - 1) Else Exit For        Next LP        P(LP) = TMP    Next RPEnd SubSub Strs2Bytes(A() As String, L As Long, R As Long, B() As Byte, P() As Long)    Dim I As Long    Dim nPtrs As Long    Dim nBytes As Long    Dim DEPTH As Integer        nBytes = 0    nPtrs = 0    For I = L To R        nBytes = nBytes + Strings.Len(A(I)) + 1        nPtrs = nPtrs + 1    Next I    ReDim B(1 To nBytes)    ReDim P(1 To nPtrs)        nPtrs = 1    nBytes = 1    For I = L To R        P(nPtrs) = nBytes        For DEPTH = 1 To Strings.Len(A(I))            B(nBytes) = Asc(Strings.MID(A(I), DEPTH, 1))            nBytes = nBytes + 1        Next DEPTH        B(nBytes) = 0        nBytes = nBytes + 1        nPtrs = nPtrs + 1    Next IEnd Sub

Share the Post:
Share on facebook
Share on twitter
Share on linkedin

Overview

The Latest

your company's audio

4 Areas of Your Company Where Your Audio Really Matters

Your company probably relies on audio more than you realize. Whether you’re creating a spoken text message to a colleague or giving a speech, you want your audio to shine. Otherwise, you could cause avoidable friction points and potentially hurt your brand reputation. For example, let’s say you create a

chrome os developer mode

How to Turn on Chrome OS Developer Mode

Google’s Chrome OS is a popular operating system that is widely used on Chromebooks and other devices. While it is designed to be simple and user-friendly, there are times when users may want to access additional features and functionality. One way to do this is by turning on Chrome OS

homes in the real estate industry

Exploring the Latest Tech Trends Impacting the Real Estate Industry

The real estate industry is changing thanks to the newest technological advancements. These new developments — from blockchain and AI to virtual reality and 3D printing — are poised to change how we buy and sell homes. Real estate brokers, buyers, sellers, wholesale real estate professionals, fix and flippers, and beyond may