是否有不调用自身/不使用递归的快速排序例程
Is there a quicksort routine without calling itself / without using recursion
众所周知的快速排序例程在最后使用了两次递归调用。但是，在 Excel-VBA 中对大型未排序数组（> 40 万个元素）使用快速排序例程可能会由于许多递归调用而导致内存堆栈溢出。
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
我的问题是：谁知道修改后的快速排序例程，与传统的快速排序例程相比，额外时间的损失很小（由于提到的内存堆栈溢出，您只能比较 "old" 和"new" 相对较小的未排序数组的例程)?
针对“可能已有您的答案的问题”显示的答案不是我的问题的答案。
这是双打的简单排序：
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
不知道"quick"够不够。:
提到的合并排序与传统的快速排序有相同的缺点：它也使用递归调用（参见下面 Excel 的 VBA 的代码，改编自命名的 Wiki-page ). TopDownMergeSort 仅对 n-1 数组值进行排序。因此，您需要将第 n 个值插入排序后的数组（当然是在正确的位置）。
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
我正在寻找的解决方案是没有任何递归调用。在排序步骤中使用几个额外的变量用于必要的管理目的，我成功地进行了以下替代快速排序“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
额外的行政代码行在加时赛中的惩罚非常小。
众所周知的快速排序例程在最后使用了两次递归调用。但是，在 Excel-VBA 中对大型未排序数组（> 40 万个元素）使用快速排序例程可能会由于许多递归调用而导致内存堆栈溢出。
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
我的问题是：谁知道修改后的快速排序例程，与传统的快速排序例程相比，额外时间的损失很小（由于提到的内存堆栈溢出，您只能比较 "old" 和"new" 相对较小的未排序数组的例程)?
针对“可能已有您的答案的问题”显示的答案不是我的问题的答案。
这是双打的简单排序：
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
不知道"quick"够不够。:
提到的合并排序与传统的快速排序有相同的缺点：它也使用递归调用（参见下面 Excel 的 VBA 的代码，改编自命名的 Wiki-page ). TopDownMergeSort 仅对 n-1 数组值进行排序。因此，您需要将第 n 个值插入排序后的数组（当然是在正确的位置）。
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
我正在寻找的解决方案是没有任何递归调用。在排序步骤中使用几个额外的变量用于必要的管理目的，我成功地进行了以下替代快速排序“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
额外的行政代码行在加时赛中的惩罚非常小。