vba子集求和算法

Question

我正在尝试编写一个算法来解决子集求和问题。

我相信我有算法的开始，但是我想写一些东西，从1开始，根据数组的长度设置为N组。理想情况下，它最终会吐出匹配的第一个结果。

我相信这可以写得更好，因为它确实遵循一种模式。

任何输入表示赞赏。

谢谢！

安东尼

Function SubnetSum() 

Dim num() As Variant 
Dim goal As Double 
Dim result As Double 

Num() = array (1,2,3,4,5,6,7,8,9,10) 

goal = 45 

For i = LBound(num) To UBound(num) 
    If num(i) = goal Then 
     MsgBox num(i) & " " & goal & " 1 Set" 
     Exit Function 
    End If 
Next 

For i = LBound(num) To UBound(num) 
    For j = i + 1 To UBound(num) 
     If num(i) + num(j) = goal Then 
      result = num(i) + num(j) 
      MsgBox result & " " & goal & " 2 Sets" 
      Exit Function 
     End If 
    Next 
Next 

For i = LBound(num) To UBound(num) 
    For j = i + 1 To UBound(num) 
     For k = j + 1 To UBound(num) 
      If num(i) + num(j) + num(k) = goal Then 
       result = num(i) + num(j) + num(k) 
       MsgBox result & " " & goal & " 3 Sets" 
       Exit Function 
      End If 
     Next 
    Next 
Next 

For i = LBound(num) To UBound(num) 
    For j = i + 1 To UBound(num) 
     For k = j + 1 To UBound(num) 
      For l = k + 1 To UBound(num) 
       If num(i) + num(j) + num(k) + num(l) = goal Then 
        result = num(i) + num(j) + num(k) + num(l) 
        MsgBox result & " " & goal & " 4 Sets" 
        Exit Function 
       End If 
      Next 
     Next 
    Next 
Next 

For i = LBound(num) To UBound(num) 
    For j = i + 1 To UBound(num) 
     For k = j + 1 To UBound(num) 
      For l = k + 1 To UBound(num) 
       For m = l + 1 To UBound(num) 
        If num(i) + num(j) + num(k) + num(l) + num(m) = goal Then 
         result = num(i) + num(j) + num(k) + num(l) + num(m) 
         MsgBox result & " " & goal & " 5 Sets" 
         Exit Function 
        End If 
       Next 
      Next 
     Next 
    Next 
Next 

MsgBox "Nothing found" 

End Function 

---

编辑

@Enderland谢谢你的文章，我觉得这是很有趣，我很抱歉，因为这是我的这个网站上的第一篇文章。

我想要做的是解决一个子集和问题，即我有一个9的目标和使用[1,2,3,4,5]的数字集，我想找到最优化的方式使用数组中的数字组合到5。

可能的解决方案是[5]，[5,4]，[5,3,1]，[4,3,2]。但是，我想获得最佳的解决方案[5]。此外，如果我的目标是从[1,2,3,4,5]中获得14，它将循环遍历数组数组中的所有可能的加法组合，并且吐出最优解，在此情况是[5,4,3,2]。

我的代码正在做的是，它通过数组数字循环最多5个值，直到它获得最佳解决方案。

我想要做的是编写一个递归循环，以便它不被硬编码为只有5个可能的值。相反，我希望能够根据数组的大小循环遍历N个可能值的数字组合。

但是，我不能想到一个循环，将支持该功能。我相信它可能会有一点递归。

我想我的问题是...有没有办法将上面的代码合并成一个复杂的递归函数？

谢谢！

Answer 1

我需要一个类似的递归函数。这是代码。

*添加自己的错误处理

Public Function fSubSet(arr As Variant, goal As Double, Optional arrIndices As Variant) As Boolean 

    Dim i As Integer 
    Dim intSumSoFar As Integer 

    i = 0 
    If IsMissing(arrIndices) Then 
     arrIndices = Array(0) 
    End If 
    For i = LBound(arrIndices) To UBound(arrIndices) 
     intSumSoFar = intSumSoFar + arr(arrIndices(i)) 
    Next 
    If intSumSoFar = goal Then 
     For i = LBound(arrIndices) To UBound(arrIndices) 
      Debug.Print arr(arrIndices(i)) 
     Next 
     fSubSet = True 
     Exit Function 
    End If 
    'now we increment one piece of the array starting from the last one 
    i = UBound(arrIndices) 
    Do While i > -1 
     If arrIndices(i) + (UBound(arrIndices) - i) < UBound(arr) Then 
      arrIndices(i) = arrIndices(i) + 1 
      Exit Do 
     End If 
     i = i - 1 
    Loop 
    'if we are on the first index of the indices array and it is pushed as far as it can go then reset the array and add one to it if that doesn't make it too big 
    If i = -1 And UBound(arrIndices) < UBound(arr) Then 
     ReDim arrIndices(UBound(arrIndices) + 1) 
     For i = 0 To UBound(arrIndices) 
      arrIndices(i) = i 
     Next 
     'we need to end this monster 
    ElseIf i = -1 And UBound(arrIndices) = UBound(arr) Then 
     fSubSet = False 
     Exit Function 
    End If 

    fSubSet = fSubSet(arr, goal, arrIndices) 

End Function 
Public Function fTestSubSet() 
    Debug.Print fSubSet(Array(1, 2, 5, 6, 11, 10), 35) 
End Function