1 ! Copyright (c) 2012 Anonymous
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays fry io kernel locals make math
4 math.order math.parser math.ranges sequences sorting ;
5 IN: rosetta-code.knapsack
7 ! http://rosettacode.org/wiki/Knapsack_problem/0-1
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
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
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?
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 }
59 : make-table ( -- table )
60 items length 1 + [ limit 1 + 0 <array> ] replicate ;
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 |
68 weight item weight>> - dup 0 >=
69 [ prev nth item value>> + max ]
74 : fill-table ( table -- )
75 [ items length <iota> ] dip
78 :: extract-packed-items ( table -- items )
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 =
87 [ name>> , ] [ weight>> weight swap - weight! ] bi
92 : solve-knapsack ( -- items value )
93 make-table [ fill-table ]
94 [ extract-packed-items ] [ last last ] tri ;
96 : knapsack-main ( -- )
98 "Total value: " write number>string print
99 "Items packed: " print
101 [ " " write print ] each ;