' 2/4/03.  The previous version of ShuttleMergeSort failed on very short lists. '  The code below corrects the problem and eliminates a couple of unnecessary ' variables.  Sorting times for one million random longs,'  double or strings are 67, 90 and 95 seconds (Excel 2001 / 800 mhz PowerBook /'  MacOS 10.2.3).' 1/7/03.  Here is a 20-25% faster version of MergeSort.  The old version ' merged into an auxiliary array, and copied the result back to the primary ' array at the end of each pass.  This version plans ahead for an even number ' of passes, and alternates direction each time, first merging to the auxiliary ' array and then back to the primary array.  It also replaces recursive calls ' with an explicit stack, and calls to a separate InsertionSort with in-line ' code.  Because of the back and forth merging,'  I call this version "ShuttleMergeSort".' Another frequently proposed optimization for MergeSort is to set runs up in ' alternating directions (low to high, then high to low).  This allows ' replacing separate boundary tests for LP and RP with a single test for LP ' crossing RP.  I tried this, and it wasn't faster in practice.  Probably the ' gain from fewer loop tests was offset by time spent in extra comparisons; in ' the simpler version, when one run is used up, the rest of the other run is ' copied to the output array with no further comparisons.  Also,'  the run-alternating version was significantly slower on presorted inputs,'  which often occur in practice.' QuickSort is still faster for strings (64 sec vs. 95),'  but MergeSort is faster for doubles (90 sec vs. 162) and longs (67 sec vs. ' 116).  Given that MergeSort is stable and guaranteed NlogN,'  while QuickSort is unstable and always has an N^2 worst case,'  MergeSort is my choice for a single all-purpose sort.' The first example below is a pointerized version for strings.  It can be ' adapted to doubles by changing the declaration of A() and T.  The second ' example is a direct version for longs that can be adapted to integers.Sub pShuttleMergeSortS(LO As Long, HI As Long, A() As String, P() As Long, _    Q() As Long)    'LO and HI point to first and last keys; A() is the buffer of string keys.    'P() and Q() are buffers of pointers to the keys in A()    Dim Length As Double    'length of initial runs to be made by InsertionSort    Dim nRuns As Long        'the number of runs at each stage    Dim Stack() As Long        'bookkeeping stack for merge passes    Dim I As Long    Dim L As Long            'left limit    Dim R As Long            'right limit    Dim LP As Long            'left pointer    Dim RP As Long            'right pointer    Dim OP As Long            'other pointer    Dim TMP As String    Dim Forward As Boolean    'toggle for direction of alternate merge passes        'Calculate how many merge passes will be needed.    'Each back & forth pair of merges will convert 4N sublists into N.    Length = 1 + HI - LO    nRuns = 1    While Length > 20        Length = Length / 4        nRuns = nRuns * 4    Wend    'Set up stack to keep track of sublists being merged.    ReDim Stack(1 To nRuns)    For I = 1 To nRuns - 1        Stack(I) = LO + (Length * CDbl(I))    Next I    Stack(nRuns) = HI        'Build short runs using low overhead InsertionSort.    L = LO    For I = 1 To nRuns        R = Stack(I)        For RP = L + 1 To R            OP = P(RP)            TMP = A(OP)            For LP = RP To L + 1 Step -1                If TMP 'Make back & forth passes of MergeSort until all runs are merged.    Forward = True    While nRuns > 1        R = LO - 1        If Forward Then            'Half the passes are forward, merging from P() into Q().            For I = 2 To nRuns Step 2                LP = R + 1                OP = LP                L = Stack(I - 1)                RP = L + 1                R = Stack(I)                Do                    If A(P(LP))  L Then                            Do                                Q(OP) = P(RP)                                OP = OP + 1                                RP = RP + 1                            Loop Until RP > R                            Exit Do                        End If                    Else                        Q(OP) = P(RP)                        OP = OP + 1                        RP = RP + 1                        If RP > R Then                            Do                                Q(OP) = P(LP)                                OP = OP + 1                                LP = LP + 1                            Loop Until LP > L                            Exit Do                        End If                    End If                Loop                Stack(I  2) = R            Next I        Else        'Half the passes are backward, merging from Q() into P().            For I = 2 To nRuns Step 2                LP = R + 1                OP = LP                L = Stack(I - 1)                RP = L + 1                R = Stack(I)                Do                    If A(Q(LP))  L Then                            Do                                P(OP) = Q(RP)                                OP = OP + 1                                RP = RP + 1                            Loop Until RP > R                            Exit Do                        End If                    Else                        P(OP) = Q(RP)                        OP = OP + 1                        RP = RP + 1                        If RP > R Then                            Do                                P(OP) = Q(LP)                                OP = OP + 1                                LP = LP + 1                            Loop Until LP > L                            Exit Do                        End If                    End If                Loop                Stack(I  2) = R            Next I        End If        'After each merge, we have half as many runs and we switch direction.        nRuns = nRuns  2        Forward = Not Forward    WendEnd SubSub ShuttleMergeSortL(LO As Long, HI As Long, A() As Long, B() As Long)    'LO and HI point to the first and last keys.    'A() and B() are the primary and auxiliary buffers of keys    Dim Length As Double    'length of initial runs to be made by InsertionSort    Dim nRuns As Long        'the number of runs at each stage    Dim Stack() As Long        'bookkeeping stack for merge passes    Dim I As Long    Dim L As Long            'left limit    Dim R As Long            'right limit    Dim LP As Long            'left pointer    Dim RP As Long            'right pointer    Dim OP As Long            'other pointer    Dim TMP As String    Dim Forward As Boolean    'toggle for direction of alternate merge passes        'Calculate how many merge passes will be needed.    'Each back & forth pair of merges will convert 4N sublists into N.    Length = 1 + HI - LO    nRuns = 1    While Length > 20        Length = Length / 4        nRuns = nRuns * 4    Wend    'Set up stack to keep track of sublists being merged.    ReDim Stack(1 To nRuns)    For I = 1 To nRuns - 1        Stack(I) = LO + (Length * CDbl(I))    Next I    Stack(nRuns) = HI        'Build short runs using low overhead InsertionSort.    L = LO    For I = 1 To nRuns        R = Stack(I)        For RP = L + 1 To R            TMP = A(RP)            For LP = RP To L + 1 Step -1                If TMP 'Make back & forth passes of MergeSort until all runs are merged.    Forward = True    While nRuns > 1        R = LO - 1        If Forward Then            'Half the passes are forward, merging from P() into Q().            For I = 2 To nRuns Step 2                LP = R + 1                OP = LP                L = Stack(I - 1)                RP = L + 1                R = Stack(I)                Do                    If A(LP)  L Then                            Do                                B(OP) = A(RP)                                OP = OP + 1                                RP = RP + 1                            Loop Until RP > R                            Exit Do                        End If                    Else                        B(OP) = A(RP)                        OP = OP + 1                        RP = RP + 1                        If RP > R Then                            Do                                B(OP) = A(LP)                                OP = OP + 1                                LP = LP + 1                            Loop Until LP > L                            Exit Do                        End If                    End If                Loop                Stack(I  2) = R            Next I        Else         'Half the passes are backward, merging from Q() into P().           For I = 2 To nRuns Step 2                LP = R + 1                OP = LP                L = Stack(I - 1)                RP = L + 1                R = Stack(I)                Do                    If B(LP)  L Then                            Do                                A(OP) = B(RP)                                OP = OP + 1                                RP = RP + 1                            Loop Until RP > R                            Exit Do                        End If                    Else                        A(OP) = B(RP)                        OP = OP + 1                        RP = RP + 1                        If RP > R Then                            Do                                A(OP) = B(LP)                                OP = OP + 1                                LP = LP + 1                            Loop Until LP > L                            Exit Do                        End If                    End If                Loop                Stack(I  2) = R            Next I        End If       'After each merge, we have half as many runs and we switch direction.        nRuns = nRuns  2        Forward = Not Forward    WendEnd Sub