快速排序代码比拼

loquat

应该已经接近极限了吧，100w整数100毫秒

loquat

将Val改为CLng仍能提升一点点

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

复制代码

loquat

以上函数是IDE下最快的。
一下函数是目前我见过的编译后最快的。

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

复制代码

loquat

基本跟C里的速度持平了。。。

lovemh1987

loquat 发表于 2015-6-7 10:02
以上函数是IDE下最快的。
一下函数是目前我见过的编译后最快的。

快速排序法标记