Login | Register   
LinkedIn
Google+
Twitter
RSS Feed
Download our iPhone app
TODAY'S HEADLINES  |   ARTICLE ARCHIVE  |   FORUMS  |   TIP BANK
Browse DevX
Sign up for e-mail newsletters from DevX


Tip of the Day
Language: VB5, VB6
Expertise: Advanced
Jan 13, 2003

ShuttleMergeSort - An improved MergeSort

' 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 < A(P(LP - 1)) Then P(LP) = P(LP - 1) Else Exit For
            Next LP
            P(LP) = OP
        Next RP
        L = R + 1
    Next I
    
    '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)) <= A(P(RP)) Then
                        Q(OP) = P(LP)
                        OP = OP + 1
                        LP = LP + 1
                        If 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)) <= A(Q(RP)) Then
                        P(OP) = Q(LP)
                        OP = OP + 1
                        LP = LP + 1
                        If 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
    Wend
End Sub

Sub 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 < A(LP - 1) Then A(LP) = A(LP - 1) Else Exit For
            Next LP
            A(LP) = TMP
        Next RP
        L = R + 1
    Next I
    
    '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) <= A(RP) Then
                        B(OP) = A(LP)
                        OP = OP + 1
                        LP = LP + 1
                        If 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) <= B(RP) Then
                        A(OP) = B(LP)
                        OP = OP + 1
                        LP = LP + 1
                        If 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
    Wend
End Sub
David B. Ring
 
Comment and Contribute

 

 

 

 

 


(Maximum characters: 1200). You have 1200 characters left.

 

 

Sitemap