' 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