堆排序演示

lipton

堆排序是一种高效的排序方法，关于原理算法，论坛和网上有许多帖子介绍，这里就不复述了，直接发个实例给初学的同学参考。

lipton

主要函数：

起始函数

1. Public Sub HeapSortFunction(arr() As Long)
   
2.         
   
3.     Dim i As Long
   
4.     Dim iLength As Long
   
5.    
   
6.     iLength = UBound(arr)
   
7.     Call BuildMaxHeap(arr, iLength) ' 创建大顶推（初始状态看做：整体无序）
   
8.     For i = iLength To 1 Step -1
   
9.         
   
10.         clsBin(0).setColor   '用于观察交换的位置实际运行不需此语句
    
11.         clsBin(i).setColor   '用于观察交换的位置实际运行不需此语句
    
12.         
    
13.         Call Swap(arr(0), arr(i), 0, i) ' 将堆顶元素依次与无序区的最后一位交换（使堆顶元素进入有序区）
    
14.         Call MaxHeapify(arr, 0, i) '重新将无序区调整为大顶堆
    
15.     Next i
    
16.             
    
17.         
    
18. End Sub

复制代码

创建大顶推（根节点大于左右子节点）

1. ' 创建大顶推（根节点大于左右子节点）
   
2. 
   
3. Private Sub BuildMaxHeap(arr() As Long, iLength As Long)
   
4. 
   
5.     Dim i As Long
   
6.    
   
7.     '根据大顶堆的性质可知：数组的前半段的元素为根节点，其余元素都为叶节点
   
8.     For i = iLength \ 2 To 0 Step -1        '从最底层的最后一个根节点开始进行大顶推的调整
   
9.    
   
10.         Call MaxHeapify(arr, i, iLength + 1) '调整大顶堆
    
11.     Next i
    
12. 
    
13. End Sub

复制代码

核心函数：升序或降序在此函数调整

1. Private Sub MaxHeapify(arr() As Long, currentIndex As Long, heapSize As Long)
   
2. 
   
3.     Dim left As Long
   
4.     Dim right As Long
   
5.     Dim large As Long
   
6.    
   
7.     left = 2 * currentIndex + 1         '左子节点在数组中的位置
   
8.     right = 2 * currentIndex + 2        '右子节点在数组中的位置
   
9.     large = currentIndex                '记录此根节点、左子节点、右子节点 三者中最大值的位置
   
10. 
    
11.     If left < heapSize Then
    
12.         If arr(left) > arr(large) Then  '与左子节点进行比较
    
13.             large = left
    
14.         End If
    
15.     End If
    
16.     If right < heapSize Then
    
17.         If arr(right) > arr(large) Then '与右子节点进行比较
    
18.             large = right ';
    
19.         End If
    
20.     End If
    
21.     If currentIndex <> large Then '如果 currentIndex不等于large 则表明 large 发生变化（即：左右子节点中有大于根节点的情况）
    
22.         
    
23.         clsBin(currentIndex).setColor   '用于观察交换的位置实际运行不需此语句
    
24.         clsBin(large).setColor          '用于观察交换的位置实际运行不需此语句
    
25.         
    
26.         Call Swap(arr(currentIndex), arr(large), currentIndex, large) '将左右节点中的大者与根节点进行交换（即：实现局部大顶堆）
    
27.         Call MaxHeapify(arr, large, heapSize) '以上次调整动作的large位置（为此次调整的根节点位置），进行递归调整
    
28.     End If
    
29.    
    
30. End Sub

复制代码

lipton

附件是实例，附件在0ffice2010测试通过。

tlog

虽然不是很了解，但是觉得很牛X

Laofofo

谢谢分享！

liyongji102

hen nv,.谢谢分享

tjusophia

密码是多少

lipton

tjusophia 发表于 2014-7-3 08:58
密码是多少

我发的附件从来不加密码。