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 <lemming@henning-thielemann.de> wrote:
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<x,cs<-run (x-c) (dropWhile (/=c) menu)] run 1505 menu -> [[215,215,215,215,215,215,215],[215,355,355,580]]
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<x,cs<-run (x-c) (dropWhile (/=c) menu)] run 1505 menu
-> [[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