Author Topic: Knapsack Problem/0-1 - Rosetta Code (Read 4804 times)

bplus · « **on:** October 05, 2020, 11:49:01 am »

Rosetta Code ref link is in comments at top. Basically packing a Knapsack with supplies needed for day and you have more items than you can carry so you assign values to each item and pick best value for 400 weight limit. Items total over 800.

This turned out way easier than I expected, thinking I would have to try all combinations that added to 400 in weight and take the best values score but no:

Code: QB64: [Select]

_TITLE "Knapsack problem/0-1 - Rosetta Code" 'b+ 2020-10-04
' w < 400   http://rosettacode.org/wiki/Knapsack_problem/0-1
TYPE item
    name AS STRING
    weight AS SINGLE
    value AS SINGLE
    vPerW AS SINGLE ' value Per Weight
END TYPE
REDIM it(0) AS item, insert AS item
FOR i = 1 TO 22
    READ insert.name, insert.weight, insert.value
    insert.vPerW = insert.value / insert.weight
    loadSort insert, it()
NEXT
PRINT "      *** Knapsack Items Sorted by Value Per Unit Weight ***"
PRINT " #: Item:         Wght:  Val:   V/W:  Accum W:    Packed or Not: Value Packed:"
FOR i = 1 TO 22
    PRINT RIGHT$(SPC(3) + STR$(i), 3); SPC(1);
    PRINT LEFT$(it(i).name + SPC(15), 15);
    PRINT RIGHT$(SPC(4) + _TRIM$(STR$(it(i).weight)), 4);
    PRINT RIGHT$(SPC(6) + _TRIM$(STR$(it(i).value)), 6);
    PRINT RIGHT$(SPC(7) + _TRIM$(STR$(INT(it(i).vPerW * 100) / 100)), 7);
    totW = totW + it(i).weight
    PRINT RIGHT$(SPC(10) + _TRIM$(STR$(totW)), 10); SPC(4);
    IF totW < 400 THEN
        PRINT "Packed!";
        totV = totV + it(i).value
        PRINT RIGHT$(SPC(21) + _TRIM$(STR$(totV)), 21);
    ELSE
        PRINT "Not included.";
    END IF
    IF i < 22 THEN PRINT
NEXT
SLEEP
DATA map,9,150
DATA compass,13,35
DATA water,153,200
DATA sandwich,50,160
DATA glucose,15,60
DATA tin,68,45
DATA banana,27,60
DATA apple,39,40
DATA cheese,23,30
DATA beer,52,10
DATA suntan cream,11,70
DATA camera,32,30
DATA T-shirt,24,15
DATA trousers,48,10
DATA umbrella,73,40
DATA WP_trousers,42,70
DATA WP_wear,43,75
DATA note-case,22,80
DATA sunglasses,7,20
DATA towel,18,12
DATA socks,4,50
DATA book,30,10
SUB loadSort (insertN AS item, dynArr() AS item) '  modified for this code
    'note this leaves dynArr(0) empty! so ubound of array is also number of items in list
    DIM ub, j, k
    ub = UBOUND(dynArr) + 1
    REDIM _PRESERVE dynArr(LBOUND(dynArr) TO ub) AS item
    FOR j = 1 TO ub - 1
        IF insertN.vPerW > dynArr(j).vPerW THEN '  GT to LT according to descending or ascending sort
            FOR k = ub TO j + 1 STEP -1
                dynArr(k) = dynArr(k - 1)
            NEXT
            EXIT FOR
        END IF
    NEXT
    dynArr(j) = insertN
END SUB
 
 

After sort by value per weight unit, just take top items until you exceed 400. Actually this problem might be made trickier by throwing in really light low value items.

On a practical side if you are expecting rain and take all that rain gear, do you need sun glasses, sun protection oil and water or vice versa? Well maybe you could run into both?

WP is short for Water proof and I changed WP_wear from "Waterproof overclothes" because the name was so long.

Rubidium · « **Reply #1 on:** October 06, 2020, 07:13:10 pm »

Yes, by sorting your items in descending order of Value per Weight you are guaranteed the top of the list up to 400 (dag) are the most valuable items to pack. very neat solution.

bplus · « **Reply #2 on:** October 06, 2020, 07:43:42 pm »

Thanks. I've been thinking since I posted this code that if list included a couple of really light items, they might have been added to knapsack no matter their value rating, there was room for 4 more weight units and I would have to change code to look for that. My solution matched the others so I let it be.

bplus · « **Reply #3 on:** October 13, 2020, 04:44:57 pm »

Yeah, this is a much more satisfactory solution, now what you take may not be the first set of items that appear. You may still have room for lighter but way lower valued items like this:

Code: QB64: [Select]

_TITLE "Knapsack problem/0-1 - Rosetta Code Better Solution" 'b+
' ref:  http://rosettacode.org/wiki/Knapsack_problem/0-1
 
' 2020-10-04 post Knapsack - Rosetta Code.bas
' https://www.qb64.org/forum/index.php?topic=3091.msg123665#msg123665
 
' 2020-10-13 Knapsack better soln 2020-10-13 Rosetta Code
' swap DATA beer,52,10 for DATA xtra_paper,3,1 to trip up original code solution and test better code soln.
' note: need to keep number at 22 to fit default screen 0.
 
' w < 400 taking highest valued items first.
TYPE item
    name AS STRING
    weight AS SINGLE
    value AS SINGLE
    vPerW AS SINGLE ' value Per Weight
END TYPE
REDIM it(0) AS item, insert AS item
FOR i = 1 TO 22
    READ insert.name, insert.weight, insert.value
    insert.vPerW = insert.value / insert.weight
    loadSort insert, it()
NEXT
PRINT "              *** Knapsack Items Sorted by Value Per Unit Weight ***"
PRINT " #: Item:         Wght:  Val:   V/W:    Packed or Not:  Accum w: Value Packed:"
FOR i = 1 TO 22
    IF totW + it(i).weight < 400 THEN
        pack = -1: totW = totW + it(i).weight: totV = totV + it(i).value
    ELSE
        pack = 0
    END IF
    PRINT RIGHT$(SPC(3) + STR$(i), 3); SPC(1);
    PRINT LEFT$(it(i).name + SPC(15), 15);
    PRINT RIGHT$(SPC(4) + STR$(it(i).weight), 4);
    PRINT RIGHT$(SPC(6) + STR$(it(i).value), 6);
    PRINT RIGHT$(SPC(7) + STR$(INT(it(i).vPerW * 100) / 100), 7);
    IF pack THEN
        PRINT SPC(8); "Packed!"; SPC(4);
        PRINT RIGHT$(SPC(9) + STR$(totW), 9);
        PRINT RIGHT$(SPC(14) + STR$(totV), 14);
    ELSE
        PRINT SPC(5); "Not included.";
    END IF
    IF i < 22 THEN PRINT
NEXT
SLEEP
DATA map,9,150
DATA compass,13,35
DATA water,153,200
DATA sandwich,50,160
DATA glucose,15,60
DATA tin,68,45
DATA banana,27,60
DATA apple,39,40
DATA cheese,23,30
DATA suntan cream,11,70
DATA camera,32,30
DATA T-shirt,24,15
DATA trousers,48,10
DATA umbrella,73,40
DATA WP_trousers,42,70
DATA WP_wear,43,75
DATA note-case,22,80
DATA sunglasses,7,20
DATA towel,18,12
DATA socks,4,50
DATA book,30,10
DATA extra_paper,3,1
SUB loadSort (insertN AS item, dynArr() AS item) '  modified for this code
    'note this leaves dynArr(0) empty! so ubound of array is also number of items in list
    DIM ub, j, k
    ub = UBOUND(dynArr) + 1
    REDIM _PRESERVE dynArr(LBOUND(dynArr) TO ub) AS item
    FOR j = 1 TO ub - 1
        IF insertN.vPerW > dynArr(j).vPerW THEN '  GT to LT according to descending or ascending sort
            FOR k = ub TO j + 1 STEP -1
                dynArr(k) = dynArr(k - 1)
            NEXT
            EXIT FOR
        END IF
    NEXT
    dynArr(j) = insertN
END SUB

I traded out beer for xtra_paper so that all the stuff still fits on default screen 0.

bplus · « **Reply #4 on:** October 14, 2020, 10:48:38 pm »

bplus method sucks as a general solution to this sort of problem. Here is a counter example, compare the solution the code produces with logic and common sense, take the crackers with carry out value of 100!

Code: QB64: [Select]

_TITLE "Shopping Cart Mod of Knapsack Problem/0-1  from Rosetta Code" ' b+ 2020-10-14
' mod from: "Knapsack problem/0-1 - Rosetta Code Better Solution" 'b+
' ref:  http://rosettacode.org/wiki/Knapsack_problem/0-1
 
' 2020-10-04 post Knapsack - Rosetta Code.bas
' https://www.qb64.org/forum/index.php?topic=3091.msg123665#msg123665
 
' 2020-10-13 Knapsack better soln 2020-10-13 Rosetta Code
' swap DATA beer,52,10 for DATA xtra_paper,3,1 to trip up original code solution and test better code soln.
' note: need to keep number at 22 to fit default screen 0.
' post  https://www.qb64.org/forum/index.php?topic=3091.msg123962#msg123962
 
' 2020-10-14 Shopping Cart Mod bplus Knapsack solution sucks!
' It will not serve as a general solution or method to approach problems like this.
' The DATA just happens to work well with sort and pick method
 
 
' ========================= Here is a counter example with 100 weight limit  =======================
DATA ham,20,25
DATA crackers,100,100
DATA ice cream,20,9
DATA potatoes,70,66
DATA beans,30,17
DATA carrots,20,19
DATA cookies,10,5
 
' Obviously you should pickup the crackers only!
' Make the 100 weight limit with a carry out value of 100!
'===================================================================================================
TYPE item
    name AS STRING
    weight AS SINGLE
    value AS SINGLE
    vPerW AS SINGLE ' value Per Weight
END TYPE
REDIM it(0) AS item, insert AS item
FOR i = 1 TO 7
    READ insert.name, insert.weight, insert.value
    insert.vPerW = insert.value / insert.weight
    loadSort insert, it()
NEXT
PRINT "              *** Shopping Cart Items Sorted by Value Per Unit Weight ***"
PRINT " #: Item:         Wght:  Val:   V/W:    Packed or Not:  Accum w: Value Packed:"
FOR i = 1 TO 7
    IF totW + it(i).weight <= 100 THEN
        pack = -1: totW = totW + it(i).weight: totV = totV + it(i).value
    ELSE
        pack = 0
    END IF
    PRINT RIGHT$(SPC(3) + STR$(i), 3); SPC(1);
    PRINT LEFT$(it(i).name + SPC(15), 15);
    PRINT RIGHT$(SPC(4) + STR$(it(i).weight), 4);
    PRINT RIGHT$(SPC(6) + STR$(it(i).value), 6);
    PRINT RIGHT$(SPC(7) + STR$(INT(it(i).vPerW * 100) / 100), 7);
    IF pack THEN
        PRINT SPC(8); "Packed!"; SPC(4);
        PRINT RIGHT$(SPC(9) + STR$(totW), 9);
        PRINT RIGHT$(SPC(14) + STR$(totV), 14);
    ELSE
        PRINT SPC(5); "Not included.";
    END IF
    IF i < 7 THEN PRINT
NEXT
SLEEP
 
'DATA "ham,20,25"
'DATA "crackers,100,100"
'DATA "ice cream,20,9"
'DATA "potatoes,70,66"
'DATA "beans,30,17"
'DATA "carrots,20,19"
'DATA "cookies,10,5"
 
SUB loadSort (insertN AS item, dynArr() AS item) '  modified for this code
    'note this leaves dynArr(0) empty! so ubound of array is also number of items in list
    DIM ub, j, k
    ub = UBOUND(dynArr) + 1
    REDIM _PRESERVE dynArr(LBOUND(dynArr) TO ub) AS item
    FOR j = 1 TO ub - 1
        IF insertN.vPerW > dynArr(j).vPerW THEN '  GT to LT according to descending or ascending sort
            FOR k = ub TO j + 1 STEP -1
                dynArr(k) = dynArr(k - 1)
            NEXT
            EXIT FOR
        END IF
    NEXT
    dynArr(j) = insertN
END SUB
 
 

Yeah to get best optimization in such problems, you need to run through all the combinations which gets pretty hairy when big numbers of items are involved.

Like this:

Code: QB64: [Select]

_TITLE "Shopping Cart solve by Combo Method" '  b+ 2020-10-15
' a combinations problem modeled on a bluatigro post 2016-07-23 and fixed at old JB forum.
 
maxWeight = 100 'for problem
maxItems = 7 'for data reading and array dimensions
DIM item$(maxItems), w(maxItems), v(maxItems)
FOR i = 1 TO maxItems
    READ i$, ww, vv
    item$(i) = i$: w(i) = ww: v(i) = vv
    PRINT item$(i), w(i), v(i)
NEXT
PRINT: PRINT "Find the combination of items above the will fill cart for $100 and maximize the value."
FOR combo = 1 TO (2 ^ (maxItems + 1) - 1)
    testList$ = "": testValue = 0: testWeight = 0
    FOR power = 0 TO maxItems
        IF combo AND 2 ^ power THEN
            IF testList$ = "" THEN testList$ = item$(power) ELSE testList$ = testList$ + CHR$(10) + item$(power)
            testValue = testValue + v(power)
            testWeight = testWeight + w(power)
        END IF
    NEXT
    IF testWeight <= maxWeight AND testValue >= MaxValue THEN
        MaxValue = testValue: saveCombo = combo: saveList$ = testList$: saveWeight = testWeight
    END IF
    IF combo MOD 1000 = 0 THEN LOCATE 1, 1: PRINT SPACE$(20): LOCATE 1, 1: PRINT combo 'progress
NEXT
PRINT: PRINT "Best value found <= $"; maxWeight; " was:"
PRINT saveList$
PRINT "Total $"; saveWeight; "  Total value: "; MaxValue
 
DATA "ham",20,25
DATA "crackers",100,100
DATA "ice cream",20,9
DATA "potatoes",70,66
DATA "beans",30,17
DATA "carrots",20,19
DATA "cookies",10,5
 
 

bplus · « **Reply #5 on:** October 15, 2020, 02:42:36 am »

Wow what took about a half hour to run at JB took about a minute in QB64:

Code: QB64: [Select]

_TITLE "Knapsack problem/0-1 Combo Method Solve" 'Revised 2020-10-15.txt b+
' http://rosettacode.org/wiki/Knapsack_problem/0-1
' Found Knapsack problem posed by bluatigro and fixed 2016-07-23 at old JB Forum.
' This code follows that fixed method.
DEFLNG A-Z
maxWeight = 400 'for problem
maxItems = 22 'for data reading and array dimensions 8,388,608 combinations!
topItemsIndex = maxItems - 1
DIM item$(topItemsIndex), w(topItemsIndex), v(topItemsIndex)
FOR i = 0 TO topItemsIndex
    READ i$, ww, vv
    item$(i) = i$: w(i) = ww: v(i) = vv
NEXT
topComboIndex = 2 ^ maxItems - 1
FOR combo = 0 TO topComboIndex
    testList$ = "": testValue = 0: testWeight = 0
    FOR power = 0 TO topItemsIndex
        IF combo AND 2 ^ power THEN
            IF testList$ = "" THEN testList$ = item$(power) ELSE testList$ = testList$ + CHR$(10) + item$(power)
            testValue = testValue + v(power)
            testWeight = testWeight + w(power)
        END IF
    NEXT
    IF testWeight <= maxWeight AND testValue >= MaxValue THEN
        MaxValue = testValue
        saveCombo = combo
        saveList$ = testList$
        saveWeight = testWeight
    END IF
    IF combo MOD 1000 = 0 THEN LOCATE 1, 1: PRINT SPACE$(20): LOCATE 1, 1: PRINT combo 'progress
NEXT
CLS
PRINT "Best value found <= "; maxWeight; " was:"
PRINT saveList$
PRINT: PRINT "Total weight: "; saveWeight; "  Total value: "; MaxValue
 
DATA "map",9,150
DATA "compass",13,35
DATA "water",153,200
DATA "sandwich",50,160
DATA "glucose",15,60
DATA "tin",68,45
DATA "banana",27,60
DATA "apple",39,40
DATA "cheese",23,30
DATA "beer",52,10
DATA "suntan cream",11,70
DATA "camera",32,30
DATA "T-shirt",24,15
DATA "trousers",48,10
DATA "umbrella",73,40
DATA "WP_trousers",42,70
DATA "WP_wear",43,75
DATA "note-case",22,80
DATA "sunglasses",7,20
DATA "towel",18,12
DATA "socks",4,50
DATA "book",30,10
 

EDIT 2020-10-15 AM Because of indexing base 0 and indexing base 1 was a little mixed up, I was doing twice as many calculations as needed 2^23 not 2^22 which it should have been, anyway it's fixed now.

News:

Author Topic: Knapsack Problem/0-1 - Rosetta Code (Read 4804 times)

bplus

Knapsack Problem/0-1 - Rosetta Code

Rubidium

Re: Knapsack Problem/0-1 - Rosetta Code

bplus

Re: Knapsack Problem/0-1 - Rosetta Code

bplus

Re: Knapsack Problem/0-1 - Rosetta Code

bplus

Re: Knapsack Problem/0-1 - Rosetta Code

bplus

Re: Knapsack Problem/0-1 - Rosetta Code