Knapsack Problem/0-1 Rosetta Code

Started by bplus, October 05, 2020, 07:44:57

Previous topic - Next topic

bplus

Been silent for far too long here at SB (SmallBASIC Board not Syntax Bomb, so many SB's around here.)

So try translating a solution made in QB64 to SmallBASIC. Works great once I realized I needed the BYREF for the loadSort SUB because default for SB is BYVAL. SB sure is nice for adding any property you want onto variables or array variables without need for a Structure or Type definition.

Here is Knapsack Problem from Rosetta Code (see ref: link in comments at top):

' "Knapsack problem/0-1 - Rosetta Code" 'b+ 2020-10-04
' w < 400   http://rosettacode.org/wiki/Knapsack_problem/0-1

DIM it(22)
FOR i = 1 TO 22
    READ insrt.name, insrt.weight, insrt.value
    insrt.vPerW = insrt.value / insrt.weight
    loadSort insrt, 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) + 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);
    totW = totW + it(i).weight
    PRINT RIGHT$(SPC(10) + STR$(totW), 10); SPC(4);
    IF totW < 400 THEN
        PRINT "Packed!";
        totV = totV + it(i).value
        PRINT RIGHT$(SPC(21) + STR$(totV), 21);
    ELSE
        PRINT "Not included.";
    END IF
    IF i < 22 THEN PRINT
NEXT

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 (insrtN, byref dynArr)
  dynArr(0).weight = dynArr(0).weight + 1 ' <<<<<<<<< tracking the loading here in an empty item
  ub = dynArr(0).weight
  FOR j = 1 TO ub - 1
    IF insrtN.vPerW > dynArr(j).vPerW THEN
      FOR k = ub TO j + 1 STEP -1
        dynArr(k) = dynArr(k - 1)
      NEXT
      EXIT FOR
    END IF
  NEXT
  dynArr(j) = insrtN
END SUB


Oh yeah, I am glad I don't have to double quote the string data but how did all the items get UPPER CASED?  :o




1 person likes this

chrisws

Quote from: bplus on October 05, 2020, 07:44:57
Oh yeah, I am glad I don't have to double quote the string data but how did all the items get UPPER CASED?  :o

Ha nice:)

The UPPER CASE is no doubt a bug.

Are you going to submit the code?

https://rosettacode.org/wiki/Knapsack_problem/0-1

Cheers,
Chris

round157

Quote from: bplus on October 05, 2020, 07:44:57
Been silent for far too long here at SB (SmallBASIC Board......

Oh, perhaps you are right. BlitzMax NG forum looks more active. Maybe making the user base of SmallBASIC bigger will be an interesting target. 

bplus

#3
Not considering submission to Rosetta because although code solves given problem it would miss a trickier inventory of weights and values.

Say a feather pen and piece of paper to make a note were added to inventory with really low weights and values, say the weight was 3 and the value is 1  st v/w = .333...

It should be added to knapsack but this code would not include it:

' "Knapsack problem/0-1 - Rosetta Code" 'b+ 2020-10-04
' w < 400   http://rosettacode.org/wiki/Knapsack_problem/0-1

DIM it(23)
FOR i = 1 TO 23
    READ insrt.name, insrt.weight, insrt.value
    insrt.vPerW = insrt.value / insrt.weight
    loadSort insrt, 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 23
    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);
    totW = totW + it(i).weight
    PRINT RIGHT$(SPC(10) + STR$(totW), 10); SPC(4);
    IF totW < 400 THEN
        PRINT "Packed!";
        totV = totV + it(i).value
        PRINT RIGHT$(SPC(21) + STR$(totV), 21);
    ELSE
        PRINT "Not included.";
    END IF
    IF i < 23 THEN PRINT
NEXT

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
DATA pen_paper,3,1

SUB loadSort (insrtN, byref dynArr)
  dynArr(0).weight = dynArr(0).weight + 1
  ub = dynArr(0).weight
  FOR j = 1 TO ub - 1
    IF insrtN.vPerW > dynArr(j).vPerW THEN
      FOR k = ub TO j + 1 STEP -1
        dynArr(k) = dynArr(k - 1)
      NEXT
      EXIT FOR
    END IF
  NEXT
  dynArr(j) = insrtN
END SUB


Pen_Paper would fit 396 + 3 < 400 but code at present would miss it, it stops looking for items when items packed plus items not packed exceed 400. I suppose there is a quick fix for this theoretic problem... be right back.



1 person likes this

bplus

OK a better solution with trickier inventory of potential knapsack candidates:

' "Knapsack problem/0-1 - Rosetta Code" 'b+ 2020-10-04
' w < 400   http://rosettacode.org/wiki/Knapsack_problem/0-1

DIM it(23)
FOR i = 1 TO 23
    READ insrt.name, insrt.weight, insrt.value
    insrt.vPerW = insrt.value / insrt.weight
    loadSort insrt, 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 23
    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);
    PRINT RIGHT$(SPC(10) + STR$(totW), 10); SPC(4);
    IF totW + it(i).weight < 400 THEN
        totW = totW + it(i).weight
        PRINT "Packed!";
        totV = totV + it(i).value
        PRINT RIGHT$(SPC(21) + STR$(totV), 21);
    ELSE
        PRINT "Not included.";
    END IF
    IF i < 23 THEN PRINT
NEXT

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
DATA pen_paper,3,1

SUB loadSort (insrtN, byref dynArr)
  dynArr(0).weight = dynArr(0).weight + 1
  ub = dynArr(0).weight
  FOR j = 1 TO ub - 1
    IF insrtN.vPerW > dynArr(j).vPerW THEN
      FOR k = ub TO j + 1 STEP -1
        dynArr(k) = dynArr(k - 1)
      NEXT
      EXIT FOR
    END IF
  NEXT
  dynArr(j) = insrtN
END SUB


Now we catch the tricky item and any other we might have room for:
1 person likes this

bplus

#5
Dang, problem with accum weight sigh!

OK here is better version with trickier set of candidates for Knapsack:

' "Knapsack problem/0-1 - Rosetta Code" 'b+ 2020-10-04 fix 2020-10-13
' w < 400   http://rosettacode.org/wiki/Knapsack_problem/0-1

DIM it(23)
FOR i = 1 TO 23
    READ insrt.name, insrt.weight, insrt.value
    insrt.vPerW = insrt.value / insrt.weight
    loadSort insrt, 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 23
    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(4); "Packed!"; SPC(4);
       PRINT RIGHT$(SPC(10) + STR$(totW), 10);
       PRINT RIGHT$(SPC(15) + STR$(totV), 15)
    else
       PRINT SPC(4); "Not included."
    end if
NEXT

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
DATA pen_paper,3,1

SUB loadSort (insrtN, byref dynArr)
  dynArr(0).weight = dynArr(0).weight + 1
  ub = dynArr(0).weight
  FOR j = 1 TO ub - 1
    IF insrtN.vPerW > dynArr(j).vPerW THEN
      FOR k = ub TO j + 1 STEP -1
        dynArr(k) = dynArr(k - 1)
      NEXT
      EXIT FOR
    END IF
  NEXT
  dynArr(j) = insrtN
END SUB


1 person likes this

johnno56

#6
I think I may have a solution to the "Knapsack Problem".

The difficulty in trying to cram as much as you can into a Knapsack can be overcome by using another knapsack. Or maybe we are waiting for the new Tardis Knapsack... lol

Sorry... No coffee yet!
May your journey be free of incident.

Live long and prosper.

bplus

#7
Yeah well yesterday I found out my approach to this sort of problem is wrong minded and just lucky this worked on given data at Rosetta. Dang! we worked a similar (lesser item) problem way back in 2016 on old JB Forum. And dang again, I had forgotten the trick in counting in Binary numbers to list all 2^n combinations of n items which I knew about when ordering pizza with combinations of toppings. But forgot about when needing to generate combinations lists. Dah! getting old, I am forgetting stuff.

Well I will rewrite this properly for a general solution to this type of problem and not just a solution that works for a particular set of data. Trouble is running 2 ^ 22 combos is going to take awhile with an interpreter.

This type of problem easily could fail with the approach I applied to Rosetta Data. Yesterday I came up with simple counter example. Again I will go over when I rewrite everything from the start.

This is an important chapter about listing combos and optimizing in any coders book!
Heck I just used similar principles for finding optimum hands in Gin Rummy but forgot the Binary trick for listing or trying all combinations. I was generating data files for combination lists which is less than elegant way to go about the problem.

1 person likes this

bplus

#8
Knapsack solution should have been based on combinations. Here is code to generate combinations


' Simple method to generate combinations of n items" ' b+ 2020-10-15

' decisions: powers are base 0 so keep items$() array also base 0
' number of anything is usually base 1 so if we say number of items it would go from 1 to n
' but if we say topIndexItemIndex we have a base 0 item coulnt for accessing array wo errors.
' So call number of items base 1 >>> topIndexIndex base 0

DIM items$(9) 'limit 10 items
topIndex = -1 ' just to be clear
repeat
    INPUT "item to add to set for combos, nothing to end list "; item$
    IF item$ <> "" THEN 'item is not nothing
        topIndex = topIndex + 1
        items$(topIndex) = item$ 'add item to 0 based array
        'increment the index and
        IF topIndex + 1 > 9 THEN EXIT loop 'limit 10 items
    END IF
UNTIL item$ = ""
PRINT "topIndex is "; topIndex 'ok finally

' generating listings of combos
nItems = topIndex + 1 ' number is base 1
topComboIndex = 2 ^ nItems - 1 ' base 0 array
FOR i = 0 TO topComboIndex ' just going to print but could make list in array or process combo immediately
    b$ = "" ' for building a combination
    FOR power = 0 TO topIndex
        IF i BAND 2 ^ power THEN
            IF b$ = "" THEN b$ = items$(power) ELSE b$ = b$ + ", " + items$(power)
        END IF
    NEXT
    PRINT i + 1; "= "; b$, 'the combination built
NEXT



So the knapsack solve code in SB might look like this:

'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.

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 BAND 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



Hey faster than JB!

1 person likes this