vba中的子​​集求和算法 [英] Subset sum algorithm in vba

问题描述

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

I'm trying to write an algorithm to solve a subset sum problem.

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

I believe I have the start of the algorithm however I want to write something that will start off with 1 set to N sets depending on the length of the array. Ideally it will end up spitting out the first result that matches.

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

I believe that this could be written way better since it does follow a pattern.

感谢任何输入.

谢谢！

安东尼奥

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 感谢这篇文章，我觉得它很有趣，我很抱歉，因为这是我在这个网站上的第一篇文章.

@Enderland Thanks for the article I found it quite amusing and I apologize as this is my first post on this website.

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

What I am trying to do is to solve a subset sum problem i.e. I have a goal of 9 and using the number set of [1,2,3,4,5], I want to find the most optimal way to get to 5 using the the combination of numbers in the array.

可能的解是[5],[5,4],[5,3,1],[4,3,2].但是，我想得到最佳解决方案，即 [5].

The possible solutions are [5],[5,4],[5,3,1],[4,3,2]. However, I want to get the most optimal solution which is [5].

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

Moreover, if my goal is to obtain 14 from [1,2,3,4,5] it would loop through all the possible addition combinations within the array of numbers and spit out the most optimal solution, which in this case is [5,4,3,2].

我的代码正在做的是循环遍历最多 5 个值的数组，直到获得最佳解决方案.

What my code is doing is that it loops through the array numbers with up to 5 values until it obtains the most optimal solution.

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

What I want to do is write a recursive loop so that it is not hard coded to only 5 possible values. Instead I want to be able to loop through the combination of numbers with N possible values based on the size of the array.

然而，我想不出一个支持该功能的循环.我相信只要稍微递归一下就可以了.

I however for one cannot think of a loop that would support that function. I'm sure its possible with a little recursion.

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

I guess my question would be... Is there a way to consolidate the code I have above into one complex recursive function?

谢谢！

推荐答案

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

I needed a similar recursive function. Here is the code.

*添加您自己的错误处理

*add your own error handling

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

这篇关于vba中的子​​集求和算法的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！