堆排序(使用VB实现）

堆排序(使用VB实现）

大根堆，即父节点大于等于其子节点，但左、右子节点大小不考虑。
堆排序的主体思路为：从最后一个父节点开始，调整将该节点调整为大根堆，然后调整上一个父节点为大根堆，最终将首个父节点为大根堆。所以最大的值即为首个父节点。

首个父节点与最后一个节点相调换，最值被放到最后一个节点，循环，最终完成排序。
在进行排序之前，首先需要确定的是最后一个父节点、每父节点对应的左子节点和右子节点的下标。
假设一个数组arr()，其上边界为L，下边界为H，父节点对应的下标为dad，两个子节点下标分别为left_son和right_son，最后一个父节点的下标为last_dad，则有如下关系：
L=lbound(arr)
H=ubound(arr)
left_son=2dad+1-L
right_son=left_son+1=2dad+2-L
last_dad=(L+H-1)/2

代码如下：

Option Explicit
'设定L=lbound(arr)  H=ubound(arr)
'lastParent=(L+H-1)/2
'leftChild=2*parent+1-L
'rightChild=leftChild+1=2*parent+2-L

Const LOW As Long = 2
Const HIGH As Long = 10
Sub swap(x As Long, y As Long)
    Dim t As Long
    t = x
    x = y
    y = t
End Sub

'调整为大根堆
'indxStart  代表取部分数组的首元素下标， indxEnd 代表取部分数组尾元素下标， low代表整个数组的首元素下标
'取部分数组是因为在堆排序时，数组的范围不断缩小，将最值放到取部分数组的最后元素的后一个元素中，indxStart==Low
Sub adjust2MaxHeap(ByRef arr() As Long, ByRef indxStart As Long, ByRef indxEnd As Long, ByRef L As Long)
    Dim parent As Long: parent = indxStart
    Dim child As Long: child = 2 * parent + 1 - L
    
    Do While (child >= indxStart And child <= indxEnd)
        
        '取child=max(leftChild,rightChild)
        If child + 1 <= indxEnd Then            '此处不能写为 if child+1<=indxEnd AND arr(child)<arr(child+1)
            If arr(child) < arr(child + 1) Then '因为如果child+1<=indxEnd不成立，计算机仍会判断arr(child+1)
                child = child + 1               '而此时arr(child+1)访问越界，造成bug
            End If                              '如果是C语言，则可以写为 if( child+1<arrLen && arr[child]<arr[child+1])
        End If                                  '因为C语言中，if(test1 && test2){},计算机会先判断test1，
                                                '如果test1不成立，则不会再去判断test2，不会造成越界访问
        If (arr(parent) < arr(child)) Then
            swap arr(parent), arr(child)
            parent = child
            child = 2 * parent + 1 - L
        Else
            GoTo exitLoop
        End If
    Loop
exitLoop:
End Sub

'对数组进行堆排序
'步骤：从最后一个父节点开始，将整个数组调整为大根堆，然后将最值arr(L)和最后一个元素arr(H)进行互换
'      依次取新数组，缩小数组的尾元素indxEnd,依次调整为大根堆，并将最值arr(L)和新数组的最后一个元素arr(i)进行交换，
'      完成排序
Sub heapSort(arr() As Long)
    Dim L As Long: L = LBound(arr)
    Dim H As Long: H = UBound(arr)
    Dim parent As Long
    Dim child As Long
    parent = (L + H - 1) / 2
    child = 2 * parent + 1 - L
    Dim i As Long
    
    '从最后一个父节点开始，将整个数组调整为大根堆
    '然后将最值arr(L)和最后一个元素arr(H)进行互换
    
    For i = parent To L Step -1         ' i 代表indxStart
        adjust2MaxHeap arr, i, H, L
    Next i
    swap arr(L), arr(H)
    
    '依次取新的数组arr
    '上标indxStart为L， 下标indxEnd依次为 H-1, H-2 ,...L+1
    '将新的数组调整为大根堆，并将最值arr(L)与最后一个元素arr(i)相交换
    
    For i = H - 1 To L + 1 Step -1      'i 代表indxEnd
        adjust2MaxHeap arr, L, i, L
        swap arr(L), arr(i)
    Next i
End Sub

Sub main()
    Dim arr() As Long
    ReDim arr(LOW To HIGH) As Long
    Dim L As Long
    Dim H As Long
    L = LBound(arr)
    H = UBound(arr)
    Dim i As Long
    For i = L To H
        arr(i) = Application.WorksheetFunction.RandBetween(LOW, HIGH)
        Sheets(1).Cells(i, 1) = arr(i)
    Next i
    
    heapSort arr '对数组进行了堆排序
    For i = L To H
        Sheets(1).Cells(i, 2) = arr(i)
    Next i
    
End Sub