[开_86] 比速度,看谁的程序更快.

香川群子

既然42楼代码有速度优势，那就说还是值得研究。


等我有空，抽时间研究一下代码的思路原理，看看能否debug掉错误。

如果算法有值得借鉴的地方，或许可以让我的递归速度也提高一下。


…………
不过话又说回来，3.48秒的速度，已经不如我的递归3和递归4大约 2.68秒的速度快了。

彭希仁

{:soso_e113:}很久之前写的代码了,正是因为这题,我才开始学习递归的.呵呵

香川群子

彭希仁 发表于 2012-10-8 14:21
很久之前写的代码了,正是因为这题,我才开始学习递归的.呵呵

哈哈，那我是大约去年年底开始，看了你的漫谈递归才开始学习递归的。

所以我的递归代码结构，就是完全抄袭您的代码。

只不过在算法上，自己做了些改进。

香川群子

之前解决问题，都是直接用VBA数组+for……next 或 do……loop循环处理。

现在才发现递归很好玩的。


……
有个hanoi塔的递归，当时看了还是不太能理解。

有空要再捡起来看看哦……


Hanoi.zip (35.03 KB, 下载次数: 88)

2012-10-8 14:40 上传

点击文件名下载附件

彭希仁

Dim arr, z As Long, jj As Long, d, j%
Sub peng()
    Set d = CreateObject("Scripting.Dictionary")
    jj = 0
    Open "d:\peng.txt" For Output As #1
    Columns("A:A").Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo
    j = [A65536].End(xlUp).Row
    arr = Range("A1:A" & j)
    z = Cells(1, 2)
    j = j - 1
    aa = Timer
    For i = 1 To UBound(arr)  '定位
        d(arr(i, 1)) = i
    Next i
    Call xi("", 1, 0)
    Close #1
    MsgBox "找到 " & jj & " 个解! 花费" & Format(Timer - aa, "0.00" & "保存在D:\peng.txt") & "秒"
End Sub
Sub xi(a, X As Long, Y As Long)
    If Y + arr(X, 1) + arr(X + 1, 1) >= z Then    '最后一个数直接定位
        If d.Exists(z - Y) Then
            jj = jj + 1
            'Print #1, z - Y & a
        End If
        If Y + arr(X, 1) + arr(X + 1, 1) = z Then    '这里如果提前算好,会有一点点的提升空间
            jj = jj + 1
            'Print #1, arr(X + 1, 1) & "+" & arr(X, 1) & a
        End If
        Exit Sub
    End If
    If X > j Then Exit Sub    '递归层数
    Call xi("+" & arr(X, 1) & a, X + 1, Y + arr(X, 1))    '
    Call xi(a, X + 1, Y)
End Sub

这样会快很多,不过任何递归都可以转变为非递归,那样速度还有20%的提升空间.

香川群子

彭希仁 发表于 2012-10-8 15:41
Public arr, z As Long, jj As Long, d, j%
Sub peng()
    Set d = CreateObject("Scripting.Dictionary ...

我试过了，速度并没有明显提高，
计算1-100求和=100时，比42楼代码略快一些，但不如我的递归代码快。
计算1-20求和=88时耗时0.648秒
计算1-99奇数，求和=150时耗时0.57秒

但是，当计算数据量小的随机整数时，耗时很多要2秒多。
如计算： 2,3,8,11,13,15,21,24,30,31,36,38,47,56,58,65,68,70,71,75 共20个数求和=740（第2个开始所有元素）时，
耗时2.2秒。

而降序递归法只要0秒。

可见，该算法本身还不是很好。

彭希仁

我电脑上测试,速度是有明显提升的.

香川群子

彭希仁 发表于 2012-10-8 14:21
很久之前写的代码了,正是因为这题,我才开始学习递归的.呵呵

呵呵，我是9月28日收到您的站内短信才开始关注这个题目的。

看来提升速度，改变算法才是关键。

彭希仁

其这我们可以反其道而行之,对数据真接进行拆分.

彭希仁

Dim arr, z As Long, jj As Long, d, j%, xx
Sub peng()
    Set d = CreateObject("Scripting.Dictionary")
    jj = 0
    Open "d:\peng.txt" For Output As #1
    Columns("A:A").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo
    j = [A65536].End(xlUp).Row
    arr = Range("A1:B" & j)
    z = Cells(1, 2)
    For i = 1 To UBound(arr) - 1    '定位
        d(arr(i, 1)) = i
        arr(i, 2) = arr(i, 1) + arr(i + 1, 1)
    Next i
    d(arr(j, 2)) = arr(i, 1)
    d(arr(j, 1)) = i
    j = j - 1
    aa = Timer
    Call xi("", 1, 0)
    MsgBox "找到 " & jj & " 个解! 花费" & Format(Timer - aa, "0.00" & "保存在D:\peng.txt") & "秒"
    Close #1
End Sub
Sub xi(a, X As Long, Y As Long)
    If Y + arr(X, 2) >= z Then    '最后一个数直接定位
        If d.Exists(z - Y) Then
            jj = jj + 1
            '     Print #1, z - Y & a
        End If
        If Y + arr(X, 2) = z Then
            jj = jj + 1
            '        Print #1, arr(X + 1, 1) & "+" & arr(X, 1) & a
        End If
        Exit Sub
    End If
    If X > j Then Exit Sub    '递归层数
    Call xi("+" & arr(X, 1) & a, X + 1, Y + arr(X, 1))    '
    Call xi(a, X + 1, Y)
End Sub
再优化了一下,1-100=100   只需1.27秒