User:Eriksiers/Knapsack problem: Difference between revisions
(created! not working! whatever!) |
m (clarify) |
||
Line 1: | Line 1: | ||
This is my working version of another VB solution to the [[Knapsack problem/Unbounded|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...'' |
This is my not-quite-working version of another VB solution to the [[Knapsack problem/Unbounded|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. |
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. |
Revision as of 02:01, 10 November 2010
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>