factor/extra/rosetta-code/knapsack-unbounded/knapsack-unbounded.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 ;