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.

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