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