69 lines
		
	
	
		
			2.1 KiB
		
	
	
	
		
			Factor
		
	
	
		
		
			
		
	
	
			69 lines
		
	
	
		
			2.1 KiB
		
	
	
	
		
			Factor
		
	
	
| 
								 | 
							
								! Copyright (c) 2012 Anonymous
							 | 
						||
| 
								 | 
							
								! See http://factorcode.org/license.txt for BSD license.
							 | 
						||
| 
								 | 
							
								USING: accessors combinators kernel locals math math.order
							 | 
						||
| 
								 | 
							
								math.vectors sequences sequences.product combinators.short-circuit ;
							 | 
						||
| 
								 | 
							
								IN: rosetta-code.knapsack-unbounded
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								! http://rosettacode.org/wiki/Knapsack_problem/Unbounded
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								! A traveller gets diverted and has to make an unscheduled stop
							 | 
						||
| 
								 | 
							
								! in what turns out to be Shangri La. Opting to leave, he is
							 | 
						||
| 
								 | 
							
								! allowed to take as much as he likes of the following items, so
							 | 
						||
| 
								 | 
							
								! long as it will fit in his knapsack, and he can carry it. He
							 | 
						||
| 
								 | 
							
								! knows that he can carry no more than 25 'weights' in total; and
							 | 
						||
| 
								 | 
							
								! that the capacity of his knapsack is 0.25 'cubic lengths'.
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								! Looking just above the bar codes on the items he finds their
							 | 
						||
| 
								 | 
							
								! weights and volumes. He digs out his recent copy of a financial
							 | 
						||
| 
								 | 
							
								! paper and gets the value of each item.
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								! He can only take whole units of any item, but there is much
							 | 
						||
| 
								 | 
							
								! more of any item than he could ever carry
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								! How many of each item does he take to maximise the value of
							 | 
						||
| 
								 | 
							
								! items he is carrying away with him?
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								! Note:
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								! There are four solutions that maximise the value taken. Only
							 | 
						||
| 
								 | 
							
								! one need be given.
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								CONSTANT: values { 3000 1800 2500 }
							 | 
						||
| 
								 | 
							
								CONSTANT: weights { 0.3 0.2 2.0 }
							 | 
						||
| 
								 | 
							
								CONSTANT: volumes { 0.025 0.015 0.002 }
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								CONSTANT: max-weight 25.0
							 | 
						||
| 
								 | 
							
								CONSTANT: max-volume 0.25
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								TUPLE: bounty amounts value weight volume ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								: <bounty> ( items -- bounty )
							 | 
						||
| 
								 | 
							
								    [ bounty new ] dip {
							 | 
						||
| 
								 | 
							
								        [ >>amounts ]
							 | 
						||
| 
								 | 
							
								        [ values v. >>value ]
							 | 
						||
| 
								 | 
							
								        [ weights v. >>weight ]
							 | 
						||
| 
								 | 
							
								        [ volumes v. >>volume ]
							 | 
						||
| 
								 | 
							
								    } cleave ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								: valid-bounty? ( bounty -- ? )
							 | 
						||
| 
								 | 
							
								    { [ weight>> max-weight <= ]
							 | 
						||
| 
								 | 
							
								      [ volume>> max-volume <= ] } 1&& ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								M:: bounty <=> ( a b -- <=> )
							 | 
						||
| 
								 | 
							
								    a valid-bounty? [
							 | 
						||
| 
								 | 
							
								        b valid-bounty? [
							 | 
						||
| 
								 | 
							
								            a b [ value>> ] compare
							 | 
						||
| 
								 | 
							
								        ] [ +gt+ ] if
							 | 
						||
| 
								 | 
							
								    ] [ b valid-bounty? +lt+ +eq+ ? ] if ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								: find-max-amounts ( -- amounts )
							 | 
						||
| 
								 | 
							
								    weights volumes [
							 | 
						||
| 
								 | 
							
								        [ max-weight swap / ]
							 | 
						||
| 
								 | 
							
								        [ max-volume swap / ] bi* min >integer
							 | 
						||
| 
								 | 
							
								    ] 2map ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								: best-bounty ( -- bounty )
							 | 
						||
| 
								 | 
							
								    find-max-amounts [ 1 + iota ] map <product-sequence>
							 | 
						||
| 
								 | 
							
								    [ <bounty> ] [ max ] map-reduce ;
							 | 
						||
| 
								 | 
							
								
							 |