ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
楼主: lee1892

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

  [复制链接]

TA的精华主题

TA的得分主题

 楼主| 发表于 2013-4-24 12:49 | 显示全部楼层
本帖已被收录到知识树中,索引项:排序
liucqa 发表于 2013-4-24 12:33
搞100万数据测试看看

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

TA的精华主题

TA的得分主题

发表于 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左右,也许对普通用户来说用哪个序列都无所谓的吧。

你有空可以测试一下。

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

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


TA的精华主题

TA的得分主题

发表于 2013-4-24 14:12 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 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

点评

不用怀疑啦。我就设计过。3500+个数据,在xp+2003里就溢出了。。我的算法在坛子里很一般哦。  发表于 2014-4-2 12:29

TA的精华主题

TA的得分主题

 楼主| 发表于 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排序算法:
  1. while (没有排好序)
  2. 打乱当前序列的顺序;
复制代码
LOL~~~

点评

我喜欢  发表于 2013-4-24 18:54

TA的精华主题

TA的得分主题

发表于 2013-4-25 00:24 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖最后由 liucqa 于 2013-4-25 00:31 编辑

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



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

TA的精华主题

TA的得分主题

 楼主| 发表于 2013-4-25 00:36 | 显示全部楼层
liucqa 发表于 2013-4-25 00:24
http://www.doc88.com/p-905591811549.html
有空测试一下这个论文的真假

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

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

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

TA的精华主题

TA的得分主题

 楼主| 发表于 2013-4-25 12:08 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖最后由 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


TA的精华主题

TA的得分主题

 楼主| 发表于 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

TA的精华主题

TA的得分主题

 楼主| 发表于 2013-4-25 12:50 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
内省排序(IntroSort)

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

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

以上算法被采用在 Microsoft STL std::sort 中。
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-6-23 21:43 , Processed in 0.049485 second(s), 7 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表