Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
countdown template for FP101x using Maybe instead of list
> {-# LANGUAGE MonadComprehensions #-}
Countdown example from chapter 11 of Programming in Haskell,
Graham Hutton, Cambridge University Press, 2007.
Modified to use Maybe instead of lists
> import System.CPUTime
> import Numeric
> import System.IO
Expressions
-----------
> data Op = Add | Sub | Mul | Div
> valid :: Op -> Int -> Int -> Bool
> valid Add _ _ = True
> valid Sub x y = x > y
> valid Mul _ _ = True
> valid Div x y = x `mod` y == 0
> apply :: Op -> Int -> Int -> Int
> apply Add x y = x + y
> apply Sub x y = x - y
> apply Mul x y = x * y
> apply Div x y = x `div` y
> data Expr = Val Int | App Op Expr Expr
> values :: Expr -> [Int]
> values (Val n) = [n]
> values (App _ l r) = values l ++ values r
Instead of lists to indicate success of failure we gonna use
maybe. Thanks to *MonadComprehensions* this is really the same as with lists
> eval :: Expr -> Maybe Int
> eval (Val n) = [n | n > 0]
> eval (App o l r) = [apply o x y | x <- eval l
> , y <- eval r
> , valid o x y]
Combinatorial functions
-----------------------
> subs :: [a] -> [[a]]
> subs [] = [[]]
> subs (x:xs) = yss ++ map (x:) yss
> where yss = subs xs
> interleave :: a -> [a] -> [[a]]
> interleave x [] = [[x]]
> interleave x (y:ys) = (x:y:ys) : map (y:) (interleave x ys)
> perms :: [a] -> [[a]]
> perms [] = [[]]
> perms (x:xs) = concat (map (interleave x) (perms xs))
> choices :: [a] -> [[a]]
> choices = undefined
Formalising the problem
-----------------------
> solution :: Expr -> [Int] -> Int -> Bool
> solution e ns n = elem (values e) (choices ns) && eval e == return n
Brute force solution
--------------------
> split :: [a] -> [([a],[a])]
> split = undefined
> exprs :: [Int] -> [Expr]
> exprs [] = []
> exprs [n] = [Val n]
> exprs ns = [e | (ls,rs) <- split ns
> , l <- exprs ls
> , r <- exprs rs
> , e <- combine l r]
>
> combine :: Expr -> Expr -> [Expr]
> combine l r = [App o l r | o <- ops]
> ops :: [Op]
> ops = [Add,Sub,Mul,Div]
> solutions :: [Int] -> Int -> [Expr]
> solutions ns n = [e | ns' <- choices ns
> , e <- exprs ns'
> , eval e == return n]
Combining generation and evaluation
-----------------------------------
> type Result = (Expr,Int)
> results :: [Int] -> [Result]
> results [] = []
> results [n] = [(Val n,n) | n > 0]
> results ns = [res | (ls,rs) <- split ns
> , lx <- results ls
> , ry <- results rs
> , res <- combine' lx ry]
> combine' :: Result -> Result -> [Result]
> combine' (l,x) (r,y) = [(App o l r, apply o x y) | o <- ops
> , valid o x y]
> solutions' :: [Int] -> Int -> [Expr]
> solutions' ns n = [e | ns' <- choices ns
> , (e,m) <- results ns'
> , m == n]
Exploiting numeric properties
-----------------------------
> valid' :: Op -> Int -> Int -> Bool
> valid' Add x y = x <= y
> valid' Sub x y = x > y
> valid' Mul x y = x /= 1 && y /= 1 && x <= y
> valid' Div x y = y /= 1 && x `mod` y == 0
> results' :: [Int] -> [Result]
> results' [] = []
> results' [n] = [(Val n,n) | n > 0]
> results' ns = [res | (ls,rs) <- split ns
> , lx <- results' ls
> , ry <- results' rs
> , res <- combine'' lx ry]
> combine'' :: Result -> Result -> [Result]
> combine'' (l,x) (r,y) = [(App o l r, apply o x y) | o <- ops
> , valid' o x y]
> solutions'' :: [Int] -> Int -> [Expr]
> solutions'' ns n = [e | ns' <- choices ns
> , (e,m) <- results' ns'
> , m == n]
Interactive version for testing
-------------------------------
> instance Show Op where
> show Add = "+"
> show Sub = "-"
> show Mul = "*"
> show Div = "/"
> instance Show Expr where
> show (Val n) = show n
> show (App o l r) = bracket l ++ show o ++ bracket r
> where
> bracket (Val n) = show n
> bracket e = "(" ++ show e ++ ")"
> showtime :: Integer -> String
> showtime t = showFFloat (Just 3)
> (fromIntegral t / (10^12)) " seconds"
> display :: [Expr] -> IO ()
> display es = do t0 <- getCPUTime
> if null es then
> do t1 <- getCPUTime
> putStr "\nThere are no solutions, verified in "
> putStr (showtime (t1 - t0))
> else
> do t1 <- getCPUTime
> putStr "\nOne possible solution is "
> putStr (show (head es))
> putStr ", found in "
> putStr (showtime (t1 - t0))
> putStr "\n\nPress return to continue searching..."
> getLine
> putStr "\n"
> t2 <- getCPUTime
> if null (tail es) then
> putStr "There are no more solutions"
> else
> do sequence [print e | e <- tail es]
> putStr "\nThere were "
> putStr (show (length es))
> putStr " solutions in total, found in "
> t3 <- getCPUTime
> putStr (showtime ((t1 - t0) + (t3 - t2)))
> putStr ".\n\n"
> main :: IO ()
> main = do hSetBuffering stdout NoBuffering
> putStrLn "\nCOUNTDOWN NUMBERS GAME SOLVER"
> putStrLn "-----------------------------\n"
> putStr "Enter the given numbers : "
> ns <- readLn
> putStr "Enter the target number : "
> n <- readLn
> display (solutions'' ns n)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.