有史以来最快的希尔排序 - 比历史贴快10倍，比Excel排序更快 - 兼论堆排序和快速排序

Zamyi

loquat 发表于 2015-4-28 08:45
测试环境，win7 32位 i5-3470 3.2GHz, 4G内存
楼上代码本人电脑上的测试结果：
1.425781

法师代码中：Dim Pivot&, Swap&
注意红色变量类型。改后相差很小。但如果数据源改为：
For i = 1 To n
  b(i) = Rnd * n / 1000
Next

loquat

Zamyi 发表于 2015-4-28 09:33
法师代码中：Dim Pivot&, Swap&
注意红色变量类型。改后相差很小。但如果数据源改为：
For i = 1 To n
...

额，这两个声明好像是我自己修改了的

的确这个效率是目前效率最高的了

loquat

Zamyi 发表于 2015-4-28 09:33
法师代码中：Dim Pivot&, Swap&
注意红色变量类型。改后相差很小。但如果数据源改为：
For i = 1 To n
...

这个还能再提高6%

1. Private Sub StartSort(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.         '递归方法
    
38.         If (L < j) Then Call StartSort(key_arr, L, j)
    
39.         If (i < R) Then Call StartSort(key_arr, i, R)
    
40.     End If
    
41. End Sub

复制代码

loquat

好吧，发出来，应该已经是VB的极限速度了。
里面还有个for循环如果用汇编做应该还能有提升。

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. 
   
6. Private m_bCode(42) As Byte, m_hMod As Long, m_lpFunc As Long
   
7. 
   
8. Friend Sub QuickSort(idxArray() As Long, ByVal nStart As Long, ByVal nEnd As Long)
   
9. If nEnd - nStart <= 1 Then Exit Sub
   
10. If m_lpFunc Then
    
11.     CallWindowProc VarPtr(m_bCode(0)), VarPtr(idxArray(nStart)), nEnd - nStart + 1, m_lpFunc, 0
    
12.     Exit Sub
    
13. End If
    
14. End Sub
    
15. 
    
16. Private Sub Class_Initialize()
    
17. Dim s As String, m As Long, i As Long
    
18. m_hMod = LoadLibrary("msvcrt.dll")
    
19. m_lpFunc = GetProcAddress(m_hMod, "qsort")
    
20. s = "89E0E800000000830424156A04FF7008" + _
    
21.     "FF7004FF500C83C410C21000" + _
    
22.     "8B4C24048B4424088B108B0129D0C3"
    
23. m = Len(s) \ 2
    
24. For i = 0 To m - 1
    
25.     m_bCode(i) = Val("&H" + Mid(s, i + i + 1, 2))
    
26. Next i
    
27. End Sub
    
28. 
    
29. Private Sub Class_Terminate()
    
30. FreeLibrary m_hMod
    
31. End Sub

复制代码

loquat

Val改成CLng还能提高一点点。。。

jsgj2023

感谢分享,好好学习!

tangwb123

谢谢分享！

djsjcn

谢谢分享！

aoe1981

“堆排序最大特点：可以迅速取出最大值（或者最小值），如果是求100万元素的前1万个，那么堆排序肯定是最快的。”

“作为一般而言最高速的排序算法，快速排序既让人高兴，又让人不放心”

……

大师神帖，以前只知收藏，未曾研读，如今读来，深有同感，再次学习了。

aoe1981

Zamyi 发表于 2015-4-27 16:53
法师的几个所谓快速排序实质上是混合排序，用快速排序+（希尔、插入、冒泡）作为排序，它的优化体现在以下 ...

哈哈，“三数取中法”，我参照写的快排也是这么个做法。