104 lines
		
	
	
		
			3.2 KiB
		
	
	
	
		
			Factor
		
	
	
			
		
		
	
	
			104 lines
		
	
	
		
			3.2 KiB
		
	
	
	
		
			Factor
		
	
	
| ! Copyright (c) 2012 Anonymous
 | |
| ! See http://factorcode.org/license.txt for BSD license.
 | |
| USING: accessors arrays fry io kernel locals make math
 | |
| math.order math.parser math.ranges sequences sorting ;
 | |
| IN: rosetta-code.knapsack
 | |
| 
 | |
| ! http://rosettacode.org/wiki/Knapsack_problem/0-1
 | |
| 
 | |
| ! A tourist wants to make a good trip at the weekend with his
 | |
| ! friends. They will go to the mountains to see the wonders of
 | |
| ! nature, so he needs to pack well for the trip. He has a good
 | |
| ! knapsack for carrying things, but knows that he can carry a
 | |
| ! maximum of only 4kg in it and it will have to last the whole
 | |
| ! day. He creates a list of what he wants to bring for the trip
 | |
| ! but the total weight of all items is too much. He then decides
 | |
| ! to add columns to his initial list detailing their weights and a
 | |
| ! numerical value representing how important the item is for the
 | |
| ! trip.
 | |
| 
 | |
| ! The tourist can choose to take any combination of items from
 | |
| ! the list, but only one of each item is available. He may not cut
 | |
| ! or diminish the items, so he can only take whole units of any
 | |
| ! item.
 | |
| 
 | |
| ! Which items does the tourist carry in his knapsack so that
 | |
| ! their total weight does not exceed 400 dag [4 kg], and their
 | |
| ! total value is maximised?
 | |
| 
 | |
| TUPLE: item
 | |
|     name weight value ;
 | |
| 
 | |
| CONSTANT: items {
 | |
|         T{ item f "map" 9 150 }
 | |
|         T{ item f "compass" 13 35 }
 | |
|         T{ item f "water" 153 200 }
 | |
|         T{ item f "sandwich" 50 160 }
 | |
|         T{ item f "glucose" 15 60 }
 | |
|         T{ item f "tin" 68 45 }
 | |
|         T{ item f "banana" 27 60 }
 | |
|         T{ item f "apple" 39 40 }
 | |
|         T{ item f "cheese" 23 30 }
 | |
|         T{ item f "beer" 52 10 }
 | |
|         T{ item f "suntan cream" 11 70 }
 | |
|         T{ item f "camera" 32 30 }
 | |
|         T{ item f "t-shirt" 24 15 }
 | |
|         T{ item f "trousers" 48 10 }
 | |
|         T{ item f "umbrella" 73 40 }
 | |
|         T{ item f "waterproof trousers" 42 70 }
 | |
|         T{ item f "waterproof overclothes" 43 75 }
 | |
|         T{ item f "note-case" 22 80 }
 | |
|         T{ item f "sunglasses" 7 20 }
 | |
|         T{ item f "towel" 18 12 }
 | |
|         T{ item f "socks" 4 50 }
 | |
|         T{ item f "book" 30 10 }
 | |
|     }
 | |
|  
 | |
| CONSTANT: limit 400
 | |
|  
 | |
| : make-table ( -- table )
 | |
|     items length 1 + [ limit 1 + 0 <array> ] replicate ;
 | |
|  
 | |
| :: iterate ( item-no table -- )
 | |
|     item-no table nth :> prev
 | |
|     item-no 1 + table nth :> curr
 | |
|     item-no items nth :> item
 | |
|     limit [1,b] [| weight |
 | |
|         weight prev nth
 | |
|         weight item weight>> - dup 0 >=
 | |
|         [ prev nth item value>> + max ]
 | |
|         [ drop ] if
 | |
|         weight curr set-nth
 | |
|     ] each ;
 | |
| 
 | |
| : fill-table ( table -- )
 | |
|     [ items length iota ] dip
 | |
|     '[ _ iterate ] each ;
 | |
| 
 | |
| :: extract-packed-items ( table -- items )
 | |
|     [
 | |
|         limit :> weight!
 | |
|         items length iota <reversed> [| item-no |
 | |
|             item-no table nth :> prev
 | |
|             item-no 1 + table nth :> curr
 | |
|             weight [ curr nth ] [ prev nth ] bi =
 | |
|             [
 | |
|                 item-no items nth
 | |
|                 [ name>> , ] [ weight>> weight swap - weight! ] bi
 | |
|             ] unless
 | |
|         ] each
 | |
|     ] { } make ;
 | |
| 
 | |
| : solve-knapsack ( -- items value )
 | |
|     make-table [ fill-table ]
 | |
|     [ extract-packed-items ] [ last last ] tri ;
 | |
| 
 | |
| : knapsack-main ( -- )
 | |
|     solve-knapsack
 | |
|     "Total value: " write number>string print
 | |
|     "Items packed: " print
 | |
|     natural-sort
 | |
|     [ "   " write print ] each ;
 | |
| 
 | |
| MAIN: knapsack-main
 |