排序算法学习

aoe1981

搞了大半晚上，终于把“二叉查找树排序”搞出来了，初步验证效率可与“快速排序”匹敌，而且是“稳定”排序，这个算法有两处很有意思：
1.居然不要用递归的结构，由于排序数据多时，会造成递归次数过大，带来“堆栈溢出”。神奇的是居然可以改成普通循环完成，反而让代码更简洁，只需一个过程即可完成。
2.当规定二叉查找树的“左孩子<=父节点、父节点<右孩子”时，该排序算法是不稳定的；
当规定二叉查找树的“左孩子<父节点、父节点<=右孩子”时，该排序算法是稳定的。
这个结论是我结合普通例子和极端例子初步分析得出的，或许有些不恰当，期待进一步验证。

上代码：

1. Option Explicit
   
2. Public Sub Sort13() '二叉查找树排序（稳定）
   
3.     Dim t!, arr(), brr(), crr(), n&, i&, j&, rng_h&
   
4.     Dim jl() As Boolean, lr() As Boolean, f&(), l&(), r&(), js& '记录判断，左右判断，所有节点的父节点、左孩子、右孩子序号，计数
   
5.     Dim i1&, i2& '当前父节点序号，当前子节点序号
   
6.     t = Timer()
   
7.     Sht.Activate
   
8.     Range("o3:o" & Rows.Count).ClearContents
   
9.     rng_h = Range("a" & Rows.Count).End(xlUp).Row
   
10.     If rng_h < 3 Then
    
11.         End
    
12.     ElseIf rng_h = 3 Then
    
13.         ReDim arr(1 To 1, 1 To 1)
    
14.         arr(1, 1) = Range("a3").Value
    
15.     Else
    
16.         arr = Range("a3:a" & rng_h).Value
    
17.     End If
    
18.     n = UBound(arr, 1)
    
19.     ReDim brr(1 To n), crr(1 To n), jl(1 To n) As Boolean, lr(1 To n) As Boolean, f&(1 To n), l&(1 To n), r&(1 To n)
    
20.     For i = 1 To n
    
21.         brr(i) = arr(i, 1)
    
22.     Next i
    
23.    
    
24.     For i = 2 To n '构建二叉查找树
    
25.         j = 1
    
26.         Do
    
27.             If brr(i) < brr(j) Then '此处更改为brr(i)<=brr(j)则为不稳定排序
    
28.                 If l(j) = 0 Then
    
29.                     l(j) = i '记录左孩子
    
30.                     f(i) = j '记录父节点
    
31.                     Exit Do
    
32.                 Else
    
33.                     j = l(j) '比较左侧下一节点
    
34.                 End If
    
35.             Else
    
36.                 If r(j) = 0 Then
    
37.                     r(j) = i '记录右孩子
    
38.                     lr(i) = True '记录右孩子位于父节点的右枝
    
39.                     f(i) = j '记录父节点
    
40.                     Exit Do
    
41.                 Else
    
42.                     j = r(j) '比较右侧下一节点
    
43.                 End If
    
44.             End If
    
45.         Loop
    
46.     Next i
    
47.    
    
48.     js = 0 '中序遍历记录排序序列
    
49.     i1 = f(1)
    
50.     i2 = 1
    
51.     Do
    
52.         If l(i2) = 0 Then '左孩子为空
    
53.             If jl(i2) = False Then
    
54.                 js = js + 1
    
55.                 crr(js) = brr(i2) '记录节点
    
56.                 jl(i2) = True
    
57.             End If
    
58.             If r(i2) = 0 Then '右孩子也为空
    
59.                 If i2 > 1 Then '根节点无父节点
    
60.                     If lr(i2) Then r(i1) = 0 Else l(i1) = 0 '当前节点为父节点的左（右）枝，父节点已记录的左（右）孩子归零
    
61.                 End If
    
62.             Else
    
63.                 i1 = i2
    
64.                 i2 = r(i2) '节点转至右孩子
    
65.                 GoTo 100
    
66.             End If
    
67.         Else
    
68.             i1 = i2
    
69.             i2 = l(i2) '节点转至左孩子
    
70.             GoTo 100
    
71.         End If
    
72.         If i1 = 0 Then i1 = f(1) Else i1 = f(i1)
    
73.         If i1 = 0 Then i2 = 1 Else i2 = i1 '回溯到父节点
    
74. 100:
    
75.     Loop Until js = n
    
76.    
    
77.     For i = 1 To n
    
78.         arr(i, 1) = crr(i)
    
79.     Next i
    
80.     Range("o3").Resize(n, 1).Value = arr
    
81.     Range("o2").Value = Timer() - t
    
82. End Sub

复制代码

附件说明：已更新至1楼。

（20190930上午8：32新增并完善代码。“新增”指续写出“二叉查找树排序”代码，“完善”主要针对1、2楼代码中关于数据源为空和只有一个源数据时的错误，已贴出的代码不再修改。）


原理容后细细道来，夜深了。细说原理，于我也是好的，日子久了，我也会看着糊涂的，写的过程确实很费劲。

aoe1981

家中旧电脑100万个=RANDBETWEEN(1,1000000)的随机整数测试：
希尔排序：19.18798828秒；
归并排序：11.41894531秒；
快速排序：7.036132813秒；
堆排序：15.64599609秒；
计数排序：4.102050781秒；
基数排序：6.520019531秒；
二叉查找树排序：12.32397461秒。
可见：
希尔>堆排>二叉查找树>归并>快速>基数>计数


单位较新电脑100万个=RANDBETWEEN(1,1000000)的随机整数测试：
希尔排序：5.7265625秒；
归并排序：4.2890625秒；
快速排序：3.3515625秒；
堆排序：6.2265625秒；
计数排序：2.73046875秒；
基数排序：3.27734375秒；
二叉查找树排序：4.3515625秒。
可见：
堆排>希尔>二叉查找树>归并>快速>基数>计数


“二叉查找树排序”比不过“归并”和“快速”啊，也有可能是我的“二叉查找树排序”的代码还不够优化，期待大神指点。

也可以看出：二叉树中，“二叉查找树”比“堆”的效率高！！！

aoe1981

本帖说说“二叉查找树排序”的道理。

以下列乱序序列为例：

i：1、2、3、4、5、6、7、8、9、10

brr(i)：5、2、6、1、3、9、7、6、4、8

一、对于排序“不稳定”的二叉查找树

左孩子键值<=父节点键值

父节点键值<右孩子键值

按i的序号，依次可生成如下“二叉查找树”：

1.元素brr(i)的二叉查找树

2.相对应的元素序号i的二叉图

二、对于排序“稳定”的二叉查找树

左孩子键值<父节点键值

父节点键值<=右孩子键值

按i的序号，依次可生成如下“二叉查找树”：

1.元素brr(i)的二叉查找树

2.相对应的元素序号i的二叉图

三、VBA中如何用数组构建二叉查找树

以文首乱序序列为例，以构建对排序“稳定”的二叉查找树为例。

i：1、2、3、4、5、6、7、8、9、10

brr(i)：5、2、6、1、3、9、7、6、4、8

1.记录左孩子序号

i：1、2、3、4、5、6、7、8、9、10

l(i)：2、4、0、0、0、7、8、0、0、0

2.记录右孩子序号

i：1、2、3、4、5、6、7、8、9、10

r(i)：3、5、6、0、9、0、10、0、0、0

3.记录父节点序号

i：1、2、3、4、5、6、7、8、9、10

f(i)：0、1、1、2、2、3、6、7、5、7

4.记录各节点位于父节点的左枝或右枝

i：1、2、3、4、5、6、7、8、9、10

lr(i)：False、False、True、False、True、True、False、False、True、True

其中：False表示左枝，True表示右枝。

5.标记各节点元素值（或键值）是否被“中序遍历”记录进有序区

i：1、2、3、4、5、6、7、8、9、10

jl(i)：False、False、False、False、False、False、False、False、False、False

全部为True时意味着程序（或“中序遍历”）的结束。

6.动态记录当前节点及其父节点的序号

i1：当前节点的父节点序号

i2：当前节点的序号

其实，程序中的所谓“二叉查找树”主要由源数组brr(i)和上面1～4项中的数组：l(i)、r(i)、f(i)、lr(i)共同组成，是指它们的逻辑结构是“二叉查找树”，而非呈现形态。

四、二叉查找树的遍历取值

1.先序遍历：父节点→左孩子→右孩子；

2.中序遍历：左孩子→父节点→右孩子；

3.后序遍历：左孩子→右孩子→父节点。

可见，左孩子的访问始终在右孩子之前，以父节点的访问位置为划分依据，居左为“先序”，居中为“中序”，居右为“后序”。下面主要介绍“中序遍历”，因为该遍历方式下生成的是从小到大的已排序序列。

上例中，对于排序“稳定”的二叉查找树各节点的遍历次序如下图：

其实，程序中实际的遍历寻找路线是：

5→2→1→2→3→4→3→2→5→6→10→8→7→8→9→8→10

虽然说“只需遍历一次”就可提取出完整的已排序序列，但是明显可以看出，这“一次”中既有“寻找”，又有“回溯”，来回折腾不在话下，故而效率低了些，比不上快速排序，但是比起“堆”这种二叉树的维护来说，效率又是高的。

aoe1981

一把小刀闯天下 发表于 2019-9-28 23:04
'都是整数这样效率也不错，，，

Option Explicit

您这个也是“计数排序”，不过，我为何觉得内循环中的判断是不是没啥必要？
　If brr(i, 1) > 0 Then
      For j = 1 To brr(i, 1)
        m = m + 1
        arr(m, 1) = i
      Next　Endif
为什么不直接写成：
      For j = 1 To brr(i, 1)
        m = m + 1
        arr(m, 1) = i
      Next

连lee1892大师也是这样做的，我想应该测试下速度。

我在天外

mark下，回头学习下

zopey

1. Sub pey_test()
   
2. Dim arr, k0
   
3. k0 = [a1].End(4).Row
   
4. arr = [a1].Resize(k0, 1)
   
5. 
   
6. Dim brr() As Long
   
7. ReDim brr(0 To 1) '假设最小值 -1 最大值 65535
   
8. brr(0) = -1: brr(1) = 65535
   
9. 
   
10. Set dica = CreateObject("Scripting.Dictionary")
    
11. Set dicb = CreateObject("Scripting.Dictionary")
    
12. dica(-1) = 65535: dicb(-1) = 0
    
13. 
    
14. '''''''循环插入
    
15. For i = 1 To k0
    
16.    dicb(arr(i, 1)) = dicb(arr(i, 1)) + 1
    
17.    
    
18.    If Not dica.exists(arr(i, 1)) Then
    
19.       temp = Application.Lookup(arr(i, 1), brr)
    
20.       dica(arr(i, 1)) = dica(temp): dica(temp) = arr(i, 1)
    
21.       
    
22.       ReDim Preserve brr(0 To UBound(brr) + 1)
    
23.       For j = UBound(brr) To 0 Step -1
    
24.           If brr(j - 1) = temp Then
    
25.              brr(j) = arr(i, 1): Exit For
    
26.           Else
    
27.              brr(j) = brr(j - 1)
    
28.           End If
    
29.       Next j
    
30.    End If
    
31. Next i
    
32. 
    
33. '''''''''结果输出
    
34. ReDim brr(1 To k0, 1 To 1)
    
35. k = 0: stra = -1
    
36. 
    
37. Do
    
38.    For i = 1 To dicb(stra)
    
39.        k = k + 1: brr(k, 1) = stra
    
40.    Next
    
41.    stra = dica(stra)
    
42. Loop Until k = k0
    
43. 
    
44. [c1].Resize(k0, 1) = brr
    
45. End Sub

复制代码

写了一个插入排序，A列为原始数字，数值范围暂假设（0-65535）可以是小数，C列为排序结果。

zopey

1. Sub pey_test()
   
2. Dim arr, k0
   
3. k0 = [a1].End(4).Row
   
4. arr = [a1].Resize(k0, 1)
   
5. 
   
6. Dim brr() As Double
   
7. ReDim brr(0 To 1) '假设最小值 -1 最大值 65535
   
8. brr(0) = -1: brr(1) = 65535
   
9. 
   
10. Set dic = CreateObject("Scripting.Dictionary")
    
11. '''''''循环插入
    
12. For i = 1 To k0
    
13.    If Not dic.exists(arr(i, 1)) Then
    
14.       temp = Application.Lookup(arr(i, 1), brr)
    
15.       
    
16.       ReDim Preserve brr(0 To UBound(brr) + 1)
    
17.       For j = UBound(brr) To 0 Step -1
    
18.           If brr(j - 1) = temp Then
    
19.              brr(j) = arr(i, 1): Exit For
    
20.           Else
    
21.              brr(j) = brr(j - 1)
    
22.           End If
    
23.       Next j
    
24.    End If
    
25.    dic(arr(i, 1)) = dic(arr(i, 1)) + 1
    
26. Next i
    
27. 
    
28. '''''''''结果输出
    
29. Dim crr()
    
30. ReDim crr(1 To k0, 1 To 1)
    
31. 
    
32. For i = 1 To UBound(brr)
    
33.    For j = 1 To dic(brr(i))
    
34.        k = k + 1: crr(k, 1) = brr(i)
    
35.    Next
    
36. Next i
    
37. 
    
38. [c1].Resize(k0, 1) = crr
    
39. End Sub
    

复制代码

简化为 一个字典

一把小刀闯天下

aoe1981 发表于 2019-9-30 18:36
您这个也是“计数排序”，不过，我为何觉得内循环中的判断是不是没啥必要？
　If brr(i, 1) > 0 Then
  ...

感谢老师指点，试了一下确实是这样的。

各测试10次，分别累加计时值，去除if的效率能提升10%。只是觉得挺奇怪的，if本来就是用于逻辑判断，当条件不满足时不进入下层循环效率理应会更高些，但事实并不是这样的。

aoe1981

一把小刀闯天下 发表于 2019-10-1 08:52
感谢老师指点，试了一下确实是这样的。

各测试10次，分别累加计时值，去除if的效率能提升10%。只是觉 ...

您就别这样客气了，在这个坛子里，我也是一个学习者，岂敢以“老师”自居。
用if判断，您和lee1892都是这样处理的，故而我想探讨，下一句for是从1开始循环，终值为0按理应该不会执行循环体，难道for后面的条件计算判断的效率比if的低？故而大神也会采取这种办法？
这才是我的疑惑，不能简单就说，我的想法是专业的或对的。

感谢感谢。

aoe1981

zopey 发表于 2019-9-30 23:44
简化为 一个字典

您才是高手，写出的代码思路新奇，让人大开眼界！
（1）temp = Application.Lookup(arr(i, 1), brr)旨在查找不大于arr(i,1)的在brr中最接近的值；
（2）If Not dic.exists(arr(i, 1)) Then排除了重复值；
（3）循环插入旨在为接下来的字典计数做好准备，使得访问字典的key值是有序的。
佩服佩服，学习学习！