extra/rosetta-code/knapsack/knapsack.factor

   1 ! Copyright (c) 2012 Anonymous
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays io kernel make math math.order
   4 math.parser ranges sequences sorting ;
   5 IN: rosetta-code.knapsack
   6
   7 ! http://rosettacode.org/wiki/Knapsack_problem/0-1
   8
   9 ! A tourist wants to make a good trip at the weekend with his
  10 ! friends. They will go to the mountains to see the wonders of
  11 ! nature, so he needs to pack well for the trip. He has a good
  12 ! knapsack for carrying things, but knows that he can carry a
  13 ! maximum of only 4kg in it and it will have to last the whole
  14 ! day. He creates a list of what he wants to bring for the trip
  15 ! but the total weight of all items is too much. He then decides
  16 ! to add columns to his initial list detailing their weights and a
  17 ! numerical value representing how important the item is for the
  18 ! trip.
  19
  20 ! The tourist can choose to take any combination of items from
  21 ! the list, but only one of each item is available. He may not cut
  22 ! or diminish the items, so he can only take whole units of any
  23 ! item.
  24
  25 ! Which items does the tourist carry in his knapsack so that
  26 ! their total weight does not exceed 400 dag [4 kg], and their
  27 ! total value is maximised?
  28
  29 TUPLE: item
  30     name weight value ;
  31
  32 CONSTANT: items {
  33         T{ item f "map" 9 150 }
  34         T{ item f "compass" 13 35 }
  35         T{ item f "water" 153 200 }
  36         T{ item f "sandwich" 50 160 }
  37         T{ item f "glucose" 15 60 }
  38         T{ item f "tin" 68 45 }
  39         T{ item f "banana" 27 60 }
  40         T{ item f "apple" 39 40 }
  41         T{ item f "cheese" 23 30 }
  42         T{ item f "beer" 52 10 }
  43         T{ item f "suntan cream" 11 70 }
  44         T{ item f "camera" 32 30 }
  45         T{ item f "t-shirt" 24 15 }
  46         T{ item f "trousers" 48 10 }
  47         T{ item f "umbrella" 73 40 }
  48         T{ item f "waterproof trousers" 42 70 }
  49         T{ item f "waterproof overclothes" 43 75 }
  50         T{ item f "note-case" 22 80 }
  51         T{ item f "sunglasses" 7 20 }
  52         T{ item f "towel" 18 12 }
  53         T{ item f "socks" 4 50 }
  54         T{ item f "book" 30 10 }
  55     }
  56
  57 CONSTANT: limit 400
  58
  59 : make-table ( -- table )
  60     items length 1 + [ limit 1 + 0 <array> ] replicate ;
  61
  62 :: iterate ( item-no table -- )
  63     item-no table nth :> prev
  64     item-no 1 + table nth :> curr
  65     item-no items nth :> item
  66     limit [1..b] [| weight |
  67         weight prev nth
  68         weight item weight>> - dup 0 >=
  69         [ prev nth item value>> + max ]
  70         [ drop ] if
  71         weight curr set-nth
  72     ] each ;
  73
  74 : fill-table ( table -- )
  75     [ items length <iota> ] dip
  76     '[ _ iterate ] each ;
  77
  78 :: extract-packed-items ( table -- items )
  79     [
  80         limit :> weight!
  81         items length <iota> <reversed> [| item-no |
  82             item-no table nth :> prev
  83             item-no 1 + table nth :> curr
  84             weight [ curr nth ] [ prev nth ] bi =
  85             [
  86                 item-no items nth
  87                 [ name>> , ] [ weight>> weight swap - weight! ] bi
  88             ] unless
  89         ] each
  90     ] { } make ;
  91
  92 : solve-knapsack ( -- items value )
  93     make-table [ fill-table ]
  94     [ extract-packed-items ] [ last last ] tri ;
  95
  96 : knapsack-main ( -- )
  97     solve-knapsack
  98     "Total value: " write number>string print
  99     "Items packed: " print
 100     natural-sort
 101     [ "   " write print ] each ;
 102
 103 MAIN: knapsack-main