[Haskell-cafe] xkcd #287 "NP-Complete"
Donald Bruce Stewart
dons at cse.unsw.edu.au
Mon Jul 9 18:50:04 EDT 2007
trebla:
> http://xkcd.com/c287.html
>
> import Data.Array
> import Control.Monad
>
> -- exactly n v
> -- items in v that sum to exactly n
> -- returns list of solutions, each solution list of items
> exactly :: (Real a) => a -> Array Int a -> [[a]]
> exactly 0 v = return []
> exactly n v = do
> i <- indices v
> guard (v!i <= n)
> liftM (v!i :) (exactly (n - v!i) (v `without` i))
> -- for solutions that use items multiple times,
> -- change (v `without` i) to v
>
> -- v `without` i
> -- new array like v except one shorter with v!i missing
> without :: Array Int a -> Int -> Array Int a
> without v i = ixmap (lo, hi-1) f v
> where (lo, hi) = bounds v
> f j | j >= i = j+1
> | otherwise = j
>
> play = exactly 1505 menu
> menu = listArray (1,6) [215, 275, 335, 355, 420, 580]
>
> test = exactly 10 (listArray (1,5) [1,1,2,3,4])
>
> It disappoints me that there is no solution if each item is used at most
> once. However, do change the code to allow multiple uses, then there are
> many solutions.
These smaller NP problems really love the list monad. here's roconnor's
solution from #haskell:
import Control.Monad
menu = [("Mixed Fruit",215),("French Fries",275)
,("Side Salad",335),("Hot Wings",355)
,("Mozzarella Sticks",420),("Sampler Plate",580)]
main = mapM_ print
[ map fst y
| i <- [0..]
, y <- replicateM i menu
, sum (map snd y) == 1505 ]
-- Don
More information about the Haskell-Cafe
mailing list