Is there a quicksort routine without calling itself / without using recursion

Question

The well known quicksort routine uses two recursive calls at the end. However, using the quicksort routine in Excel-VBA for large unsorted arrays (> 400 thousand elements) may lead to a memory stack overflow because of the many recursive calls.

Public Sub dQsort(List() As Double, ByVal min As Long, ByVal max As Long)
    Dim med_value As Double
    Dim hi As Long
    Dim lo As Long
    Dim i As Long

    ' If min >= max, the list contains 0 or 1 items so it is sorted.
    If min >= max Then GoTo ErrorExit
    ' Pick the dividing value.
    i = (max + min + 1) / 2
    med_value = List(i)
    ' Swap it to the front.
    List(i) = List(min)
    lo = min
    hi = max

    Do
        ' Look down from hi for a value < med_value.
        Do While List(hi) >= med_value
            hi = hi - 1
            If hi <= lo Then Exit Do
        Loop
        If hi <= lo Then
            List(lo) = med_value
            Exit Do
        End If
        ' Swap the lo and hi values.
        List(lo) = List(hi)
        ' Look up from lo for a value >= med_value.
        lo = lo + 1
        Do While List(lo) < med_value
            lo = lo + 1
            If lo >= hi Then Exit Do
        Loop
        If lo >= hi Then
            lo = hi
            List(hi) = med_value
            Exit Do
        End If
        ' Swap the lo and hi values.
        List(hi) = List(lo)
    Loop

    ' Sort the two sublists.
    dQsort List(), min, lo - 1  ' Recursive call which I would like to avoid
    dQsort List(), lo + 1, max  ' Recursive call which I would like to avoid

End Sub

My question is: Who knows a modified quicksort routine with only a small penalty in extra time compared to the traditional quicksort routine (because of the mentioned memory stack overflow, you can only compare between the "old" and "new" routine for relative small unsorted arrays)?

Answers shown for the "Questions that may already have your answer" are not the answers for my question.

You could always paste assign the values to a spreadsheet and use Excel's sort then load it back into the array. — Scott Craner, Mar 14 '17 at 20:51
@ScottCraner - ahh - but Excel's sort routine probably uses recursive calls ;) — YowE3K, Mar 14 '17 at 20:52
@YowE3K - It damned well better, it I find out it's bubble sorting I'm asking for my money back. ;-) — Comintern, Mar 14 '17 at 20:54
You will probably have good results googling "vba shell sort" or "vba insertion sort". — GSerg, Mar 14 '17 at 20:59
A [merge sort](https://en.wikipedia.org/wiki/Merge_sort#Bottom-up_implementation) is also a good choice that's fairly easy to write in VBA. — Comintern, Mar 14 '17 at 21:04
With 400 000 records to sort, the nesting level will increase to a whopping .... 20 levels. That should be no problem at all for VBA. Did you have an issue with stack overflow? You could also use the `System.Collections.ArrayList` object. See [here](http://stackoverflow.com/a/34077228/5459839). — trincot, Mar 14 '17 at 21:10
@trincot 20 levels appears to be [the best case](http://stackoverflow.com/a/28371165/11683), with the worst case being 400k, with the VBA recursion limit of [around 4k](http://stackoverflow.com/a/1866120/11683). — GSerg, Mar 14 '17 at 21:33

score 1 · Answer 1 · answered Mar 14 '17 at 21:12

Here is a simple sort for doubles:

Public Sub aSort(ByRef InOut)

    Dim i As Long, J As Long, Low As Long
    Dim Hi As Long, Temp As Variant

    Low = LBound(InOut)
    Hi = UBound(InOut)

    J = (Hi - Low + 1) \ 2
    Do While J > 0
        For i = Low To Hi - J
          If InOut(i) > InOut(i + J) Then
            Temp = InOut(i)
            InOut(i) = InOut(i + J)
            InOut(i + J) = Temp
          End If
        Next i
        For i = Hi - J To Low Step -1
          If InOut(i) > InOut(i + J) Then
            Temp = InOut(i)
            InOut(i) = InOut(i + J)
            InOut(i + J) = Temp
          End If
        Next i
        J = J \ 2
    Loop
End Sub

Sub MAIN()
    Dim ary(1 To 3) As Double, msg As String
    Dim i As Long

    ary(1) = 0.4
    ary(2) = 0.1
    ary(3) = 0.5

    Call aSort(ary)

    msg = ""
    For i = 1 To 3
         msg = msg & ary(i) & vbCrLf
    Next i

    MsgBox msg
End Sub

I don't know if it is "quick" enough.:

score 0 · Accepted Answer · answered Mar 19 '17 at 18:07

The mentioned merge sort has the same disadvantage as the traditional Quicksort: it also uses a recursive call (see the code for Excel’s VBA below, adapted from the named Wiki-page). The TopDownMergeSort sorts only the n-1 array value’s. Therefore, you need to insert the n-th value in the sorted array (of course at the correct place).

Sub Test_Method_MergeSort()

    'Array adData with Doubles, starting from index = 1
    Call TopDownMergeSort(adData)
    Call InsertIntoSortedArray(adData, adData(UBound(adData)), 1, False)

End Sub

'// Array A[] has the items to sort; array B[] is a work array.
Sub TopDownMergeSort(ByRef A() As Double)
    Dim B() As Double
    Dim n As Long
    Dim i As Long

    '// duplicate array A[] into B[]
    n = UBound(A)
    ReDim B(n)

    For i = 1 To n
        B(i) = A(i)
    Next i

    '// sort data from B[] into A[]
    TopDownSplitMerge B, 1, n, A

End Sub

'Sort the given run of array A[] using array B[] as a source.
'iBegin is inclusive; iEnd is exclusive (A[iEnd] is not in the set).

Sub TopDownSplitMerge(ByRef B() As Double, ByVal iBegin As Long, ByVal iEnd As Long, ByRef A() As Double)
    Dim iMiddle As Long
    Dim dTmp As Double

    If (iEnd - iBegin) < 2 Then Exit Sub '  // if run size == 1

    '// split the run longer than 1 item into halves
    iMiddle = (iEnd + iBegin) / 2   '// iMiddle = mid point

    '// recursively sort both runs from array A[] into B[]
    TopDownSplitMerge A, iBegin, iMiddle, B   '// sort the left run
    TopDownSplitMerge A, iMiddle, iEnd, B    '// sort the right run

    '// merge the resulting runs from array B[] into A[]
    TopDownMerge B, iBegin, iMiddle, iEnd, A

End Sub

'// Left source half is A[ iBegin:iMiddle-1].
'// Right source half is A[iMiddle:iEnd-1].
'// Result is B[ iBegin:iEnd-1].
Sub TopDownMerge(ByRef A() As Double, ByVal iBegin As Long, ByVal iMiddle As Long, ByVal iEnd As Long, ByRef B() As Double)
    Dim i As Long
    Dim j As Long
    Dim k As Long

    i = iBegin
    j = iMiddle

    '// While there are elements in the left or right runs...
    For k = iBegin To iEnd - 1

        '// If left run head exists and is <= existing right run head.
        If ((i < iMiddle) And ((j >= iEnd) Or (A(i) <= A(j)))) Then
            B(k) = A(i)
            i = i + 1

        Else
            B(k) = A(j)
            j = j + 1

        End If

    Next k
End Sub

Sub InsertIntoSortedArray(ByRef dSortedArray() As Double, ByVal dNewValue As Double, ByVal LowerBound As Long, Optional ByVal RedimNeeded As Boolean = False)    ', xi As Long) As Long
    Dim n As Long, ii As Long

    n = UBound(dSortedArray)
    If RedimNeeded Then
        ReDim Preserve dSortedArray(n + 1)

    Else
        n = n - 1

    End If 

    ii = n + 1
    Do Until dSortedArray(ii - 1) <= dNewValue Or ii < (LowerBound + 1)
        dSortedArray(ii) = dSortedArray(ii - 1)
        ii = ii - 1
    Loop
    dSortedArray(ii) = dNewValue

End Sub

The solution I was looking for is without any recursive calls. With several additional variables for necessary administration purposes during the sorting steps I succeeded in the following Alternative quicksort “IAMWW_QSort”:

' This code belongs to one and the same Excel’s  code module 
Private Const msMODULE As String = "M_QSort"

Private alMin() As Long
Private alMax() As Long
Private abTopDownReady() As Boolean
Private aiTopDownIndex() As Integer  ' 1 (= TopList) or 2 ( = DownList)
Private alParentIndex() As Long

Sub IAMWW_Qsort(ByRef List() As Double, ByVal Min As Long, ByVal Max As Long)
    Dim med_value As Double
    Dim hi As Long
    Dim lo As Long
    Dim i As Long

    Dim l_List As Long

    ' If min >= max, the list contains 0 or 1 items so it is sorted.
    If Min >= Max Then GoTo ExitPoint

    Call Init(l_List, Min, Max)

Start:

    If abTopDownReady(l_List, 1) And abTopDownReady(l_List, 2) Then
        abTopDownReady(alParentIndex(l_List), aiTopDownIndex(l_List)) = True

        l_List = l_List - 1
        If l_List >= 0 Then
            GoTo Start

        Else
            ' Ready/list is sorted
            GoTo ExitPoint

        End If

    End If

    Min = alMin(l_List)
    Max = alMax(l_List)

    ' -----------------------------------
    ' The traditional part of QuickSort

    ' Pick the dividing value.
    i = (Max + Min + 1) / 2
    med_value = List(i)
    ' Swap it to the front.
    List(i) = List(Min)
    lo = Min
    hi = Max

    Do
        ' Look down from hi for a value < med_value.
        Do While List(hi) >= med_value
           hi = hi - 1
           If hi <= lo Then Exit Do
        Loop
        If hi <= lo Then
            List(lo) = med_value
            Exit Do
        End If
        ' Swap the lo and hi values.
        List(lo) = List(hi)
        ' Look up from lo for a value >= med_value.
        lo = lo + 1
        Do While List(lo) < med_value
            lo = lo + 1
            If lo >= hi Then Exit Do
        Loop
        If lo >= hi Then
           lo = hi
            List(hi) = med_value
            Exit Do
        End If
        ' Swap the lo and hi values.
        List(hi) = List(lo)
    Loop

    ' End of the traditional part of QuickSort
    ' -----------------------------------------

    If Max > (lo + 1) Then
        ' top part as a new sublist
        l_List = l_List + 1
        Init_NewSubList l_List, l_List - 1, 1, lo + 1, Max

        If (lo - 1) > Min Then
            ' down part as a new sublist
            l_List = l_List + 1
            Init_NewSubList l_List, l_List - 2, 2, Min, lo - 1

        Else
            ' down part (=2) is sorted/ready
        abTopDownReady(l_List - 1, 2) = True

        End If


    ElseIf (lo - 1) > Min Then
        ' Top part is sorted/ready...
        abTopDownReady(l_List, 1) = True

        ' ... and down part is a new sublist.
        l_List = l_List + 1
        Init_NewSubList l_List, l_List - 1, 2, Min, lo - 1

    Else
        ' Both the top (=1) and down part (=2) are sorted/ready ...
        abTopDownReady(l_List, 1) = True
        abTopDownReady(l_List, 2) = True

        ' ... and therefore, the parent (sub)list is also sorted/ready ...
        abTopDownReady(alParentIndex(l_List), aiTopDownIndex(l_List)) = True

        ' ... and continue with the before last created new sublist.
        l_List = l_List - 1

    End If

    If l_List >= 0 Then GoTo Start    

ExitPoint:

End Sub

Private Sub Init_NewSubList(ByVal Nr As Long, ByVal Nr_Parent As Long, ByVal iTopDownIndex As Integer, ByVal Min As Long, ByVal Max As Long)

    ' Nr = number of new sublist
    ' Nr_Parent = the parent's list number of the new sublist
    ' iTopDownIndex = index for top (=1) or down part (=2) sublist


    aiTopDownIndex(Nr) = iTopDownIndex  '= 2 ' new sub list is a down part sublist
    alParentIndex(Nr) = Nr_Parent  'l_List - 2
    abTopDownReady(Nr, 1) = False 'The new sublist has a top part sublist, not ready yet
    abTopDownReady(Nr, 2) = False 'The new sublist has a down part sublist, not ready yet

    ' min and max values of the new sublist
    alMin(Nr) = Min
    alMax(Nr) = Max 'lo - 1

End Sub

Private Sub Init(ByRef Nr As Long, ByVal Min As Long, ByVal Max As Long)
    Dim lArraySize As Long

    lArraySize = Max - Min + 1

    ReDim alMin(lArraySize)
    ReDim alMax(lArraySize)
    ReDim abTopDownReady(lArraySize, 2)
    ReDim aiTopDownIndex(lArraySize)
    ReDim alParentIndex(lArraySize)

    Nr = 0
    alMin(Nr) = Min
    alMax(Nr) = Max

    aiTopDownIndex(0) = 2        ' Initial list is assumed to be a down part (= 2)

End Sub

The penalty in extra time because of the additional administrative code lines is very small.

Is there a quicksort routine without calling itself / without using recursion

2 Answers2