Алгоритм суммирования подмножества в vba

Я пытаюсь написать алгоритм для решения проблемы суммы подмножества.

Я считаю, что у меня есть начало алгоритма, но я хочу написать что-то, что начнется с 1 набора N наборов в зависимости от длины массива. В идеале это приведет к выплескиванию первого результата, который соответствует.

Я считаю, что это может быть написано лучше, так как оно соответствует шаблону.

Приветствуется любой ввод.

Спасибо!

Антонио

Function SubnetSum()
Dim num() As Variant
Dim goal As ******
Dim result As ******
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].

Кроме того, если моя цель - получить 14 из [1,2,3,4,5], он будет циклически перебирать все возможные комбинации добавлений в массиве чисел и выплеснуть наиболее оптимальное решение, которое в этом случае [5,4,3,2].

Что мой код делает, так это то, что он пробивает числа массивов до 5 значений, пока не получит наиболее оптимальное решение.

Что я хочу сделать, это написать рекурсивный цикл, чтобы он не был жестко закодирован только для 5 возможных значений. Вместо этого я хочу иметь возможность прокручивать комбинацию чисел с N возможными значениями на основе размера массива.

Однако я не могу думать о цикле, который поддерживал бы эту функцию. Я уверен, что это возможно с небольшой рекурсией.

Я предполагаю, что мой вопрос будет... Есть ли способ укрепить код, который у меня выше, в одну сложную рекурсивную функцию?

Спасибо!

1 ответ

Мне нужна была подобная рекурсивная функция. Вот код.

* добавьте свою собственную обработку ошибок

Public Function fSubSet(arr As Variant, goal As ******, 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

licensed under cc by-sa 3.0 with attribution.