求1-n个数总和符合目标值的 高效【组合递归方法】

香川群子

第5阶段，就发现如果倒序递归，并且不是计算累计和，而是计算剩余差值时，计算效率更高。

Sub dgH4(r, s$, i%, t%) '逆序dg差値計算、正序検索末位=[r,r+h2]、次位>r+h2停止/次位累計和<r停止
    Dim j%
   
    If n = 0 Or t = n Then
        For j = 1 To i - 1
            If r <= sj(j, 1) And sj(j, 1) <= r + h2 Then
                k = k + 1
                    jg(k, 0) = t
                    jg(k, 1) = h - r + sj(j, 1)
                    jg(k, 2) = s & "+" & sj(j, 1)
            End If
        Next
    End If
    If t = n Then Exit Sub 'n=0時は継続
   
    For j = i - 1 To 2 Step -1
        If sj(j, 1) < r + h2 Then
            If sj(j, 2) < r Then
                Exit For
            Else
                Call dgH4(r - sj(j, 1), s & "+" & sj(j, 1), j, t + 1)
            End If
        End If
    Next

End Sub

香川群子

第6阶段，
发现优化改进剪枝算法顺序可以最大发挥计算效率。

Sub dgH5(r, s$, i%, t%) '逆序dg計算、逆序検索末位=r/次位<r停止、次位累計和<r停止
    Dim j%
   
    For j = i - 1 To 1 Step -1
        If r = sj(j, 1) Then
            k = k + 1
            jg(k, 0) = "+" & r & s
            Exit For
        ElseIf r > sj(j, 1) Then
            j = j + 1
            Exit For
        End If
    Next
   
    For j = j - 1 To 2 Step -1
        If r > sj(j, 2) Then
            Exit For
        Else
            Call dgH5(r - sj(j, 1), "+" & sj(j, 1) & s, j, t + 1)
        End If
    Next

End Sub

但是，这样的算法顺序，只适合没有设定和值范围，不需要进行元素组合个数限制的计算。

如果有设定和值范围，和元素组合个数限制，那么阶段5的算法已经是最快、最好。

vbaplus

香川群子 发表于 2013-1-17 10:34
第5阶段，就发现如果倒序递归，并且不是计算累计和，而是计算剩余差值时，计算效率更高。

Sub dgH4(r, s ...

非常感谢香川分享该算法的整个改进历程，十分珍贵。
没有什么好感谢的，只好把今天的仅有的6朵花全部送上，表示感谢~
从前看到后，一直到阶段4都能看懂。
经过你这么一整理分析，阶段5和阶段6又有了更深的理解了，谢谢香川。

vbaplus

在阶段5中，如果在正序检查末位时，经过以下改进，是不是可以减少循环判断次数？特别是在原始数据量比较大的时候能多少提高点效率。

If n = 0 Or t = n Then
        For j = 1 To i - 1
            If r <= sj(j, 1) And sj(j, 1) <= r + h2 Then
                k = k + 1
                    jg(k, 0) = t
                    jg(k, 1) = h - r + sj(j, 1)
                    jg(k, 2) = s & "+" & sj(j, 1)
            ElseIf sj(j, 1) > r + h2 Then
                Exit For
            End If
        Next
    End If

香川群子

vbaplus 发表于 2013-1-17 12:42
在阶段5中，如果在正序检查末位时，经过以下改进，是不是可以减少循环判断次数？特别是在原始数据量比较大的 ...

嗯。

其实效果没有那么明显。


原因、理由如下：

我的算法，是直接遍历循环比较所有剩余元素，
但判断只需要一次。

而你增加了一个判断以后，可以减少大约6%的循环次数，
但同时，增加了一个判断，计算量也要相应增加4%。

两者合计，对于这一个循环比较过程来说，大约是可以节约2%的计算量。
而在整个过程中的影响就更小了。（因为单纯数组循环的速度是很快的）。

vbaplus

香川群子 发表于 2013-1-17 14:07
不可以。

这样会造成计算遗漏。

既然原始数据已排序，那么sj(j,1)都比上限值r+h2大的话，sj(j,1)以后的不都是比上限值大吗？

香川群子

vbaplus 发表于 2013-1-17 14:41
既然原始数据已排序，那么sj(j,1)都比上限值r+h2大的话，sj(j,1)以后的不都是比上限值大吗？

嗯。

我记得我一开始也是有这一段代码的，后来自己把它删掉了。

因此我想一定是有问题才删掉的。


但是现在一下子也想不起来是为什么删了。

现在看计算结果是没有错误的，那一定是速度问题了。

…………

然后，我今天又做了速度比较，发现速度没有明显提高，反而多次重复的平均时间要稍微长一点。

大概因为这个实际速度上并没有产生优势，就是我去掉这一句代码的原因吧。


呵呵。

XUYUJING2007

香川老师，作为递归进程位置指针的变量I在递归进程中好像跟常规的递归变量的变化规律不一样的，并不是进去一个就出来一个，例如，J到19了，碰到EXIT SUB 弹回去的时候，I还是5，我看不懂了，能否解释下I的变化规律

香川群子

XUYUJING2007 发表于 2013-1-17 16:45
香川老师，作为递归进程位置指针的变量I在递归进程中好像跟常规的递归变量的变化规律不一样的，并不是进去一 ...

简单解释如下：

1.
【j】是当前【循环变量】，仅在当前递归过程中起作用。
计算完成后，我把【它的值】作为【i】参数传递到下一个递归过程中去。
而一旦离开这个递归，【j变量】就将消失不见了。

2.
【i参数】是从递归开始前就从外部获得的参数，
  并且作为【递归变量】始终存在于这个递归中，
  每一个不同的【递归过程】都拥有自己独自的【递归参数】，
  并且不会因为【递归层次】的变化而消失。
  而且，如果你没有在离开这个递归过程前改变它的值，那么它的值将保持不变。

3.
  当【深层递归】结束后，递归过程将退回到【上一层递归过程】，
  继续运行剩余部分的代码，而此时本次递归的【i参数】实际上被存储在递归堆栈中没有发生变化，
  因此它将沿用【离开上一层递归过程时的值】。


大概就是这个意思。

vbaplus

香川群子 发表于 2013-1-17 15:18
嗯。

我记得我一开始也是有这一段代码的，后来自己把它删掉了。

在看了你的代码后，然后我根据我对你的思路的理解，自己尝试着写出来了，最后比对细节上和你的写法有细微差别，但测试貌似没发现什么问题，关于原始数据排序上，我这个写的是针对已已经排好序的数据进行的：

1. Public arr1, arr2, h%, plus%, m%, n%, k%
   
2. Sub ghqj()
   
3. k = 0
   
4. n = Val([c3])
   
5. h = Application.WorksheetFunction.Min(Val([c1]), Val([c2]))
   
6. plus = Abs(Val([c1]) - Val([c2]))
   
7. m = [a65536].End(3).Row
   
8. arr1 = Range("a2:a" & m).Value
   
9. ReDim Preserve arr1(1 To m - 1, 1 To 2)
   
10. ReDim arr2(65536, 1)
    
11. arr1(1, 2) = arr1(1, 1)
    
12. For i = 2 To m - 1
    
13.    arr1(i, 2) = arr1(i - 1, 2) + arr1(i, 1)
    
14. Next i
    
15. Call dgh(h, "", m, 1)
    
16. arr2(0, 0) = "r": arr2(0, 1) = "s"
    
17. Range("g1").Resize(65536, 2).ClearContents
    
18. Range("g1").Resize(k + 1, 2) = arr2
    
19. End Sub
    
20. 
    
21. Sub dgh(r, s$, i%, t%)
    
22. Dim x%, y%
    
23. If n = 0 Or t = n Then
    
24.    For x = 1 To i - 1
    
25.       If arr1(x, 1) >= r And arr1(x, 1) <= r + plus Then
    
26.          k = k + 1
    
27.          arr2(k, 0) = h - r + arr1(x, 1)
    
28.          arr2(k, 1) = s & "+" & arr1(x, 1)
    
29.       ElseIf arr1(x, 1) > r + plus Then
    
30.          Exit For
    
31.       End If
    
32.    Next x
    
33. End If
    
34. If t = n Then Exit Sub
    
35. For y = i - 1 To 2 Step -1
    
36.     If arr1(y, 2) < r Then Exit For
    
37.     If arr1(y, 1) < r + plus Then
    
38.        Call dgh(r - arr1(y, 1), s & "+" & arr1(y, 1), y, t + 1)
    
39.     End If
    
40. Next y
    
41. End Sub

复制代码