User:Eriksiers/Knapsack problem

This is my not-quite-working version of another VB solution to the unbounded knapsack problem. (The actual solution is Knapsack Problem/Visual Basic.) I didn't base this version on the one that's posted; I wanted to do it all on my lonesome. It's significantly shorter than the actual solution, but...

I didn't put it up there because there's something not quite right here; it goes over the limits by one panacea and one gold. Also, it picks the first version that works, and doesn't list all solutions (but I think I could handle that in just a few lines.) Also also, it doesn't go through all permutations of the list.

Maybe I'll fix it some day, maybe not. Probably not.

<lang vb>Type item

   name As String
   value As Long
   weight As Long  ' divide by 10 for actual weight
   volume As Long  ' divide by 1000 for actual volume

End Type

Private treasures(2) As item

Const MAX_WEIGHT = 250 Const MAX_VOLUME = 250

Private Sub buildTable()

   With treasures(0)
       .name = "panacea"
       .value = 3000
       .weight = 3
       .volume = 25
   End With
   With treasures(1)
       .name = "ichor"
       .value = 1800
       .weight = 2
       .volume = 15
   End With
   With treasures(2)
       .name = "gold"
       .value = 2500
       .weight = 20
       .volume = 2
   End With

End Sub

Sub BruteForceFillBackpack()

   Dim L0 As Long, L1 As Long, L2 As Long
   Dim volumeLeft As Long, weightLeft As Long
   Dim tmpVl As Long, tmpWt As Long, tmpNum As Long

   Dim maxTake(2) As Long

   Dim finalChoice(2) As Long, finalValue As Long, outP As String

   buildTable

   tmpVl = MAX_VOLUME \ treasures(0).volume
   tmpWt = MAX_WEIGHT \ treasures(0).weight
   maxTake(0) = IIf(tmpVl < tmpWt, tmpVl, tmpWt) 'lower number needed

   For L0 = 0 To maxTake(0)
       volumeLeft = MAX_VOLUME - (treasures(0).volume * L0)
       weightLeft = MAX_WEIGHT - (treasures(0).weight * L0)

       tmpVl = volumeLeft \ treasures(1).volume
       tmpWt = weightLeft \ treasures(1).weight
       maxTake(1) = IIf(tmpVl < tmpWt, tmpVl, tmpWt) 'lower number again
       For L1 = 0 To maxTake(1)
           volumeLeft = MAX_VOLUME - (treasures(1).volume * L1)
           weightLeft = MAX_WEIGHT - (treasures(1).weight * L1)

           tmpVl = volumeLeft \ treasures(2).volume
           tmpWt = weightLeft \ treasures(2).weight
           maxTake(2) = IIf(tmpVl < tmpWt, tmpVl, tmpWt) 'and again

           tmpNum = (treasures(0).value * L0) + (treasures(1).value * L1) + (treasures(2).value * maxTake(2))
           If tmpNum > finalValue Then
               finalChoice(0) = L0
               finalChoice(1) = L1
               finalChoice(2) = maxTake(2)
               finalValue = tmpNum
           End If
       Next
   Next

   For L0 = 0 To 2
       outP = outP & treasures(L0).name & ":" & finalChoice(L0) & vbNewLine
   Next
   outP = outP & "Total value:" & finalValue & vbNewLine
   outP = outP & "Total weight:" & Str$(((treasures(0).weight * finalChoice(0)) + (treasures(1).weight * finalChoice(1)) + (treasures(2).weight * finalChoice(2))) / 10!) & vbNewLine
   outP = outP & "Total volume:" & Str$(((treasures(0).volume * finalChoice(0)) + (treasures(1).volume * finalChoice(1)) + (treasures(2).volume * finalChoice(2))) / 1000!)

   MsgBox outP

End Sub</lang>