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

lee1892 · 发表于 2013-4-24 12:49

liucqa 发表于 2013-4-24 12:33
搞100万数据测试看看

100万干嘛用希尔？基于快速排序的改良和混合要好的多。
再大的，超过内存限制的，只能用合并~

liucqa · 发表于 2013-4-24 14:04

lee1892 发表于 2013-4-24 12:49
100万干嘛用希尔？基于快速排序的改良和混合要好的多。
再大的，超过内存限制的，只能用合并~

就VBA而言，由于在Excel中使用，最大的数据量是100万，所以给出一个支持100万数据的排序算法还是很有意义的。

我试过法师的排序，1000万 long型随机数据与标准的Sedgewick序列相比，大约快了2~3秒。100万long型随机数据大约快0.1~0.15左右，也许对普通用户来说用哪个序列都无所谓的吧。

你有空可以测试一下。

当然，如果你能给出一个快速排序+希尔排序的混合算法，或者快速排序和其他排序的混合算法也可以，只要能保证堆栈不会溢出就行。

具体多大的数据量会导致快速排序的堆栈溢出，我没有做过测试，希望你有空能测一下，谢谢！

liucqa · 发表于 2013-4-24 14:12

lee1892 · 发表于 2013-4-24 15:50

本帖最后由 lee1892 于 2013-4-24 15:54 编辑

liucqa 发表于 2013-4-24 14:04
就VBA而言，由于在Excel中使用，最大的数据量是100万，所以给出一个支持100万数据的排序算法还是很有意义 ...

对于快速排序而言，数据量的大小并不会是导致堆栈溢出的主要原因，而是数据是否是精心设计过的。

而所谓精心设计，是指对某种基准值选择方法而特定设计的数据顺序，通常是针对较普遍的基准值选择的几种方法：选第一个元素、选最后一个元素、选第一个和最后一个以及中间一个这三者中的中间值、随机选择（先随机的将一个元素与第一个元素对调），等。

实际上，一个乱序数组是不太可能造成堆栈溢出的，比如在我的机器上单精度数组最大可申请到10^7 ~ 10^8 之间，如果你愿意的话，可以反复测试下述代码是否会堆栈溢出，呵呵：
说实在的，我很怀疑坛子里有几个人能设计出这样的顺序，嘿嘿~

代码:

Sub TestQuickSortSpeed()
Dim i&, t#, aData!(), arr, nLen&
nLen = 10 ^ 7
ReDim aData(1 To nLen)
Randomize
For i = 1 To UBound(aData)
      aData(i) = Rnd
Next
Debug.Print
t = Timer
arr = aData
Call QuickSort(arr, 1, nLen)
Debug.Print "原始的快速排序："
Debug.Print Format(Timer - t, "0.000 秒")
End Sub
Sub QuickSort(ByRef arr, ByRef nLeft&, ByRef nRight&)
Dim i&, j&, vKey, vSwap
If nLeft >= nRight Then Exit Sub
vKey = arr(nLeft)
i = nLeft + 1: j = nRight
Do
      Do While i <= nRight
         If arr(i) > vKey Then Exit Do
         i = i + 1
      Loop
      Do While j > nLeft
         If arr(j) < vKey Then Exit Do
         j = j - 1
      Loop
      If i >= j Then Exit Do
      vSwap = arr(i): arr(i) = arr(j): arr(j) = vSwap
Loop
If nLeft <> j Then
      vSwap = arr(nLeft): arr(nLeft) = arr(j): arr(j) = vSwap
End If
If nLeft < j Then Call QuickSort(arr, nLeft, j)
If j + 1 < nRight Then Call QuickSort(arr, j + 1, nRight)
End Sub

lee1892 · 发表于 2013-4-24 16:26

liucqa 发表于 2013-4-24 14:12
排序演示：

插入排序演示过程：http://student.zjzk.cn/course_wa ... html/insertsort.htm

http://www.cppblog.com/Chipset/
的博客里看到最可乐的Bogo排序算法：

while (没有排好序)
打乱当前序列的顺序;

复制代码

LOL~~~

liucqa · 发表于 2013-4-25 00:24

本帖最后由 liucqa 于 2013-4-25 00:31 编辑

http://www.doc88.com/p-905591811549.html
有空测试一下这个论文的真假

这有个快速排序比较全的
http://www.cnblogs.com/mfryf/archive/2012/08/06/2625300.html

lee1892 · 发表于 2013-4-25 00:36

liucqa 发表于 2013-4-25 00:24
http://www.doc88.com/p-905591811549.html
有空测试一下这个论文的真假

我建议搞定IntroSort和TimSort，在合适的地方选择结合分配排序加速第一步工作，就完全OK了。

最多练一下上述两个混合排序，结合合并排序，以应付超大规模的数据，必须要用文件作为介质的情况。

当然兴趣所在就是另一回事了{:soso_e113:}

lee1892 · 发表于 2013-4-25 12:08

本帖最后由 lee1892 于 2013-4-25 13:39 编辑

liucqa 发表于 2013-4-24 12:33
搞100万数据测试看看

关于希尔排序不同的步长序列的选择，仅仅考查用时似乎并不是完整的工作

下述代码，在前述基础上：
1、增加了Gonnet & Baeza-Yates于1991年发布的序列
2、对于Ciura，这个是迄今最快的序列，但701以上部分则还处于未知状态，这里用 h(k) = INT(2.25*h(k-1))进行扩展
3、统计了元素移动的次数，以及元素间对比的次数，并分别计算了时间复杂度的增长阶

可以看到，法师改良的前后互质的Sedgewick双公式序列，速度确实快，但移动和对比的次数仍较Ciura序列多。

代码:

Sub TestShellSpeed()
Dim i&, t#, aData!(), arr, j&, sMsg$, aGaps, nLen&
Dim nMov As Currency, nCom As Currency
nLen = 10 ^ 5 * 3 ' <-- 数据数量
ReDim aData(1 To nLen)
Randomize
For i = 1 To UBound(aData)
      aData(i) = Rnd
Next
Debug.Print
Debug.Print "希尔排序中不同步长序列的对比："
Debug.Print "随机单精度数据数量：" & Format(nLen, "#,##")
For i = 0 To 6
      Call GetShellGaps(aGaps, nLen, i, sMsg)
      t = Timer
      arr = aData
      Call ShellSort(arr, aGaps, nMov, nCom)
      Debug.Print sMsg & "：" & Join(aGaps, ", ")
      Debug.Print Format(Timer - t, "用时 0.000 秒"), _
                  Format(nMov, "移动 #,##") & " / N ^ " & Format(Log(nMov) / Log(nLen), "0.000"), _
                  Format(nCom, "比较 #,##") & " / N ^ " & Format(Log(nCom) / Log(nLen), "0.000")
Next
End Sub

Sub ShellSort(ByRef arr, ByRef aGaps, _
            Optional ByRef nMove As Currency, _
            Optional ByRef nCompare As Currency)
Dim i&, j&, vTemp, nGap, nLen&
nLen = UBound(arr)
nMove = 0: nCompare = 0
For Each nGap In aGaps
      For i = nGap + 1 To nLen
         vTemp = arr(i)
         For j = i To nGap + 1 Step nGap * -1
            nCompare = nCompare + 1
            If arr(j - nGap) < vTemp Then Exit For
            arr(j) = arr(j - nGap)
            nMove = nMove + 1
         Next
         arr(j) = vTemp: nMove = nMove + 1
      Next
Next
End Sub

Sub GetShellGaps(ByRef arrGaps As Variant, _
               ByVal nArrLen As Currency, _
               Optional ByVal nGapType As Integer = 0, _
               Optional ByRef sMessage As String = "")
Dim i&, nNum&, aTemp, nCount&
Select Case nGapType
Case 0 ' Ciura\2001
      sMessage = "Ciura 的序列"
      aTemp = Array(1, 4, 10, 23, 57, 132, 301, 701, 1750) ' 按原论文增加1750
      If nArrLen < 2.25 * aTemp(UBound(aTemp)) Then
         For nNum = UBound(aTemp) To 0 Step -1
            If aTemp(nNum) < nArrLen Then Exit For
         Next
      Else
         nNum = UBound(aTemp)
         Do
            nNum = nNum + 1
            If UBound(aTemp) < nNum Then ReDim Preserve aTemp(0 To nNum + 10)
            aTemp(nNum) = Int(aTemp(nNum - 1) * 2.25)
            If aTemp(nNum) > nArrLen Then nNum = nNum - 1: Exit Do
         Loop
      End If
Case 1 ' Tokuda\1992
      sMessage = "Tokuda 的序列"
      ReDim aTemp(0 To 10)
      nNum = 0
      Do
         aTemp(nNum) = Int((9 ^ (nNum + 1) - 4 ^ (nNum + 1)) / (5 * 4 ^ nNum)) + IIf(nNum, 1, 0)
         If aTemp(nNum) > nArrLen Then nNum = nNum - 1: Exit Do
         nNum = nNum + 1
         If UBound(aTemp) < nNum Then ReDim Preserve aTemp(0 To nNum + 10)
      Loop
Case 2 ' Gonnet & Baeza-Yates\1991
      sMessage = "Gonnet & Baeza-Yates 的序列"
      ReDim aTemp(0 To 10)
      nNum = 0: aTemp(nNum) = Int(5 * nArrLen / 11)
      Do
         If aTemp(nNum) <= 1 Then
            aTemp(nNum) = 1
            ReDim Preserve aTemp(0 To nNum)
            arrGaps = aTemp
            Exit Sub
         End If
         nNum = nNum + 1
         If UBound(aTemp) < nNum Then ReDim Preserve aTemp(0 To nNum + 10)
         aTemp(nNum) = Int(5 * aTemp(nNum - 1) / 11)
      Loop
Case 3 ' Sedgewick\1986 双公式
      sMessage = "原本的 Sedgewick 双公式序列"
      ReDim aTemp(0 To 10)
      nNum = 0: nCount = 1
      Do
         aTemp(nNum) = 9 * (4 ^ (nCount - 1) - 2 ^ (nCount - 1)) + 1
         If aTemp(nNum) > nArrLen Then nNum = nNum - 1: Exit Do
         nNum = nNum + 1
         If UBound(aTemp) < nNum Then ReDim Preserve aTemp(0 To nNum + 10)
         aTemp(nNum) = 4 ^ (nCount + 1) - 6 * 2 ^ nCount + 1
         If aTemp(nNum) > nArrLen Then nNum = nNum - 1: Exit Do
         nNum = nNum + 1
         If UBound(aTemp) < nNum Then ReDim Preserve aTemp(0 To nNum + 10)
         nCount = nCount + 1
      Loop
Case 4 ' Sedgewick\1986 单公式
      sMessage = "Sedgewick 单公式序列"
      ReDim aTemp(0 To 10)
      aTemp(0) = 1: nNum = 1
      Do
         aTemp(nNum) = 4 ^ nNum + 3 * 2 ^ (nNum - 1) + 1
         If aTemp(nNum) > nArrLen Then nNum = nNum - 1: Exit Do
         nNum = nNum + 1
         If UBound(aTemp) < nNum Then ReDim Preserve aTemp(0 To nNum + 10)
      Loop
Case 5 ' 基于 Fibonacci
      sMessage = "基于费波那契数列的序列"
      aTemp = Array(1, 9, 34, 182, 835, 4025, 19001, 90358, 428481, 2034035, 9651787, 45806244, 217378076, 1031612713, 2147483647)
      For nNum = UBound(aTemp) To 0 Step -1
         If aTemp(nNum) < nArrLen Then Exit For
      Next
Case 6 ' Sedgewick\1986 双公式法师改良前后互质
      sMessage = "法师改良前后互质的 Sedgewick 双公式序列"
      aTemp = Array(1, 5, 19, 41, 109, 211, 503, 929, 2161, 3907, 8929, 16001, 36293, 64763, 146309, 260609, 587527, 1045055, 2354689, 4188161, 9427969)
      For nNum = UBound(aTemp) To 0 Step -1
         If aTemp(nNum) < nArrLen Then Exit For
      Next
End Select
ReDim arrGaps(0 To nNum)
For i = 0 To nNum
      arrGaps(i) = aTemp(nNum - i)
Next
End Sub

lee1892 · 发表于 2013-4-25 12:13

30万和100万两次运行的结果：

希尔排序中不同步长序列的对比：
随机单精度数据数量：300,000
Ciura 的序列：204585, 90927, 40412, 17961, 7983, 3548, 1577, 701, 301, 132, 57, 23, 10, 4, 1
用时 3.156 秒移动 8,717,408 / N ^ 1.267  比较 8,576,205 / N ^ 1.266
Tokuda 的序列：153401, 68178, 30301, 13467, 5985, 2660, 1182, 525, 233, 103, 46, 20, 9, 4, 1
用时 3.406 秒移动 8,774,041 / N ^ 1.268  比较 8,616,856 / N ^ 1.266
Gonnet & Baeza-Yates 的序列：136363, 61983, 28174, 12806, 5820, 2645, 1202, 546, 248, 112, 50, 22, 10, 4, 1
用时 4.293 秒移动 11,652,160 / N ^ 1.290 比较 11,501,987 / N ^ 1.289
原本的 Sedgewick 双公式序列：260609, 146305, 64769, 36289, 16001, 8929, 3905, 2161, 929, 505, 209, 109, 41, 19, 5, 1
用时 3.516 秒移动 8,942,928 / N ^ 1.269  比较 8,785,233 / N ^ 1.268
Sedgewick 单公式序列：262913, 65921, 16577, 4193, 1073, 281, 77, 23, 8, 1
用时 3.934 秒移动 10,718,795 / N ^ 1.284 比较 10,613,008 / N ^ 1.283
基于费波那契数列的序列：90358, 19001, 4025, 835, 182, 34, 9, 1
用时 4.500 秒移动 13,550,891 / N ^ 1.302 比较 13,438,342 / N ^ 1.301
法师改良前后互质的 Sedgewick 双公式序列：260609, 146309, 64763, 36293, 16001, 8929, 3907, 2161, 929, 503, 211, 109, 41, 19, 5, 1
用时 3.109 秒移动 8,929,300 / N ^ 1.269  比较 8,771,494 / N ^ 1.268

希尔排序中不同步长序列的对比：
随机单精度数据数量：1,000,000
Ciura 的序列：460316, 204585, 90927, 40412, 17961, 7983, 3548, 1577, 701, 301, 132, 57, 23, 10, 4, 1
用时 11.902 秒             移动 32,436,606 / N ^ 1.252 比较 31,935,447 / N ^ 1.251
Tokuda 的序列：776591, 345152, 153401, 68178, 30301, 13467, 5985, 2660, 1182, 525, 233, 103, 46, 20, 9, 4, 1
用时 12.695 秒             移动 32,570,044 / N ^ 1.252 比较 32,098,955 / N ^ 1.251
Gonnet & Baeza-Yates 的序列：454545, 206611, 93914, 42688, 19403, 8819, 4008, 1821, 827, 375, 170, 77, 35, 15, 6, 2, 1
用时 13.012 秒             移动 33,486,493 / N ^ 1.254 比较 32,984,329 / N ^ 1.253
原本的 Sedgewick 双公式序列：587521, 260609, 146305, 64769, 36289, 16001, 8929, 3905, 2161, 929, 505, 209, 109, 41, 19, 5, 1
用时 12.949 秒             移动 33,259,043 / N ^ 1.254 比较 32,743,432 / N ^ 1.253
Sedgewick 单公式序列：262913, 65921, 16577, 4193, 1073, 281, 77, 23, 8, 1
用时 14.852 秒             移动 40,763,755 / N ^ 1.268 比较 40,389,065 / N ^ 1.268
基于费波那契数列的序列：428481, 90358, 19001, 4025, 835, 182, 34, 9, 1
用时 16.945 秒             移动 51,773,670 / N ^ 1.286 比较 51,376,900 / N ^ 1.285
法师改良前后互质的 Sedgewick 双公式序列：587527, 260609, 146309, 64763, 36293, 16001, 8929, 3907, 2161, 929, 503, 211, 109, 41, 19, 5, 1
用时 11.574 秒             移动 33,187,703 / N ^ 1.253 比较 32,671,580 / N ^ 1.252

lee1892 · 发表于 2013-4-25 12:50

内省排序（IntroSort）

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

1、对于元素数量小的源数据（比如32个元素或更少），直接使用插入排序，虽然有着O(n^2)的时间复杂度，但稳定性毋庸置疑；
2、对于更多元素数量，使用三值取中法或是九值取中法的快速排序；
3、采用原地的三分快速排序，小于基准值在左、等于基准值居中、大于基准值在右；
4、对左右两个分区递归的采用上述快速排序；
5、当递归深度大于一定数值时（比如 1.5 * log N），转为堆排序。

以上算法被采用在 Microsoft STL std::sort 中。

		自动登录	找回密码
密码			免费注册

[原创] VBA编程技巧之排序算法初探

点评

点评

最新热点 /1

[原创] VBA编程技巧 之 排序算法初探

点评

点评

最新热点 /1

[原创] VBA编程技巧之排序算法初探