VBGood网站全文搜索 Google

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

VB爱好者乐园(VBGood)

 找回密码
 立即注册
搜索
12
返回列表 发新帖
楼主: loquat

找到3个比较有效率的快速排序算法,求修改

[复制链接]
 楼主| 发表于 2015-4-27 14:47:39 | 显示全部楼层
仙剑魔大侠的这个还真是快,竟然比原来他们说的那个还快很多。
按道理说他们原来的思路应该没有问题啊,当递归到R-L差值小于一定的数的时候就采用插入排序。
上述那几个优化,按道理也应该是有意义的啊,奇怪。。。

点评

对VB而言,简捷的代码通常会跑得比较快  发表于 2015-4-27 17:10
那个优化的思路是没错,但是对VB不太适用,因为VB没有内联展开,如果是VC的话是有效果的  发表于 2015-4-27 16:59
回复 支持 反对

使用道具 举报

 楼主| 发表于 2015-4-27 15:43:21 | 显示全部楼层
本帖最后由 loquat 于 2015-4-27 15:44 编辑
仙剑魔 发表于 2015-4-27 12:58
代码2那个栈模拟在VB里没有意义
因为push/pop被搞成了函数,调用反而会消耗时间
一般情况下递归的快排已经 ...


发现您这个代码排序结果有问题,详见如下代码

Sub test1()
Dim n() As Long
m = 1048576
ReDim n(1 To m)
For i = 1 To m
    n(i) = 10000 * Rnd
Next
t = Timer
StartSort n
Debug.Print Timer - t
For i = 1 To m - 1
    iSum = iSum - (n(i) > n(i + 1))  
Next
Debug.Print iSum  '如果iSum不等于0,证明算法有误
End Sub
回复 支持 反对

使用道具 举报

发表于 2015-4-27 16:57:58 | 显示全部楼层
loquat 发表于 2015-4-27 15:43
发现您这个代码排序结果有问题,详见如下代码

Sub test1()

这里你替换一下,我抄的时候经常会忘记改

  1.             If x > i Then
  2.                 Swap = key_arr(i)
  3.                 key_arr(i) = key_arr(x)
  4.                 key_arr(x) = Swap
  5.             End If

复制代码
回复 支持 反对

使用道具 举报

 楼主| 发表于 2015-4-28 10:17:37 | 显示全部楼层
本帖最后由 loquat 于 2015-4-28 10:40 编辑
仙剑魔 发表于 2015-4-27 16:57
这里你替换一下,我抄的时候经常会忘记改


之前他那个代码里是因为有两个参数声明错了,所有效率略低,现在我电脑上比你这个好像快一点点,不过相差仅仅10%
Sub test()
Dim n() As Long
m = 1048576
ReDim n(1 To m)
For i = 1 To m
    n(i) = 10000 * Rnd
Next
Dim a() As Long, b() As Long, c() As Long
a = n: b = n: c = n
t = Timer
QuickSort_A1 a, LBound(a), UBound(a)  '对数组a排序
Debug.Print Timer - t
iSum = 0
For i = 1 To m - 1
    iSum = iSum - (a(i) > a(i + 1))
Next
Debug.Print iSum  '如果iSum不等于0,证明算法有误
t = Timer
QuickSort b           '对数组b排序
Debug.Print Timer - t
jSum = 0
For i = 1 To m - 1
    jSum = jSum - (b(i) > b(i + 1))
Next
Debug.Print jSum  '如果iSum不等于0,证明算法有误
End Sub
  1. Public Sub QuickSort(ByRef vArray() As Long)
  2.     Dim iLow As Long
  3.     Dim iHi As Long
  4.    
  5.     '//get range of array
  6.     iLow = LBound(vArray) '//Low bound
  7.     iHi = UBound(vArray)  '//High bound
  8.    
  9.     '//use STACK, not RECURSION
  10.     StartSort vArray(), iLow, iHi   '//call the procedure
  11.    
  12. End Sub

  13. Private Sub StartSort(ByRef key_arr() As Long, L As Long, R As Long)
  14.     Dim i As Long, j As Long
  15.     Dim x As Long, Swap As Long
  16.     If R - L <= 16 Then
  17.         For i = L To R
  18.             x = i
  19.             For j = i + 1 To R
  20.                 If key_arr(j) < key_arr(x) Then
  21.                     x = j
  22.                 End If
  23.             Next j
  24.             
  25.             If x > i Then
  26.                 Swap = key_arr(i)
  27.                 key_arr(i) = key_arr(x)
  28.                 key_arr(x) = Swap
  29.             End If
  30.         Next i
  31.     Else
  32.         x = key_arr((L + R) \ 2)
  33.         i = L
  34.         j = R
  35.         Do While i <= j
  36.             Do While key_arr(i) < x
  37.                 i = i + 1
  38.             Loop
  39.             
  40.             Do While key_arr(j) > x
  41.                 j = j - 1
  42.             Loop
  43.            
  44.             If i <= j Then
  45.                 Swap = key_arr(i)
  46.                 key_arr(i) = key_arr(j)
  47.                 key_arr(j) = Swap
  48.                 i = i + 1
  49.                 j = j - 1
  50.             End If
  51.         Loop

  52.         '递归方法
  53.         If (L < j) Then Call StartSort(key_arr, L, j)
  54.         If (i < R) Then Call StartSort(key_arr, i, R)
  55.     End If
  56. End Sub

  57. Public Sub QuickSort_A1(ByRef key_arr() As Long, L As Long, R As Long)
  58. Dim i As Long, j As Long, a As Long, b As Long, Mid As Long, offset As Long
  59. Dim Pivot As Long, Swap As Long
  60.     If R - L <= 60 Then
  61.         For offset = 0 To 18
  62.             For i = L + offset To R Step 19
  63.                 Swap = key_arr(i)
  64.                 For j = i - 19 To L + offset Step -19
  65.                     If Swap < key_arr(j) Then
  66.                         key_arr(j + 19) = key_arr(j)
  67.                         key_arr(j) = Swap
  68.                     Else
  69.                         Exit For
  70.                     End If
  71.                 Next j
  72.             Next i
  73.         Next offset
  74.         
  75.         For offset = 0 To 4
  76.             For i = L + offset To R Step 5
  77.                 Swap = key_arr(i)
  78.                 For j = i - 5 To L + offset Step -5
  79.                     If Swap < key_arr(j) Then
  80.                         key_arr(j + 5) = key_arr(j)
  81.                         key_arr(j) = Swap
  82.                     Else
  83.                         Exit For
  84.                     End If
  85.                 Next j
  86.             Next i
  87.         Next offset
  88.         
  89.         For i = L + 1 To R
  90.             Swap = key_arr(i)
  91.             For j = i - 1 To L Step -1
  92.                 If Swap < key_arr(j) Then
  93.                     key_arr(j + 1) = key_arr(j)
  94.                     key_arr(j) = Swap
  95.                 Else
  96.                     Exit For
  97.                 End If
  98.             Next j
  99.         Next i
  100.     Else
  101.    
  102.         Mid = L + 1 + Int(Rnd * (R - L - 1))
  103. '        Mid = (L + R) / 2
  104.         If key_arr(L) > key_arr(R) Then
  105.             Swap = key_arr(R)
  106.             key_arr(R) = key_arr(L)
  107.             key_arr(L) = Swap
  108.         End If
  109.         If key_arr(Mid) > key_arr(R) Then
  110.             Swap = key_arr(R)
  111.             key_arr(R) = key_arr(Mid)
  112.             key_arr(Mid) = Swap
  113.         End If
  114.         If key_arr(L) > key_arr(Mid) Then
  115.             Swap = key_arr(L)
  116.             key_arr(L) = key_arr(Mid)
  117.             key_arr(Mid) = Swap
  118.         End If
  119.         
  120.         Pivot = key_arr(Mid)
  121.         key_arr(Mid) = key_arr(R - 1)
  122.         key_arr(R - 1) = Pivot
  123.         i = L + 1
  124.         j = R - 2
  125.         While (i < j)
  126.             For i = i To R
  127.                 If key_arr(i) >= Pivot Then Exit For
  128.             Next i
  129.             For j = j To L Step -1
  130.                 If key_arr(j) <= Pivot Then Exit For
  131.             Next j
  132.             If (i < j) Then
  133.                 Swap = key_arr(i)
  134.                 key_arr(i) = key_arr(j)
  135.                 key_arr(j) = Swap
  136.                 i = i + 1
  137.                 j = j - 1
  138.             End If
  139.         Wend

  140.         For a = j To L Step -1
  141.             If key_arr(a) < Pivot Then Exit For
  142.         Next a
  143.         For b = i To R
  144.             If key_arr(b) > Pivot Then Exit For
  145.         Next b
  146.         
  147.         '递归方法
  148.         If (L < a) Then Call QuickSort_A1(key_arr, L, a)
  149.         If (b < R) Then Call QuickSort_A1(key_arr, b, R)
  150.         
  151.     End If
  152. End Sub
复制代码
回复 支持 反对

使用道具 举报

发表于 2015-4-28 13:56:10 | 显示全部楼层
loquat 发表于 2015-4-28 10:17
之前他那个代码里是因为有两个参数声明错了,所有效率略低,现在我电脑上比你这个好像快一点点,不过相 ...

我换了个插入排序
你测试看看速度和正确性


  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.         If (L < j) Then Call StartSort(key_arr, L, j)
  38.         If (i < R) Then Call StartSort(key_arr, i, R)
  39.     End If
  40. End Sub

复制代码
回复 支持 反对

使用道具 举报

 楼主| 发表于 2015-4-28 15:22:00 | 显示全部楼层
仙剑魔 发表于 2015-4-28 13:56
我换了个插入排序
你测试看看速度和正确性

连续测试5次,你的算法略胜6%
0.8710938
0.8203125
0.8789063
0.8359375
0.8710938
0.8203125
0.8710938
0.8125
0.8789063
0.8125

点评

看来插入排序在这个环境里效率更高...  发表于 2015-4-28 16:31
回复 支持 反对

使用道具 举报

 楼主| 发表于 2015-4-28 15:24:24 | 显示全部楼层
本帖最后由 loquat 于 2015-4-28 15:32 编辑

下面开始测试string类型,各自算法的效率。。。
突然发现竟然不知道怎么用于字符串排序。。。

点评

string最好是写个指针交换的函数,不然swap效率很低...  发表于 2015-4-28 16:33
类型从long换成string而已...  发表于 2015-4-28 16:32
回复 支持 反对

使用道具 举报

 楼主| 发表于 2015-4-28 16:33:32 | 显示全部楼层
仙剑魔 发表于 2015-4-28 13:56
我换了个插入排序
你测试看看速度和正确性

在VB6下我也测试过了,大体都差不多。
主要问题是我还没有接触到字符串排序的案例。。。

点评

目前这个只要替换类型也可以凑合用;真要速度快的字符串的排序需要加别的处理  发表于 2015-4-29 09:06
回复 支持 反对

使用道具 举报

发表于 2015-5-2 04:51:05 来自手机 | 显示全部楼层
字符串中文 按拼音排序 不知如何搞?

点评

直接比大小就是按拼音的,除非是多音字  发表于 2015-5-2 10:27
回复 支持 反对

使用道具 举报

发表于 2015-5-6 23:05:01 来自手机 | 显示全部楼层
本帖最后由 menglv 于 2015-5-7 14:40 编辑

我想可以看看我的这个帖子:
http://www.vbgood.com/forum.php?mod=viewthread&tid=115369
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2022-7-5 11:41

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