Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: bplus on October 05, 2020, 11:49:01 am

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

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

I traded out beer for xtra_paper so that all the stuff still fits on default screen 0.
  [ This attachment cannot be displayed inline in 'Print Page' view ]  
Title: Re: Knapsack Problem/0-1 - Rosetta Code
Post by: bplus 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]
  1. _TITLE "Shopping Cart Mod of Knapsack Problem/0-1  from Rosetta Code" ' b+ 2020-10-14
  2. ' mod from: "Knapsack problem/0-1 - Rosetta Code Better Solution" 'b+
  3. ' ref:  http://rosettacode.org/wiki/Knapsack_problem/0-1
  4.  
  5. ' 2020-10-04 post Knapsack - Rosetta Code.bas
  6. ' https://www.qb64.org/forum/index.php?topic=3091.msg123665#msg123665
  7.  
  8. ' 2020-10-13 Knapsack better soln 2020-10-13 Rosetta Code
  9. ' swap DATA beer,52,10 for DATA xtra_paper,3,1 to trip up original code solution and test better code soln.
  10. ' note: need to keep number at 22 to fit default screen 0.
  11. ' post  https://www.qb64.org/forum/index.php?topic=3091.msg123962#msg123962
  12.  
  13. ' 2020-10-14 Shopping Cart Mod bplus Knapsack solution sucks!
  14. ' It will not serve as a general solution or method to approach problems like this.
  15. ' The DATA just happens to work well with sort and pick method
  16.  
  17.  
  18. ' ========================= Here is a counter example with 100 weight limit  =======================
  19. DATA ham,20,25
  20. DATA crackers,100,100
  21. DATA ice cream,20,9
  22. DATA potatoes,70,66
  23. DATA beans,30,17
  24. DATA carrots,20,19
  25. DATA cookies,10,5
  26.  
  27. ' Obviously you should pickup the crackers only!
  28. ' Make the 100 weight limit with a carry out value of 100!
  29. '===================================================================================================
  30. TYPE item
  31.     name AS STRING
  32.     weight AS SINGLE
  33.     value AS SINGLE
  34.     vPerW AS SINGLE ' value Per Weight
  36. REDIM it(0) AS item, insert AS item
  37. FOR i = 1 TO 7
  38.     READ insert.name, insert.weight, insert.value
  39.     insert.vPerW = insert.value / insert.weight
  40.     loadSort insert, it()
  42. PRINT "              *** Shopping Cart Items Sorted by Value Per Unit Weight ***"
  43. PRINT " #: Item:         Wght:  Val:   V/W:    Packed or Not:  Accum w: Value Packed:"
  44. FOR i = 1 TO 7
  45.     IF totW + it(i).weight <= 100 THEN
  46.         pack = -1: totW = totW + it(i).weight: totV = totV + it(i).value
  47.     ELSE
  48.         pack = 0
  49.     END IF
  50.     PRINT RIGHT$(SPC(3) + STR$(i), 3); SPC(1);
  51.     PRINT LEFT$(it(i).name + SPC(15), 15);
  52.     PRINT RIGHT$(SPC(4) + STR$(it(i).weight), 4);
  53.     PRINT RIGHT$(SPC(6) + STR$(it(i).value), 6);
  54.     PRINT RIGHT$(SPC(7) + STR$(INT(it(i).vPerW * 100) / 100), 7);
  55.     IF pack THEN
  56.         PRINT SPC(8); "Packed!"; SPC(4);
  57.         PRINT RIGHT$(SPC(9) + STR$(totW), 9);
  58.         PRINT RIGHT$(SPC(14) + STR$(totV), 14);
  59.     ELSE
  60.         PRINT SPC(5); "Not included.";
  61.     END IF
  62.     IF i < 7 THEN PRINT
  65.  
  66. 'DATA "ham,20,25"
  67. 'DATA "crackers,100,100"
  68. 'DATA "ice cream,20,9"
  69. 'DATA "potatoes,70,66"
  70. 'DATA "beans,30,17"
  71. 'DATA "carrots,20,19"
  72. 'DATA "cookies,10,5"
  73.  
  74. SUB loadSort (insertN AS item, dynArr() AS item) '  modified for this code
  75.     'note this leaves dynArr(0) empty! so ubound of array is also number of items in list
  76.     DIM ub, j, k
  77.     ub = UBOUND(dynArr) + 1
  78.     REDIM _PRESERVE dynArr(LBOUND(dynArr) TO ub) AS item
  79.     FOR j = 1 TO ub - 1
  80.         IF insertN.vPerW > dynArr(j).vPerW THEN '  GT to LT according to descending or ascending sort
  81.             FOR k = ub TO j + 1 STEP -1
  82.                 dynArr(k) = dynArr(k - 1)
  83.             NEXT
  84.             EXIT FOR
  85.         END IF
  86.     NEXT
  87.     dynArr(j) = insertN
  89.  
  90.  


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

 
Title: Re: Knapsack Problem/0-1 - Rosetta Code
Post by: bplus 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]
  1. _TITLE "Knapsack problem/0-1 Combo Method Solve" 'Revised 2020-10-15.txt b+
  2. ' http://rosettacode.org/wiki/Knapsack_problem/0-1
  3. ' Found Knapsack problem posed by bluatigro and fixed 2016-07-23 at old JB Forum.
  4. ' This code follows that fixed method.
  5. DEFLNG A-Z
  6. maxWeight = 400 'for problem
  7. maxItems = 22 'for data reading and array dimensions 8,388,608 combinations!
  8. topItemsIndex = maxItems - 1
  9. DIM item$(topItemsIndex), w(topItemsIndex), v(topItemsIndex)
  10. FOR i = 0 TO topItemsIndex
  11.     READ i$, ww, vv
  12.     item$(i) = i$: w(i) = ww: v(i) = vv
  14. topComboIndex = 2 ^ maxItems - 1
  15. FOR combo = 0 TO topComboIndex
  16.     testList$ = "": testValue = 0: testWeight = 0
  17.     FOR power = 0 TO topItemsIndex
  18.         IF combo AND 2 ^ power THEN
  19.             IF testList$ = "" THEN testList$ = item$(power) ELSE testList$ = testList$ + CHR$(10) + item$(power)
  20.             testValue = testValue + v(power)
  21.             testWeight = testWeight + w(power)
  22.         END IF
  23.     NEXT
  24.     IF testWeight <= maxWeight AND testValue >= MaxValue THEN
  25.         MaxValue = testValue
  26.         saveCombo = combo
  27.         saveList$ = testList$
  28.         saveWeight = testWeight
  29.     END IF
  30.     IF combo MOD 1000 = 0 THEN LOCATE 1, 1: PRINT SPACE$(20): LOCATE 1, 1: PRINT combo 'progress
  33. PRINT "Best value found <= "; maxWeight; " was:"
  34. PRINT saveList$
  35. PRINT: PRINT "Total weight: "; saveWeight; "  Total value: "; MaxValue
  36.  
  37. DATA "map",9,150
  38. DATA "compass",13,35
  39. DATA "water",153,200
  40. DATA "sandwich",50,160
  41. DATA "glucose",15,60
  42. DATA "tin",68,45
  43. DATA "banana",27,60
  44. DATA "apple",39,40
  45. DATA "cheese",23,30
  46. DATA "beer",52,10
  47. DATA "suntan cream",11,70
  48. DATA "camera",32,30
  49. DATA "T-shirt",24,15
  50. DATA "trousers",48,10
  51. DATA "umbrella",73,40
  52. DATA "WP_trousers",42,70
  53. DATA "WP_wear",43,75
  54. DATA "note-case",22,80
  55. DATA "sunglasses",7,20
  56. DATA "towel",18,12
  57. DATA "socks",4,50
  58. DATA "book",30,10
  59.  

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.
Text Only | Text with Attachments