User:Eriksiers/Knapsack problem: Difference between revisions
Content added Content deleted
(created! not working! whatever!) |
m (updated lang tag) |
||
(One intermediate revision by the same user not shown) | |||
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. |
||
Line 5: | Line 5: | ||
Maybe I'll fix it some day, maybe not. ''Probably'' not. |
Maybe I'll fix it some day, maybe not. ''Probably'' not. |
||
< |
<syntaxhighlight lang="vb">Type item |
||
name As String |
name As String |
||
value As Long |
value As Long |
||
Line 86: | Line 86: | ||
MsgBox outP |
MsgBox outP |
||
End Sub</ |
End Sub</syntaxhighlight> |
Latest revision as of 04:57, 1 September 2022
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.
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