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

香川群子

佛道紫皇 发表于 2013-11-14 08:29
高手，结果能不能删除已重复使用过的数值，输出的每种组合里面没有重复项？

如果找到1组组合就标记并不再使用，
那么全部计算完成后，得到的组合状态无法保证是最适合的。

建议你手动做：
1. 输出组合结果的参数选1
2. 运行以后删除这个组合，然后继续步骤1

直到最后无解为止。


上述过程当然也可以帮你改成自动化的程序代码……
不过你还是先手工模拟几次，如果这样的做法没有问题，我再考虑帮你写成自动化代码。

呵呵。

佛道紫皇

香川群子 发表于 2013-11-14 09:58
如果找到1组组合就标记并不再使用，
那么全部计算完成后，得到的组合状态无法保证是最适合的。

我用的附件里面的一个，问题不大，就是缺少，我提的那个功能

香川群子

你的附件是别人的算法代码……比较复杂。


我还是用我的算法，为你的目的写了个文件。

可指定求和范围(模糊匹配或精确匹配)
可指定个数范围(模糊匹配或精确匹配或所有解)
可指定小数点位置(向下兼容小数或向上取整)
可指定求解个数(或全部解指导无解为止)

……
但是需要注意的是，由算法限定，每次计算时得到的解，并非随机组合，也不一定是最佳组合。
仅仅是用我的递归算法找到的第一组解。


调试程序化了几个小时。
尚未考虑速度优化。

香川群子

【佛道紫皇】看一下，为你量身定做的【型材套料组合求解工具】

佛道紫皇

香川群子 发表于 2013-11-15 00:20
【佛道紫皇】看一下，为你量身定做的【型材套料组合求解工具】

谢谢，灰常感谢，无限接近我想要的输出结果了，但是能不能是我上传的附件的那种显示结果，这样方便导出数据，每种组合竖列显示。高人，能再优化不？

佛道紫皇

香川群子 发表于 2013-11-14 16:22
你的附件是别人的算法代码……比较复杂。

高风亮节！感动

香川群子

佛道紫皇 发表于 2013-11-15 08:23
谢谢，灰常感谢，无限接近我想要的输出结果了，但是能不能是我上传的附件的那种显示结果，这样方便导出数 ...

你按照第4列 【组合k】进行排序，就是你想要的竖排结果了。

这个只要把主过程代码中的最后一句改一下就可以了：
原代码：
     [a2].Resize(m, 4).Sort [a2], 1, , , , , , 2
End Sub

改成：
     [a2].Resize(m, 4).Sort [d2], 1, [a2], , 1, , , 2
End Sub




你自己改一下，试一试吧。

佛道紫皇

香川群子 发表于 2013-11-15 10:07
你按照第4列 【组合k】进行排序，就是你想要的竖排结果了。

这个只要把主过程代码中的最后一句改一下就 ...

ok,谢谢。完美了

616891719

mark 学习学习

小麦和小麦

Sub bcfhdg(r%, s$, i%, t%) '不重复组合求和的递归过程代码
'参数s是组合结果的文本格式、r是组合结果的和值、i是递归进程位置指针、t是组合抽取个数指针
    Dim j%
    cnt = cnt + 1 '递归计算次数递增+1
   
    p = Split(s, "+")
    For j = 1 To UBound(p)
        jg(0, j) = p(j) '当前递归结果分解存入状态栈，以便下一次递归是检查比对
    Next
   
    If r >= h1 And r <= h2 Then '如果本次递归组合结果的和值已经在总和目标范围内，则：
        If n > m Or t = n Then '如果参数n>m是则结果都要，或者n在1-m之间时必须t=n即抽取个数正好符合条件。
            If t > jg(0, 0) Then jg(0, 0) = t
            jg(k, -1) = t出现下标越界，如何更改
            For j = 1 To UBound(p)
                jg(k, j) = p(j) '符合总和条件的本次递归结果写入结果数组。
            Next
            jg(k, 0) = "=" & Mid(s, 2) '第一列文本格式改写为=计算式，最后输出结果时直接得到计算式结果。
            k = k + 1 '结果序号递增+1
        End If
        'Exit Sub '退出以后的递归进程，加速计算过程。
        '注意：如果原始数据数值间隔小、目标和值的范围相对较大时，则这一句要注释掉，否则会漏掉一些正确的答案。
    End If
    If t = n Then Exit Sub 'n>m → go on 当n参数>m时应该继续，而n在1-m之间时因为t已经满足抽取个数则可退出递归进程。
   
    For j = i + 1 To m '递归遍历检查所有原始元素
        If r + sj(j, 1) > h2 Then Exit For '如果本次递归结果的和值已经大于总和目标范围上限，则可退出循环了。
        If CStr(sj(j, 1)) <> jg(0, t + 1) Then '检查本次递归进程中最新位置值，和前面上次递归状态栈比对，不重复才可继续
            If t < n - 1 Then jg(0, t + 2) = "" '递归最新状态栈位清空，否则会对下一次递归的比对造成错误干扰。
            Call bcfhdg(r + sj(j, 1), s & "+" & sj(j, 1), j, t + 1) '满足条件时，继续调用递归进行下一个组合位置的递归计算。
        End If
    Next j
End Sub