排序算法学习

zopey

aoe1981 发表于 2019-10-1 09:58
您才是高手，写出的代码思路新奇，让人大开眼界！
（1）temp = Application.Lookup(arr(i, 1), brr)旨在 ...

字典dic 用于 去重、 累加，其key顺序等同 arr，由小到大则是数组brr。
函数Lookup 曾写过一个自定义函数有点印象，它适用更多类型的数据， 二分法查找效率 也比遍历高 ，。

aoe1981

关于“二叉查找树排序”有一点需要补充：
以10000个=RANDBETWEEN(1,10000)随机整数为例测试。

1.当序列为乱序：用时0.1171875秒；

2.当序列为顺序：用时12.34375秒；

3.当序列为倒序：用时7.59765625秒。

显然，“二叉查找树排序”在最坏情况下效率并不理想（与希尔、归并、快速、堆排对比），因为此时的二叉查找树长成了一条长长的链状。如果是顺序，则是一捺，向右下伸展；如果是倒序，则是一撇，向左下伸展。我猜测性分析：影响“二叉查找树”效率的关键是“叶子节点”数量的多少，所谓“叶子节点”，是无左右孩子的，也就是说，某一条从根节点出发的路径到达叶子节点就到了寻找的尽头。叶子节点只访问一次就被记录进有序区，其他节点则访问一次以上，回溯一次以上。链状二叉树中，叶子节点只有一个，其他节点一律访问一次，回溯一次，可能总次数居多吧。

再看看“堆”这种二叉树的排序：
1.乱序序列：0.16015625秒；
2.顺序序列：0.16796875秒；
3.倒序序列：0.16015625秒。
几乎不受影响，十分稳定，这又使我对“堆”刮目相看！！！

zopey

数据拉满
100万组有重复数字 ，测试字典排序，

592rmb

记录下，空了研究

aoe1981

zopey 发表于 2019-10-2 08:46
数据拉满
100万组有重复数字 ，测试字典排序，

受您的启发，又做了一个“二分查找插入排序”，这个算法可以设计成稳定的，它像希尔一样，是对普通插入排序的一种改进，由于采用递归二分查找的方法，比普通插入法把有序区“从后至前扫描”的方法节省时间，但优化效果比不上希尔排序，果然“希尔排序”更加地大名鼎鼎。
10000个=RANDBETWEEN(1,10000)随机整数测试结果如下：
插入排序（5.2890625秒）>二分查找插入排序（2.65625秒）>希尔排序（0.234375秒）
30000个=RANDBETWEEN(1,10000)随机整数测试结果如下：
插入排序（46.953125秒）>二分查找插入排序（23.296875秒）>希尔排序（0.46875秒）


可见，所谓“二分查找插入排序”比起普通“插入排序”效率提升了一半。

代码如下：

1. Option Explicit
   
2. Dim brr(), x&, gd
   
3. Public Sub Sort14() '二分查找插入排序（稳定）
   
4.     Dim t!, arr(), i&, j&, n&, rng_h&
   
5.     t = Timer()
   
6.     Sht.Activate
   
7.     Range("i3:i" & Rows.Count).ClearContents
   
8.     rng_h = Range("a" & Rows.Count).End(xlUp).Row
   
9.     If rng_h < 3 Then
   
10.         End
    
11.     ElseIf rng_h = 3 Then
    
12.         ReDim arr(1 To 1, 1 To 1)
    
13.         arr(1, 1) = Range("a3").Value
    
14.     Else
    
15.         arr = Range("a3:a" & rng_h).Value
    
16.     End If
    
17.     n = UBound(arr, 1)
    
18.     ReDim brr(1 To n)
    
19.     For i = 1 To n
    
20.         brr(i) = arr(i, 1)
    
21.     Next i
    
22.     If brr(1) > brr(2) Then gd = brr(1): brr(1) = brr(2): brr(2) = gd
    
23.     For i = 3 To n
    
24.         gd = brr(i) '储存当前拟插入值
    
25.         x = i '储存当前拟插入值序号
    
26.         If brr(i) < brr(i - 1) Then Call DG_efcz(1, i - 1)
    
27.     Next i
    
28.     For i = 1 To n
    
29.         arr(i, 1) = brr(i)
    
30.     Next i
    
31.     Range("i3").Resize(n, 1).Value = arr
    
32.     Range("i2").Value = Timer() - t
    
33. End Sub
    
34. Public Sub DG_efcz(l&, r&) '有序区数组左起点、右起点
    
35.     Dim c1&, c2&, i&, j&
    
36.     c1 = Int((l + r) / 2)
    
37.     c2 = c1 + 1
    
38.     If brr(x) >= brr(c1) And brr(x) < brr(c2) Then '若同时brr(x) <= brr(c2)的话则不稳定
    
39.         For i = x - 1 To c2 Step -1
    
40.             brr(i + 1) = brr(i)
    
41.         Next i
    
42.         brr(c2) = gd
    
43.     ElseIf brr(x) < brr(c1) Then
    
44.         If c1 = l Then
    
45.             If brr(x) < brr(l) Then j = l Else j = l + 1
    
46.             For i = x - 1 To j Step -1
    
47.                 brr(i + 1) = brr(i)
    
48.             Next i
    
49.             brr(j) = gd
    
50.         Else
    
51.             Call DG_efcz(l, c1)
    
52.         End If
    
53.     ElseIf brr(x) >= brr(c2) Then
    
54.         Call DG_efcz(c2, r)
    
55.     End If
    
56. End Sub

复制代码

同步更新1楼附件。

microyip

表示对楼主的研究精神敬重心悠然而生，平时我也是把代码弄来用，把能弄懂的就修改成自己平时习惯去用，没弄懂就丢一边了，没这么详细去研究

zopey

aoe1981 发表于 2019-10-3 22:40
受您的启发，又做了一个“二分查找插入排序”，这个算法可以设计成稳定的，它像希尔一样，是对普通插入排 ...

1. Sub pey_testb()
   
2. Dim t1, t2
   
3. t1 = Timer
   
4. 
   
5. Dim arr, k0&, ar(), i&
   
6. k0 = [a1].End(4).Row
   
7. arr = [a1].Resize(k0, 1)
   
8. 
   
9. ReDim ar(1 To k0)
   
10. For i = 1 To k0
    
11.     ar(i) = arr(i, 1)
    
12. Next i
    
13. 
    
14. t2 = Timer
    
15. 
    
16. Dim br() As Long, dic As Object, j&, m&
    
17. Set dic = CreateObject("Scripting.Dictionary")
    
18. 
    
19. ReDim br(1 To k0)
    
20. m = 1: br(m) = ar(m): dic(br(m)) = 1
    
21. 
    
22. '''''''循环插入
    
23. 
    
24. For i = 2 To k0
    
25.    If Not dic.exists(ar(i)) Then
    
26.       m = m + 1
    
27.       For j = m To VL(ar(i), br, m) + 2 Step -1
    
28.           br(j) = br(j - 1)
    
29.       Next j
    
30.       br(j) = ar(i)
    
31.    End If
    
32.    dic(ar(i)) = dic(ar(i)) + 1
    
33. Next i
    
34. 
    
35. [e9] = Timer() - t2
    
36. '''''''''结果输出
    
37. Dim brr(), n&
    
38. ReDim brr(1 To k0, 1 To 1)
    
39. 
    
40. For i = 1 To m
    
41.    For j = 1 To dic(br(i))
    
42.        n = n + 1: brr(n, 1) = br(i)
    
43.    Next j
    
44. Next i
    
45. 
    
46. [f1].Resize(k0, 1) = brr
    
47. [e11] = Timer() - t1
    
48. End Sub
    
49. 
    
50. Function VL(X, R, n)
    
51.     l = 0: h = n
    
52.    
    
53.     Do
    
54.        t = l + (h - l) \ 2
    
55.       
    
56.        If X < R(t) Then
    
57.             If t = 1 Then VL = 0: Exit Do
    
58.             h = t
    
59.        Else
    
60.             If t = h - 1 Then VL = t: Exit Do
    
61.             l = t
    
62.        End If
    
63.     Loop
    
64. End Function

复制代码

100万组数字 ，速度有所提升 约2秒

ychj526926

二维数组排序 我觉得香川的快排最牛！

aoe1981

zopey 发表于 2019-10-4 19:54
100万组数字 ，速度有所提升 约2秒

兄台电脑速度快啊，我试了20000整数，用了6.71875，7.0078125……不论硬件，还是软件，都是天外有天啊……

aoe1981

ychj526926 发表于 2019-10-4 22:44
二维数组排序 我觉得香川的快排最牛！

哈哈，香川的“二维数组”排序我没用过，不过“我也觉得”如此！

工作表自带排序相信已经是登峰造极的算法了，我有时候也有些冲动，想练习一下“二维数组”排序，但转念想到工作表排序中不同“关键字”的组合，有些升序，有些降序，不一而论，情况众多，想必更是在做无用功，且目前无用功已做的太多了，便又时时提醒自己打消念头，或者等到有更多闲暇时间后再说……哈哈