
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.

trebla:
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

On Tue, 10 Jul 2007, Donald Bruce Stewart wrote:
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 ]
Shouldn't we stay away from integer indices on lists? [ map fst y | y <- concat (iterate (liftM2 (:) menu) [[]]), sum (map snd y) == 1505]

lemming:
On Tue, 10 Jul 2007, Donald Bruce Stewart wrote:
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 ]
Shouldn't we stay away from integer indices on lists?
[ map fst y | y <- concat (iterate (liftM2 (:) menu) [[]]), sum (map snd y) == 1505]
Also, wouldn't it be nice to bring back monad comprehensions... Bring them back! No one's scared any more! -- Don

This is a compact solution, but it produces multiple permutations of the
same solution, which increases runtime. I let it run for 10 seconds, then
ctrl-c'd.
Here's a solution that produces all 2 (or three, if you include Barbecue
Sandwich) solutions instantly:
Output:
=====
*Xkcd287> go
Menu 1
******
Mixed Fruit ($2.15) x 7
Total: 15.05
Menu 2
******
Hot Wings ($3.55) x 2
Mixed Fruit ($2.15) x 1
Sample Plate ($5.8) x 1
Total: 15.05
Menu 3
******
Barbecue Sandwich ($6.55) x 1
Mixed Fruit ($2.15) x 2
Mozzarella Sticks ($4.2) x 1
Total: 15.05
*Xkcd287>
Sourcecode:
=========
module Xkcd287
where
import Char
import IO
import GHC.Float
import List
import qualified Data.Map as Map
import Control.Monad
import Control.Monad.State
import Control.Monad.Reader
import Control.Monad.Writer
menu :: [(String,Int)]
menu = [("Mixed Fruit", 215),
("French Fries", 275),
("Side Salad", 335),
("Hot Wings", 355),
("Mozzarella Sticks", 420),
("Sample Plate", 580),
("Barbecue Sandwich", 655) ]
cost:: Int
cost = 1505
solutions :: [(String,Int)] -> Int -> [[(String,Int)]]
solutions menu targetcost = [ solution | solution <- solutions' menu []
targetcost ]
solutions' :: [(String,Int)] -> [(String,Int)] -> Int -> [[(String,Int)]]
solutions' menu itemssofar targetcost | targetcost == 0 = [itemssofar]
| otherwise = [ solution | item <-
menu,
(null
itemssofar) || ((snd item) <= snd(head itemssofar)),
(snd item)
<= targetcost,
solution <-
solutions' menu (item:itemssofar) (targetcost - (snd item) ) ]
synthesize :: [[(String,Int)]] -> [[(String,Int,Int)]]
synthesize solutions = [ synthesize' solution | solution <- solutions ]
synthesize' :: [(String,Int)] -> [(String,Int,Int)]
synthesize' solution = [ (name,value,count) | (name,(value,count)) <-
synthesize'' ]
where synthesize'' :: [(String,(Int,Int))]
synthesize'' = Map.toList $ foldr (\(name,value) thismap ->
(process name value (Map.lookup name thismap) thismap) ) Map.empty solution
process :: String -> Int -> Maybe (Int,Int) -> Map.Map String
(Int,Int) -> Map.Map String (Int,Int)
process name value Nothing thismap = Map.insert name (value,1 )
thismap
process name value (Just(value',count)) thismap =
Map.adjust(\(oldvalue,oldcount) -> (oldvalue,oldcount + 1)) name
thismap
createbilling :: [[(String,Int,Int)]] -> [String]
createbilling solutions = [ line | (solution,i) <- (zip solutions [1..]),
line <- ["Menu " ++ show(i), "******"] ++
createbilling' solution ++
["Total: " ++ show( (int2Double $
foldr (\(name,value,count) total -> (total + (value * count)) ) 0 solution )
/ 100) ] ++
[""]
]
createbilling' :: [(String,Int,Int)] -> [String]
createbilling' solution = [ name ++ " ($" ++ show((int2Double value) / 100.0)
++ ") x " ++ show(count) | (name,value,count) <- solution ]
go' :: [[(String,Int,Int)]]
go' = synthesize $ solutions menu cost
go :: IO ()
go = mapM_ putStrLn (createbilling $ go' )
On 7/10/07, Henning Thielemann
On Tue, 10 Jul 2007, Donald Bruce Stewart wrote:
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 ]
Shouldn't we stay away from integer indices on lists?
[ map fst y | y <- concat (iterate (liftM2 (:) menu) [[]]), sum (map snd y) == 1505] _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Am Dienstag, 10. Juli 2007 00:25 schrieb Albert Y. C. Lai:
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.
i see only two solutions.
let menu = [215, 275, 335, 355, 420, 580]
let run x menu = [[c]|c<-menu,c==x]++[c:cs|c<-menu,c

Marc A. Ziegert wrote:
i see only two solutions.
let menu = [215, 275, 335, 355, 420, 580] let run x menu = [[c]|c<-menu,c==x]++[c:cs|c<-menu,c
-> [[215,215,215,215,215,215,215],[215,355,355,580]]
You are right, I saw many solutions but they were all equivalent to just those two. I did not avoid permutation-induced redundancy. I was unsure how to eliminate that redundancy. After reading your algorithm, I see it. Here is my algorithm modified. import Data.List 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 -> [a] -> [[a]] exactly 0 v = return [] exactly n v = do w@(c:w') <- tails v guard (c <= n) liftM (c :) (exactly (n - c) w) -- for solutions that use items at most once, -- change w to w' play = exactly 1505 menu menu = [215, 275, 335, 355, 420, 580]

By the way, if you enjoy these problems, there are tons of these at topcoder.com I cant help thinking it'd be neat to have topcoder-like competitions for Haskell, either by pursuading topcoder to integrate support for Haskell, or hosting our own.

On Tue, 10 Jul 2007, Hugh Perkins wrote:
By the way, if you enjoy these problems, there are tons of these at topcoder.com I cant help thinking it'd be neat to have topcoder-like competitions for Haskell, either by pursuading topcoder to integrate support for Haskell, or hosting our own.
Is this related to http://www.haskell.org/haskellwiki/Great_language_shootout ?

Henning Thielemann wrote:
On Tue, 10 Jul 2007, Hugh Perkins wrote:
By the way, if you enjoy these problems, there are tons of these at topcoder.com I cant help thinking it'd be neat to have topcoder-like competitions for Haskell, either by pursuading topcoder to integrate support for Haskell, or hosting our own.
Is this related to http://www.haskell.org/haskellwiki/Great_language_shootout ?
No. topcoder is a competition between programmers, a programming contest. A question is posed, then 20 minutes later or something, see whose code has fewer bugs. It's web site is www.topcoder.com

Albert Y. C. Lai wrote:
You are right, I saw many solutions but they were all equivalent to just those two. I did not avoid permutation-induced redundancy.
I was unsure how to eliminate that redundancy. After reading your algorithm, I see it. Here is my algorithm modified.
In general, I find this kind of stuff really hard to avoid... :-S (Or rather, avoid efficiently.)

There's a good tutorial on pruning at: http://www.cs.nott.ac.uk/~gmh/book.html (Section "Slides", number 11) In general, I find this kind of stuff really hard to avoid... :-S

Hugh Perkins wrote:
There's a good tutorial on pruning at:
http://www.cs.nott.ac.uk/~gmh/book.html http://www.cs.nott.ac.uk/%7Egmh/book.html (Section "Slides", number 11)
In general, I find this kind of stuff really hard to avoid... :-S
...and indeed, countdown was what I was attempting to solve... o_O

Hugh Perkins wrote:
There's a good tutorial on pruning at:
http://www.cs.nott.ac.uk/~gmh/book.html http://www.cs.nott.ac.uk/%7Egmh/book.html (Section "Slides", number 11)
Aaahhhh... Interesting. Check each subexpression for validity at every stage of the process. I hadn't thought of that. (I was trying to generate only algebraicly distinct expressions by construction rather than by filtering - and it's really hard to make *all* expressions such that you don't miss or duplicate anything...) Thanks for the link!
participants (6)
-
Albert Y. C. Lai
-
Andrew Coppin
-
dons@cse.unsw.edu.au
-
Henning Thielemann
-
Hugh Perkins
-
Marc A. Ziegert