VBA编程技巧 之 排序算法初探

liucqa

lee1892 发表于 2013-4-25 12:08
关于希尔排序不同的步长序列的选择，仅仅考查用时似乎并不是完整的工作

下述代码，在前述基础上：

http://blog.csdn.net/hustxifangshibai/article/details/619620

/*
* Ciura 算法。发表于 2001 年。性能卓越。
*/
int shellsortCi(int p[],int n)
{
int op=0;
int h,i,j,t,temp;
int incs[18] = {
  2331004, 1036002, 460445, 204643, 90952,
  40423, 17965, 7985, 3549, 1577, 701,
  301, 132, 57, 23, 9, 4, 1
};

lee1892

liucqa 发表于 2013-4-25 13:15
http://blog.csdn.net/hustxifangshibai/article/details/619620

/*

701以后都是这哥们不知道哪抄来的吧，我用的是：h(k) = INT(2.25 * h(k-1))，他这个应该是：h(k) = INT(701 * 2.25^(k-9))，一回事

http://sun.aei.polsl.pl/~mciura/publikacje/shellsort.pdf

人论文里只出现到1750哦~

好吧，我修正一下，到701后面一个是1750，但也就到此为止了~

liucqa

lee1892 发表于 2013-4-25 13:25
701以后都是这哥们不知道哪抄来的吧，我用的是：h(k) = INT(2.25 * h(k-1))，他这个应该是：h(k) = INT(h ...

希尔排序中不同步长序列的对比：
随机单精度数据数量：300,000
Ciura 的 序列：204643, 90952, 40423, 17965, 7985, 3549, 1577, 701, 301, 132, 57, 23, 9, 4, 1
用时 3.258 秒 移动 8,761,525 / N ^ 1.268  比较 8,620,407 / N ^ 1.266
法师改良 前后互质的 Sedgewick 双公式 序列：260609, 146309, 64763, 36293, 16001, 8929, 3907, 2161, 929, 503, 211, 109, 41, 19, 5, 1
用时 3.293 秒 移动 8,935,513 / N ^ 1.269  比较 8,777,580 / N ^ 1.268

希尔排序中不同步长序列的对比：
随机单精度数据数量：300,000
Ciura 的 序列：204643, 90952, 40423, 17965, 7985, 3549, 1577, 701, 301, 132, 57, 23, 9, 4, 1
用时 3.465 秒 移动 8,771,917 / N ^ 1.268  比较 8,630,846 / N ^ 1.266
法师改良 前后互质的 Sedgewick 双公式 序列：260609, 146309, 64763, 36293, 16001, 8929, 3907, 2161, 929, 503, 211, 109, 41, 19, 5, 1
用时 3.539 秒 移动 8,954,461 / N ^ 1.269  比较 8,797,172 / N ^ 1.268

希尔排序中不同步长序列的对比：
随机单精度数据数量：1,000,000
Ciura 的 序列：460445, 204643, 90952, 40423, 17965, 7985, 3549, 1577, 701, 301, 132, 57, 23, 9, 4, 1
用时 12.574 秒              移动 32,509,377 / N ^ 1.252 比较 32,008,371 / N ^ 1.251
法师改良 前后互质的 Sedgewick 双公式 序列：587527, 260609, 146309, 64763, 36293, 16001, 8929, 3907, 2161, 929, 503, 211, 109, 41, 19, 5, 1
用时 13.867 秒              移动 33,172,395 / N ^ 1.253 比较 32,655,966 / N ^ 1.252

希尔排序中不同步长序列的对比：
随机单精度数据数量：2,400,000
Ciura 的 序列：2331004, 1036002, 460445, 204643, 90952, 40423, 17965, 7985, 3549, 1577, 701, 301, 132, 57, 23, 9, 4, 1
用时 32.852 秒              移动 84,012,798 / N ^ 1.242 比较 82,844,399 / N ^ 1.241
法师改良 前后互质的 Sedgewick 双公式 序列：2354689, 1045055, 587527, 260609, 146309, 64763, 36293, 16001, 8929, 3907, 2161, 929, 503, 211, 109, 41, 19, 5, 1
用时 36.039 秒              移动 85,484,188 / N ^ 1.243 比较 84,233,821 / N ^ 1.242


嗯，Ciura  序列确实快一些。把序列搞全就好了，至少要到一千万。

liucqa

lee1892 发表于 2013-4-25 13:25
701以后都是这哥们不知道哪抄来的吧，我用的是：h(k) = INT(2.25 * h(k-1))，他这个应该是：h(k) = INT(7 ...

Ciura 换成部分质数序列貌似快点

希尔排序中不同步长序列的对比：
随机单精度数据数量：1,000,000
Ciura 的 部分质数序列：460451, 204641, 90947, 40427, 17971, 7993, 3547, 1579, 701, 307, 131, 57, 23, 9, 4, 1
用时 11.902 秒              移动 32,932,455 / N ^ 1.253 比较 32,431,147 / N ^ 1.252
Ciura 的 序列：460445, 204643, 90952, 40423, 17965, 7985, 3549, 1577, 701, 301, 132, 57, 23, 9, 4, 1
用时 12.543 秒              移动 32,524,887 / N ^ 1.252 比较 32,022,997 / N ^ 1.251
法师改良 前后互质的 Sedgewick 双公式 序列：587527, 260609, 146309, 64763, 36293, 16001, 8929, 3907, 2161, 929, 503, 211, 109, 41, 19, 5, 1
用时 13.445 秒              移动 33,162,505 / N ^ 1.253 比较 32,646,279 / N ^ 1.252

希尔排序中不同步长序列的对比：
随机单精度数据数量：500,000
Ciura 的 部分质数序列：460451, 204641, 90947, 40427, 17971, 7993, 3547, 1579, 701, 307, 131, 57, 23, 9, 4, 1
用时 6.320 秒 移动 15,467,034 / N ^ 1.262 比较 15,228,557 / N ^ 1.260
Ciura 的 序列：460445, 204643, 90952, 40423, 17965, 7985, 3549, 1577, 701, 301, 132, 57, 23, 9, 4, 1
用时 6.535 秒 移动 15,310,490 / N ^ 1.261 比较 15,072,301 / N ^ 1.260
法师改良 前后互质的 Sedgewick 双公式 序列：260609, 146309, 64763, 36293, 16001, 8929, 3907, 2161, 929, 503, 211, 109, 41, 19, 5, 1
用时 6.660 秒 移动 15,652,105 / N ^ 1.262 比较 15,377,516 / N ^ 1.261

lee1892

liucqa 发表于 2013-4-25 15:21
Ciura 换成部分质数序列貌似快点

希尔排序中不同步长序列的对比：

按原论文，701后面一个是1750

再后面的都不是Ciura序列了，是拿2.25乘出来的~

1、没有数学上的证明，仅靠几次测试随机数是说明不了问题的
2、快速排序在大数量数据排序时可以轻易的击败希尔排序，所以从根上说，研究希尔排序是数学家的事，咱没必要参合的
3、希尔排序的实际应用实在是太少了，当然代码写起来倒是蛮方便的

liucqa

lee1892 发表于 2013-4-25 15:31
按原论文，701后面一个是1750

再后面的都不是Ciura序列了，是拿2.25乘出来的~

不同的序列，在大数据量下，差距还是很可观的。

对俺这等数学盲来说，啥算法无所谓，如果能在希尔排序里面，找到一个更快的序列，那就用嘛。
要说证明，嗯...  俺的意见是，如果计算机跑10次，大部分时候都是某个序列快的话，那就当作是真快好了{:soso_e113:}

随机单精度数据数量：5,000,000
Ciura 的 序列：2331004, 1036002, 460445, 204643, 90952, 40423, 17965, 7985, 3549, 1577, 701, 301, 132, 57, 23, 9, 4, 1
用时 105.602 秒             移动 185,427,945 / N ^ 1.234              比较 182,904,249 / N ^ 1.233
Ciura 的 部分质数序列：2330959, 1036001, 460451, 204641, 90947, 40427, 17971, 7993, 3547, 1579, 701, 307, 131, 57, 23, 9, 4, 1
用时 95.973 秒              移动 186,994,537 / N ^ 1.235              比较 184,471,604 / N ^ 1.234
法师改良 前后互质的 Sedgewick 双公式 序列：4188161, 2354689, 1045055, 587527, 260609, 146309, 64763, 36293, 16001, 8929, 3907, 2161, 929, 503, 211, 109, 41, 19, 5, 1
用时 94.875 秒              移动 188,564,332 / N ^ 1.235              比较 185,962,704 / N ^ 1.234

随机单精度数据数量：300,000
Ciura 的 序列：204643, 90952, 40423, 17965, 7985, 3549, 1577, 701, 301, 132, 57, 23, 9, 4, 1
用时 4.059 秒 移动 8,749,473 / N ^ 1.267  比较 8,607,971 / N ^ 1.266
Ciura 的 部分质数序列：204641, 90947, 40427, 17971, 7993, 3547, 1579, 701, 307, 131, 57, 23, 9, 4, 1
用时 3.930 秒 移动 8,861,307 / N ^ 1.268  比较 8,719,886 / N ^ 1.267
法师改良 前后互质的 Sedgewick 双公式 序列：260609, 146309, 64763, 36293, 16001, 8929, 3907, 2161, 929, 503, 211, 109, 41, 19, 5, 1
用时 4.039 秒 移动 8,935,631 / N ^ 1.269  比较 8,777,861 / N ^ 1.268

随机单精度数据数量：10,000,000
Ciura 的 部分质数序列：5244763, 2330959, 1036001, 460451, 204641, 90947, 40427, 17971, 7993, 3547, 1579, 701, 307, 131, 57, 23, 9, 4, 1
用时 170.113 秒             移动 394,476,462 / N ^ 1.228              比较 389,258,290 / N ^ 1.227
Ciura 的 序列：5244759, 2331004, 1036002, 460445, 204643, 90952, 40423, 17965, 7985, 3549, 1577, 701, 301, 132, 57, 23, 9, 4, 1
用时 183.105 秒             移动 390,649,594 / N ^ 1.227              比较 385,431,311 / N ^ 1.227
法师改良 前后互质的 Sedgewick 双公式 序列：9427969, 4188161, 2354689, 1045055, 587527, 260609, 146309, 64763, 36293, 16001, 8929, 3907, 2161, 929, 503, 211, 109, 41, 19, 5, 1
用时 190.367 秒             移动 396,334,465 / N ^ 1.228              比较 391,201,441 / N ^ 1.227

俺不明白的是，为什么Ciura 原序列移动和比较的次数少，时间反而长呢？

lee1892

liucqa 发表于 2013-4-25 16:04
不同的序列，在大数据量下，差距还是很可观的。

对俺这等数学盲来说，啥算法无所谓，如果能在希尔排序 ...

1. 俺不明白的是，为什么Ciura 原序列移动和比较的次数少，时间反而长呢？

复制代码

这我也不明白，貌似还和前后次序有关系，看上去你也注意到了。

或则你把法师招来讨论？

liucqa

lee1892 发表于 2013-4-25 16:26
这我也不明白，貌似还和前后次序有关系，看上去你也注意到了。

或则你把法师招来讨论？

前后次序问题，大概是你的代码写的不太对，在每次排序前，应该给排序的数组用循环方式从原始数组重新赋值，而不是用=号

1. Option Explicit
   
2. 
   
3. Sub TestShellSpeed()
   
4.     Dim i&, t#, aData!(), bData!(), arr, j&, sMsg$, aGaps, nLen&
   
5.     Dim nMov As Currency, nCom As Currency
   
6.     nLen = 10 ^ 5 * 3    ' <-- 数据数量
   
7.     ReDim aData(1 To nLen)
   
8.     ReDim bData(1 To nLen)
   
9. 
   
10.     Debug.Print
    
11.     Debug.Print "希尔排序中不同步长序列的对比："
    
12.     Debug.Print "随机单精度数据数量：" & Format(nLen, "#,##")
    
13.     Randomize
    
14.     For j = 1 To UBound(aData)
    
15.         aData(j) = Rnd
    
16.     Next
    
17. 
    
18.     For i = 0 To 2
    
19.         For j = 1 To UBound(aData)
    
20.             bData(j) = aData(j)
    
21.         Next
    
22.         Call GetShellGaps(aGaps, nLen, i, sMsg)
    
23.         t = Timer
    
24.         Call ShellSort(bData, aGaps, nMov, nCom)
    
25.         Debug.Print sMsg & "：" & Join(aGaps, ", ")
    
26.         Debug.Print Format(Timer - t, "用时 0.000 秒"), _
    
27.                     Format(nMov, "移动 #,##") & " / N ^ " & Format(Log(nMov) / Log(nLen), "0.000"), _
    
28.                     Format(nCom, "比较 #,##") & " / N ^ " & Format(Log(nCom) / Log(nLen), "0.000")
    
29.     Next
    
30. End Sub
    
31. 
    
32. Sub ShellSort(ByRef arr, ByRef aGaps, _
    
33.               Optional ByRef nMove As Currency, _
    
34.               Optional ByRef nCompare As Currency)
    
35.     Dim i&, j&, vTemp, nGap, nLen&
    
36.     nLen = UBound(arr)
    
37.     nMove = 0: nCompare = 0
    
38.     For Each nGap In aGaps
    
39.         For i = nGap + 1 To nLen
    
40.             vTemp = arr(i)
    
41.             For j = i To nGap + 1 Step nGap * -1
    
42.                 nCompare = nCompare + 1
    
43.                 If arr(j - nGap) < vTemp Then Exit For
    
44.                 arr(j) = arr(j - nGap)
    
45.                 nMove = nMove + 1
    
46.             Next
    
47.             arr(j) = vTemp: nMove = nMove + 1
    
48.         Next
    
49.     Next
    
50. End Sub
    
51. 
    
52. Sub GetShellGaps(ByRef arrGaps As Variant, _
    
53.                  ByVal nArrLen As Currency, _
    
54.                  Optional ByVal nGapType As Integer = 0, _
    
55.                  Optional ByRef sMessage As String = "")
    
56.     Dim i&, nNum&, aTemp, nCount&
    
57.     Select Case nGapType
    
58.     Case 1    ' Ciura\2001
    
59.         sMessage = "Ciura 的 部分质数序列"
    
60.         aTemp = Array(1, 4, 9, 23, 57, 131, 307, 701, 1579, 3547, 7993, 17971, 40427, 90947, 204641, 460451, 1036001, 2330959, 5244763)
    
61.         For nNum = UBound(aTemp) To 0 Step -1
    
62.             If aTemp(nNum) < nArrLen Then Exit For
    
63.         Next
    
64.     Case 0    ' Ciura\2001
    
65.         sMessage = "Ciura 的 序列"
    
66.         aTemp = Array(1, 4, 9, 23, 57, 132, 301, 701, 1577, 3549, 7985, 17965, 40423, 90952, 204643, 460445, 1036002, 2331004, 5244759)
    
67.         For nNum = UBound(aTemp) To 0 Step -1
    
68.             If aTemp(nNum) < nArrLen Then Exit For
    
69.         Next
    
70.     Case 2    ' Sedgewick\1986 双公式 法师改良 前后互质
    
71.         sMessage = "法师改良 前后互质的 Sedgewick 双公式 序列"
    
72.         aTemp = Array(1, 5, 19, 41, 109, 211, 503, 929, 2161, 3907, 8929, 16001, 36293, 64763, 146309, 260609, 587527, 1045055, 2354689, 4188161, 9427969)
    
73.         For nNum = UBound(aTemp) To 0 Step -1
    
74.             If aTemp(nNum) < nArrLen Then Exit For
    
75.         Next
    
76.     Case 6    ' Tokuda\1992
    
77.         sMessage = "Tokuda 的 序列"
    
78.         ReDim aTemp(0 To 10)
    
79.         nNum = 0
    
80.         Do
    
81.             aTemp(nNum) = Int((9 ^ (nNum + 1) - 4 ^ (nNum + 1)) / (5 * 4 ^ nNum)) + IIf(nNum, 1, 0)
    
82.             If aTemp(nNum) > nArrLen Then nNum = nNum - 1: Exit Do
    
83.             nNum = nNum + 1
    
84.             If UBound(aTemp) < nNum Then ReDim Preserve aTemp(0 To nNum + 10)
    
85.         Loop
    
86.     Case 7    ' Gonnet & Baeza-Yates\1991
    
87.         sMessage = "Gonnet & Baeza-Yates 的 序列"
    
88.         ReDim aTemp(0 To 10)
    
89.         nNum = 0: aTemp(nNum) = Int(5 * nArrLen / 11)
    
90.         Do
    
91.             If aTemp(nNum) <= 1 Then
    
92.                 aTemp(nNum) = 1
    
93.                 ReDim Preserve aTemp(0 To nNum)
    
94.                 arrGaps = aTemp
    
95.                 Exit Sub
    
96.             End If
    
97.             nNum = nNum + 1
    
98.             If UBound(aTemp) < nNum Then ReDim Preserve aTemp(0 To nNum + 10)
    
99.             aTemp(nNum) = Int(5 * aTemp(nNum - 1) / 11)
    
100.         Loop
     
101.     Case 3    ' Sedgewick\1986 双公式
     
102.         sMessage = "原本的 Sedgewick 双公式 序列"
     
103.         ReDim aTemp(0 To 10)
     
104.         nNum = 0: nCount = 1
     
105.         Do
     
106.             aTemp(nNum) = 9 * (4 ^ (nCount - 1) - 2 ^ (nCount - 1)) + 1
     
107.             If aTemp(nNum) > nArrLen Then nNum = nNum - 1: Exit Do
     
108.             nNum = nNum + 1
     
109.             If UBound(aTemp) < nNum Then ReDim Preserve aTemp(0 To nNum + 10)
     
110.             aTemp(nNum) = 4 ^ (nCount + 1) - 6 * 2 ^ nCount + 1
     
111.             If aTemp(nNum) > nArrLen Then nNum = nNum - 1: Exit Do
     
112.             nNum = nNum + 1
     
113.             If UBound(aTemp) < nNum Then ReDim Preserve aTemp(0 To nNum + 10)
     
114.             nCount = nCount + 1
     
115.         Loop
     
116.     Case 4    ' Sedgewick\1986 单公式
     
117.         sMessage = "Sedgewick 单公式 序列"
     
118.         ReDim aTemp(0 To 10)
     
119.         aTemp(0) = 1: nNum = 1
     
120.         Do
     
121.             aTemp(nNum) = 4 ^ nNum + 3 * 2 ^ (nNum - 1) + 1
     
122.             If aTemp(nNum) > nArrLen Then nNum = nNum - 1: Exit Do
     
123.             nNum = nNum + 1
     
124.             If UBound(aTemp) < nNum Then ReDim Preserve aTemp(0 To nNum + 10)
     
125.         Loop
     
126.     Case 5    ' 基于 Fibonacci
     
127.         sMessage = "基于费波那契数列的 序列"
     
128.         aTemp = Array(1, 9, 34, 182, 835, 4025, 19001, 90358, 428481, 2034035, 9651787, 45806244, 217378076, 1031612713, 2147483647)
     
129.         For nNum = UBound(aTemp) To 0 Step -1
     
130.             If aTemp(nNum) < nArrLen Then Exit For
     
131.         Next
     
132. 
     
133.     End Select
     
134.     ReDim arrGaps(0 To nNum)
     
135.     For i = 0 To nNum
     
136.         arrGaps(i) = aTemp(nNum - i)
     
137.     Next
     
138. End Sub

复制代码

liucqa

lee1892 发表于 2013-4-25 12:50
内省排序（IntroSort）

内省排序结合了快速排序、插入排序以及堆排序，充分利用了各自的优点，其运作方式 ...

http://www.cnblogs.com/imAkaka/articles/2407877.html

STL sort源码剖析

灰袍法师

lee1892 发表于 2013-4-25 16:26
这我也不明白，貌似还和前后次序有关系，看上去你也注意到了。

或则你把法师招来讨论？

我的猜想是：比较和移动更多地是在“附近”的地址，所以CPU的高速缓冲有更大的命中率。
这就可以在比较＋移动次数更多的时候，总耗时反而更低。
也许可以把最后几次步长较低的 比较和移动 去掉，不计入总数，就可以看出是不是这个问题。

另一方面，似乎应该用 编译程序 来测试，VBA本身有些什么因素会影响代码速度，我也搞不清楚。

然后就是楼主的质疑：为什么发布希尔排序序列的人，不发布快一点的质数序列，而是发布公式计算出来的序列。
这个我也搞不清楚。
估计是：质数序列实际上并不能做到对 任何情况 都比 原始序列好，所以没必要这么计较。