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