中西排名自定义函数

aoe1981

香川群子 发表于 2014-8-14 18:35
【变量t能不能干脆就用trr(i)代替？】

你自己说呢？

1.     For i = L + h To U
   
2.         t = trr(i)
   
3.         For j = i - h To L Step -h
   
4.             If trr(j) > t Then trr(j + h) = trr(j) Else Exit For
   
5.         Next
   
6.         trr(j + h) = t
   
7.     Next
   

复制代码

　　想到了这样几点：
　　1.If trr(j) > t Then trr(j + h) = trr(j) Else Exit For，排除了相等时做无谓交换的情形；
　　2.trr(j + h) = trr(j)，说明大数往后走；
　　3.外层 i = L + h，里层j = i - h，说明本行与上一行比，所以外层循环的开始为第二行；
　　4.里层循环步长Step -h，说明本行不仅与上一行比，还与前面所有行同一列位置比；
　　（此处：我想到的是，一排数，光靠两两相邻位置的大小比较交换是不能够完全形成从小到大的排序的，如果倒着比较，则最后一个须与前面所有的数比完，倒数第二个数亦要与前面的所有数比完……如此，才能在整个数序列中形成从小到大的排列）
　　5.我一开始的想法是把这个行数据经过分组形成的“矩阵”数据从行与列两个方向进行变量的设计与控制，但这样会有溢出，大量循环内部会有判断……因此，只有想法，并未实施，我首先想确信我了解了您的循环变量控制及比较、排序流程……这个并不易……好在，您的评价由“笨”变成了“基础差”……呵呵，多谢指教与鼓励！

aoe1981

香川群子 发表于 2014-8-14 18:35
【变量t能不能干脆就用trr(i)代替？】

你自己说呢？

　　又想起了第6点，就是您说的这个“基础差”：
　　6.trr(i)还是不能够用位置(i)进行引用的，因为这个位置的元素有可能经过循环已经交换成其他元素了，所以要用t固定下来……

aoe1981

香川群子 发表于 2014-8-14 18:35
【变量t能不能干脆就用trr(i)代替？】

你自己说呢？

　　呃……可能还有第7点吧，也是很迷惑我的地方，倒也正说明了我的基础差：
　　7.就是内层循环结束后的这一句：
　　trr(j + h) = t
　　按理来说应该是：trr(j) = t，但实际这样做是错误的……
　　我想原因是：for循环在最后一次还会增加一个步长，在此处就是-h，所以实际上是多增加了一个步长，所以要减去，其实应该是：trr(j - (-h)) = t……呵呵，我还真是要一点一滴的来……

aoe1981

　　现在，恐怕还有个第8点吧：
　　8.If trr(j) > t Then trr(j + h) = trr(j) Else Exit For之所以碰到trr(j) <= t就退出循环，而不是像上面我在4后括号中所分析的比完前面所有行同一列位置的数，原因是一种累积的效果，因为外层是从近行往远行走，实现了逐步的对大数的沉淀，所以后面的数与上一行的数比较时，其实就相当于同前面所有行同一列位置数字的最大值的比较，所以，如果这个本行数据还要大的话，就没必要再往前面比较了……

aoe1981

1. Option Explicit
   
2. Sub ptpx() '普通排序
   
3. Dim arr, i%, j%, n%, gd, m1&, m2&, xx$, l&, u&
   
4. 'arr = Array(5, 4, 2, 1, 5, 8, 7, 2, 7, 9, 3, 6) '正常随机顺序
   
5. 'arr = Array(9, 8, 7, 7, 6, 5, 5, 4, 3, 2, 2, 1) '极端情况降序
   
6. arr = Array(1, 2, 2, 3, 4, 5, 5, 6, 7, 7, 8, 9) '极端情况升序
   
7. l = LBound(arr): u = UBound(arr): n = u - l + 1
   
8. m1 = 0: m2 = 0
   
9. For i = 0 To n - 2
   
10.     For j = i + 1 To n - 1
    
11.         m2 = m2 + 1 '记录比较次数
    
12.         If arr(j) < arr(i) Then
    
13.             gd = arr(j)
    
14.             arr(j) = arr(i)
    
15.             arr(i) = gd
    
16.             m1 = m1 + 1 '记录交换次数
    
17.         End If
    
18.     Next j
    
19. Next i
    
20. For i = 0 To n - 1
    
21.     xx = xx & arr(i) & "，"
    
22. Next i
    
23. MsgBox "排序结果：" & Chr(10) & Left(xx, Len(xx) - 1) & Chr(10) _
    
24. & "共比较" & m2 & "次，相当于数据个数" & n & "的" & Format(m2 / n, "0.0000") & "倍。" & Chr(10) _
    
25. & "共交换" & m1 & "次，相当于数据个数" & n & "的" & Format(m1 / n, "0.0000") & "倍。", , "友情提示"
    
26. End Sub
    
27. Sub sheelpx() '希尔排序
    
28. Dim arr, i%, j%, n%, gd, m1&, m2&, xx$, h&, l&, u&
    
29. 'arr = Array(5, 4, 2, 1, 5, 8, 7, 2, 7, 9, 3, 6) '正常随机顺序
    
30. 'arr = Array(9, 8, 7, 7, 6, 5, 5, 4, 3, 2, 2, 1) '极端情况降序
    
31. arr = Array(1, 2, 2, 3, 4, 5, 5, 6, 7, 7, 8, 9) '极端情况升序
    
32. l = LBound(arr): u = UBound(arr): n = u - l + 1
    
33. m1 = 0: m2 = 0: h = n
    
34. Do
    
35.     h = h \ 2
    
36.     For i = l + h To u
    
37.         gd = arr(i)
    
38.         For j = i - h To l Step -h
    
39.             m2 = m2 + 1 '记录比较次数
    
40.             If arr(j) > gd Then
    
41.                 arr(j + h) = arr(j)
    
42.                 m1 = m1 + 1 '记录交换次数
    
43.             Else
    
44.                 Exit For
    
45.             End If
    
46.         Next j
    
47.         arr(j + h) = gd
    
48.     Next i
    
49.     Debug.Print h
    
50. Loop Until h = 1
    
51. For i = 0 To n - 1
    
52.     xx = xx & arr(i) & "，"
    
53. Next i
    
54. MsgBox "排序结果：" & Chr(10) & Left(xx, Len(xx) - 1) & Chr(10) _
    
55. & "共比较" & m2 & "次，相当于数据个数" & n & "的" & Format(m2 / n, "0.0000") & "倍。" & Chr(10) _
    
56. & "共交换" & m1 & "次，相当于数据个数" & n & "的" & Format(m1 / n, "0.0000") & "倍。", , "友情提示"
    
57. End Sub
    

复制代码

这是我参照写的对比测试代码。

aoe1981

　　

1. arr = Array(5, 4, 2, 1, 5, 8, 7, 2, 7, 9, 3, 6) '正常随机顺序

复制代码

　　对比测试图片如下：
　　普通排序：
　　
　　希尔排序：
　　

aoe1981

1. arr = Array(9, 8, 7, 7, 6, 5, 5, 4, 3, 2, 2, 1) '极端情况降序

复制代码

　　对比测试图片如下：
　　普通排序：
　　
　　希尔排序：
　　

aoe1981

1. arr = Array(1, 2, 2, 3, 4, 5, 5, 6, 7, 7, 8, 9) '极端情况升序

复制代码

　　对比测试图片如下：
　　普通排序：
　　
　　希尔排序：
　　

aoe1981

　　最后对上面3楼做个小结：
　　
　　可见，希尔排序确实在多种情况下优于普通排序法。
　　注：我的希尔序列首次为数据总个数n的一半即：n\2，然后再为上一希尔序列数字的一半即：h\2……

aoe1981

aoe1981 发表于 2014-8-14 20:40
　　现在，恐怕还有个第8点吧：
　　8.If trr(j) > t Then trr(j + h) = trr(j) Else Exit For之所以碰到t ...

　　补充一个第9点：
　　核心部分代码改成以下时也会出错：

1.     For i = L + h To U
   
2.         t = trr(i)
   
3.         For j = i - h To L Step -h
   
4.             If trr(j) > t Then trr(j + h) = trr(j) Else GoTo 100
   
5.         Next
   
6.         trr(j + h) = t
   
7. 100:
   
8.     Next i
   

复制代码

　　因为跳出内循环的并非都是一次交换没有做的情况，也有可能是做了1次或几次交换后，在接下来的比较中不符合条件时退出的，这时，也跳过了trr(j + h) = t，会导致交换没有完成……