-
Notifications
You must be signed in to change notification settings - Fork 2
/
chapter10.lhs
211 lines (190 loc) · 8.71 KB
/
chapter10.lhs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
Countdown example from chapter 11 of Programming in Haskell,
Graham Hutton, Cambridge University Press, 2007.
> 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
>
> eval :: Expr -> [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 xs = [zs | ys <- subs xs, zs <- perms ys]
Ex1.)
-----
> removeone :: Eq a => a -> [a] -> [a]
> removeone x [] = []
> removeone x (y:ys)
> | x == y = ys
> | otherwise = y : removeone x ys
Ex2.)
-----
> isChoice :: Eq a => [a] -> [a] -> Bool
> isChoice [] _ = True
> isChoice (x:xs) [] = False
> isChoice (x:xs) ys = elem x ys && isChoice xs (removeone x ys)
Formalising the problem
-----------------------
> solution :: Expr -> [Int] -> Int -> Bool
> solution e ns n = elem (values e) (choices ns) && eval e == [n]
Brute force solution
--------------------
> split :: [a] -> [([a],[a])]
> split [] = []
> split [_] = []
> split (x:xs) = ([x], xs) : [(x:ls, rs) | (ls, rs) <- split xs]
>
> 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 == [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)