MergeSort – A stable sort

' MergeSort.  A stable sort (preserves original order of records with equal ' keys).  Like HeapSort, easily adapted to any data type and guaranteed to run ' in O(N log N) time, but almost twice as fast.  On the down side,'  needs an extra array of N items, but these can be pointers if the keys ' themselves are larger than pointers.  Works by repeatedly merging short ' sorted sequences (created by InsertionSort) into longer ones.  Two versions ' are given.  pMergeSortS is an indirect (pointerized) version for strings,'  which can be adapted to doubles by changing the declaration of A().  ' MergeSortL is a direct version for longs, which can be adapted to integers.'' Speed:  pMergeSortS sorts 500,000 random strings in 55.3 sec; sorts 100186 ' library call numbers in 9.8 sec; sorts 25479 dictionary words in 3.3 sec ' (random order), 2.9 sec (presorted) or 3.6 sec (reverse sorted).  MergeSortL ' sorts 500,000 random longs in 42 seconds.  Timed in Excel 2001 on an 800 mhz ' PowerBook.'' Bottom line:  fast stable sort that easily handles all data types,'  but a heavy memory user.' Usage:  Dim S1(L To R) As StringDim P1(L To R) As LongDim P2(L To R) As LongDim L1(L To R) As LongDim L2(L To R) As Long For I = L To R    S1(I) = GetRandomString()    P1(I) = I    L1(I) = GetRandomLong()Next IpMergeSortS L, R, S1, P1, P2MergeSortL L, R, L1, L2' CODE:Sub pMergeSortS(L As Long, R As Long, A() As String, P() As Long, Q() As Long)    Dim LP As Long        'left pointer    Dim RP As Long        'right pointer    Dim OP As Long        'output pointer    Dim MID As Long        'This version is for strings; for other data types,    '  change declaration of A().    'MergeSort recursively calls itself until we have lists short enough for     ' InsertionSort.    If R - L < 10 Then       'call an indirect (pointerized) version of InsertionSort        pInsertS L, R, A, P    Else       'if too long for InsertionSort, split list and recurse        MID = (L + R)  2        pMergeSortS L, MID, A, P, Q        pMergeSortS MID + 1, R, A, P, Q               'Each half of the array is sorted; now we'll merge them into the extra        ' array.       'We'll work via pointers, to keep the extra array smaller.        LP = L        RP = MID + 1        OP = L        Do        'Copy the pointer to the smaller string.            If A(P(LP)) <= A(P(RP)) Then                Q(OP) = P(LP)                OP = OP + 1                LP = LP + 1                If LP > MID Then             'We ran out of the left half, so transfer the rest of the right              ' half.                    Do                        Q(OP) = P(RP)                        OP = OP + 1                        RP = RP + 1                    Loop Until RP > R             'This merge is done.                    Exit Do                End If            Else         'This part is a mirror image of the last part.                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 > MID                    Exit Do                End If            End If        Loop    'Finally, we copy the pointers back from the extra array to the main array.        For OP = L To R             P(OP) = Q(OP)        Next OP    End IfEnd SubSub pInsertS(L As Long, R As Long, A() As String, P() As Long)    Dim LP As Long    Dim RP As Long    Dim TMP As Long    Dim T As String        For RP = L + 1 To R        TMP = P(RP)        T = A(TMP)        For LP = RP To L + 1 Step -1            If T < A(P(LP - 1)) Then P(LP) = P(LP - 1) Else Exit For        Next LP        P(LP) = TMP    Next RPEnd SubSub MergeSortL(L As Long, R As Long, A() As Long, B() As Long)    Dim LP As Long    Dim RP As Long    Dim OP As Long    Dim MID As Long        If R - L < 12 Then        InsertL L, R, A()    Else        MID = (L + R)  2        MergeSortL L, MID, A, B        MergeSortL MID + 1, R, A, B        LP = L        RP = MID + 1        OP = L        Do            If A(LP) <= A(RP) Then                B(OP) = A(LP)                OP = OP + 1                LP = LP + 1                If LP > MID 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 > MID                    Exit Do                End If            End If        Loop        For OP = L To R             A(OP) = B(OP)        Next OP    End IfEnd SubSub InsertL(L As Long, R As Long, A() As Long)    Dim LP As Long    Dim RP As Long    Dim TMP As Long        For RP = L + 1 To R        TMP = A(RP)        For LP = RP To L + 1 Step -1            If TMP < A(LP - 1) Then A(LP) = A(LP - 1) Else Exit For        Next LP        A(LP) = TMP    Next RPEnd Sub