VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)

VB爱好者乐园(VBGood)

 找回密码
 立即注册
搜索
查看: 9332|回复: 24

VB业界最快的Sorting大比拼

[复制链接]
发表于 2015-5-20 17:42:43 | 显示全部楼层 |阅读模式
VC中的qsort源代码翻译成VB的了”中的ISort2最慢?多十倍时间也不止,我的测试有问题??? (测试环境:Win7,32Bit,4G)

附件中的代码是大名鼎鼎的VBRichClient的作者Schmidt编写。

Sorting Result

Sorting Result

DualPivotQuickSortCountComparisons.zip

9.55 KB, 阅读权限: 40, 下载次数: 14

VB Sort Class

点评

Jen
我没有说QuickSort C是最快啊,只说很慢。。。  发表于 2015-5-25 13:19
我可没说我那是业界最快的排序算法,是你自己在YY  发表于 2015-5-24 11:37
发表于 2015-5-21 22:58:36 | 显示全部楼层
本帖最后由 仙剑魔 于 2015-5-21 23:02 编辑

C那个是没办法的,比较函数回调,想不慢都不行
你帖子的标题不太准确
严格来讲是QS(快排)
对long类型的数据来讲,最快的排序是基数排序

我测了下这个2路的快排速度还可以
如果改成3路的,估计就是最快的了


  1. Public Sub QSort(ByRef key_arr() As Long, L As Long, R As Long)
  2.     Dim i As Long, j As Long
  3.     Dim x As Long, Swap As Long
  4.     Const k As Long = 60
  5.     If R - L <= k Then
  6.         For i = L + 1 To R
  7.             x = key_arr(i)
  8.             
  9.             For j = i - 1 To L Step -1
  10.                 If key_arr(j) <= x Then Exit For
  11.                 key_arr(j + 1) = key_arr(j)
  12.             Next
  13.             key_arr(j + 1) = x
  14.         Next
  15.     Else
  16.         x = key_arr((L + R) \ 2)
  17.         i = L
  18.         j = R
  19.         Do While i <= j
  20.             Do While key_arr(i) < x
  21.                 i = i + 1
  22.             Loop
  23.             
  24.             Do While key_arr(j) > x
  25.                 j = j - 1
  26.             Loop
  27.            
  28.             If i <= j Then
  29.                 Swap = key_arr(i)
  30.                 key_arr(i) = key_arr(j)
  31.                 key_arr(j) = Swap
  32.                 i = i + 1
  33.                 j = j - 1
  34.             End If
  35.         Loop

  36.         '递归方法
  37.         If (L < j) Then Call QSort(key_arr, L, j)
  38.         If (i < R) Then Call QSort(key_arr, i, R)
  39.     End If
  40. End Sub



复制代码

点评

消除递归,使用循环方法,在大数据下应该会快不少  发表于 2015-5-23 16:18
Jen
你的qSort是比较快。在大数据量下大慨是1.5-2倍于其他QuichSort算法。  发表于 2015-5-22 09:14
Jen
你说的对,标题不确切。可是不能修改了,另外,发的版面也不对。谢谢纠正。  发表于 2015-5-22 08:36
回复 支持 反对

使用道具 举报

发表于 2015-5-22 03:50:52 | 显示全部楼层
修改掉我剔除看不懂的那些部分,大大提速。比本帖的应该会快8-10倍
没有理解作者的原用意,原来的用法比较复杂,我看不懂,所有直接把函数写死了
  1. Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  2. Private Declare Function LoadLibrary Lib "kernel32.dll" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
  3. Private Declare Function FreeLibrary Lib "kernel32.dll" (ByVal hLibModule As Long) As Long
  4. Private Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long

  5. Private m_bCode(42) As Byte, m_hMod As Long, m_lpFunc As Long

  6. Friend Sub QuickSort(idxArray() As Long, ByVal nStart As Long, ByVal nEnd As Long)
  7. If nEnd - nStart <= 1 Then Exit Sub
  8. If m_lpFunc Then
  9.     CallWindowProc VarPtr(m_bCode(0)), VarPtr(idxArray(nStart)), nEnd - nStart + 1, m_lpFunc, 0
  10.     Exit Sub
  11. End If
  12. End Sub

  13. Private Sub Class_Initialize()
  14. Dim s As String, m As Long, i As Long
  15. m_hMod = LoadLibrary("msvcrt.dll")
  16. m_lpFunc = GetProcAddress(m_hMod, "qsort")
  17. s = "89E0E800000000830424156A04FF7008" + _
  18.     "FF7004FF500C83C410C21000" + _
  19.     "8B4C24048B4424088B108B0129D0C3"
  20. m = Len(s) \ 2
  21. For i = 0 To m - 1
  22.     m_bCode(i) = CLng("&H" + Mid(s, i + i + 1, 2))
  23. Next i
  24. End Sub

  25. Private Sub Class_Terminate()
  26. FreeLibrary m_hMod
  27. End Sub
复制代码

点评

Jen
你的qSort是比较快。在大数据量下大慨是1.5-2倍。  发表于 2015-5-22 09:11
Jen
难以置信!你修改后速度加快几十倍,比其他的QuickSort都快近10倍。等一下我再试试看排序一下String。  发表于 2015-5-22 08:34
回复 支持 反对

使用道具 举报

 楼主| 发表于 2015-5-22 09:07:54 | 显示全部楼层
本帖最后由 Jen 于 2015-5-22 09:13 编辑
loquat 发表于 2015-5-22 03:50
修改掉我剔除看不懂的那些部分,大大提速。比本帖的应该会快8-10倍
没有理解作者的原用意,原来的用法比较 ...


由于此方法没有Expose比较的语句(例如key_arr(j) <= x之类的语句),我还真地不知道怎样用这个编码对字符串数组排序(Ascending or Descending)。请指教。
我的应用是允许CustomSor和Multi-Sort。对象是表格类型的字符串数组。例如HFlexGrid.

编辑:在大数据量下(例子中的2000000),好像速度快速的下降。
回复 支持 反对

使用道具 举报

发表于 2015-5-22 11:22:58 | 显示全部楼层
仙剑魔 发表于 2015-5-21 22:58
C那个是没办法的,比较函数回调,想不慢都不行
你帖子的标题不太准确
严格来讲是QS(快排)

我的确在等你再完善这个算法,我坚信这个算法在纯VB还可以优化。

点评

看我8楼发的  发表于 2015-5-23 20:29
尝试一个3路的算法,包含大,小,等于 3种关系  发表于 2015-5-23 19:45
现在这个快排是2路的,只有大和小两种关系  发表于 2015-5-23 19:45
是可以,比如针对最后两种数据的优化  发表于 2015-5-23 19:45
回复 支持 反对

使用道具 举报

发表于 2015-5-22 11:36:34 | 显示全部楼层
Jen 发表于 2015-5-22 09:07
由于此方法没有Expose比较的语句(例如key_arr(j)

我是初学者,还没有用到您说的这些东西,我目前只需要数字排序。
而如果用到字符串排序,我也倾向于用指针操作数组的下标 。虽然我还不会。
回复 支持 反对

使用道具 举报

发表于 2015-5-22 12:09:39 | 显示全部楼层
话说可以多线程 多核进行排序么。否则性能差距太大了。

点评

那也不能用VB6来搞啊,要不然就是大炮打蚊子  发表于 2015-5-24 11:40
回复 支持 反对

使用道具 举报

发表于 2015-5-23 20:29:20 | 显示全部楼层
优化了后两种数据的排序



  1. Public Sub QSort2(ByRef key_arr() As Long, L As Long, R As Long)
  2.     Dim i As Long, j As Long
  3.     Dim x As Long, Swap As Long
  4.     Const k As Long = 60
  5.     If R - L <= k Then
  6.         For i = L + 1 To R
  7.             x = key_arr(i)
  8.                
  9.             For j = i - 1 To L Step -1
  10.                 If key_arr(j) <= x Then Exit For
  11.                 key_arr(j + 1) = key_arr(j)
  12.             Next
  13.             key_arr(j + 1) = x
  14.         Next
  15.     Else
  16.         x = key_arr((L + R) \ 2)
  17.         i = L
  18.         j = R
  19.         Do While i <= j
  20.             Do While key_arr(i) < x
  21.                 i = i + 1
  22.             Loop
  23.             
  24.             Do While key_arr(j) > x
  25.                 j = j - 1
  26.             Loop
  27.            
  28.             If i <= j Then
  29.                 Swap = key_arr(i)
  30.                 key_arr(i) = key_arr(j)
  31.                 key_arr(j) = Swap
  32.                 i = i + 1
  33.                 j = j - 1
  34.             End If
  35.         Loop

  36.         '递归方法
  37.         If L < j Then
  38.             Do While key_arr(j) = x
  39.                 j = j - 1
  40.                 If j = L Then Exit Do
  41.             Loop
  42.             Call QSort2(key_arr, L, j)
  43.         End If
  44.         If i < R Then
  45.             Do While key_arr(i) = x
  46.                 i = i + 1
  47.                 If i = R Then Exit Do
  48.             Loop
  49.             Call QSort2(key_arr, i, R)
  50.         End If
  51.     End If
  52. End Sub


复制代码
回复 支持 反对

使用道具 举报

发表于 2015-5-24 08:22:41 | 显示全部楼层
仙剑魔 发表于 2015-5-23 20:29
优化了后两种数据的排序

但是这个对于随机数据降低得很明显,降低了1倍的样子。。。

点评

我本地没出现你说的这个现象。。。而且就算降低也不可能有1倍这么夸张,理论上不可能啊  发表于 2015-5-24 19:58
回复 支持 反对

使用道具 举报

发表于 2015-5-24 10:21:02 | 显示全部楼层
qsort和qsort_s
https://msdn.microsoft.com/en-us/library/zes7xw0h.aspx
https://msdn.microsoft.com/en-us/library/4xc60xas.aspx
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

文字版|手机版|小黑屋|VBGood  

GMT+8, 2023-2-3 15:15

VB爱好者乐园(VBGood)
快速回复 返回顶部 返回列表