I had to design a method of filling multiple sets of racks that were of a certain fixed height with individual units called MCC's. Each unit that went within the rack was of different size so aim was to use as few racks as possible and fill the racks optimally given each unit' height - used a recursive function to calculate optimal way of filling the racks while using as few racks as possible. This is a method to calculate a "subset sum problem". I will attach the whole project which draws the units however the main function is what I was interested in - to follow is the recursive function and its method to call.
Public fR As Boolean
Function RealEqual(A, B, Optional Epsilon As Double = 0.00000001)
RealEqual = Abs(A - B) <= Epsilon
End Function
Function ExtendRslt(CurrRslt, NewVal, Separator)
If CurrRslt = "" Then ExtendRslt = NewVal _
Else ExtendRslt = CurrRslt & Separator & NewVal
End Function
Sub recursiveMatch(ByVal MaxSoln As Integer, ByVal TargetVal, InArr(), _
ByVal HaveRandomNegatives As Boolean, _
ByVal CurrIdx As Integer, _
ByVal CurrTotal, ByVal Epsilon As Double, _
ByRef Rslt(), ByVal CurrRslt As String, ByVal Separator As String)
Dim I As Integer
For I = CurrIdx To UBound(InArr, 2)
If RealEqual(CurrTotal + InArr(2, I), TargetVal, Epsilon) Then
Rslt(UBound(Rslt)) = (CurrTotal + InArr(2, I)) _
& Separator & ExtendRslt(CurrRslt, I, Separator)
fR = True
If MaxSoln = 0 Then
If UBound(Rslt) Mod 100 = 0 Then Debug.Print "Rslt(" & UBound(Rslt) & ")=" & Rslt(UBound(Rslt))
Else
' If UBound(Rslt) >= MaxSoln Then Exit Sub
If fR = True Then Exit Sub
End If
ReDim Preserve Rslt(UBound(Rslt) + 1)
ElseIf IIf(HaveRandomNegatives, False, CurrTotal + InArr(2, I) > TargetVal + Epsilon) Then
ElseIf CurrIdx < UBound(InArr, 2) Then
recursiveMatch MaxSoln, TargetVal, InArr(), HaveRandomNegatives, _
I + 1, _
CurrTotal + InArr(2, I), Epsilon, Rslt(), _
ExtendRslt(CurrRslt, I, Separator), _
Separator
If MaxSoln <> 0 Then If fR = True Then Exit Sub
Else
'no matches
End If
Next I
End Sub
Called by
recursiveMatch MaxSoln, TargetVal, InArr, HaveRandomNegatives, _
LBound(InArr), 0, 0.00000001, _
Rslt, "", ", "
The applications/code on this site are distributed as is and without warranties or liability. In no event shall the owner of the copyrights, or the authors of the applications/code be liable for any loss of profit, any problems or any damage resulting from the use or evaluation of the applications/code.