-
Notifications
You must be signed in to change notification settings - Fork 0
/
countdown.hs
100 lines (77 loc) · 2.56 KB
/
countdown.hs
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
-- Expressions
data Op = Add | Sub | Mul | Div deriving (Show)
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
valid :: Op -> Int -> Int -> Bool
valid Add _ _ = True -- Placeholder _ for anything
valid Sub x y = x > y
valid Mul _ _ = True
valid Div x y = x `mod` y == 0
data Expr = Val Int | App Op Expr Expr deriving (Show)
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]
values :: Expr -> [Int]
values (Val n) = [n]
values (App _ l r) = values l ++ values r
-- First Solver
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 = concat . map perms . subs
split :: [a] -> [([a],[a])]
split [] = []
split [_] = []
split (x:xs) = ([x],xs) : [(x:ls,rs) | (ls,rs) <- split xs]
combine :: Expr -> Expr -> [Expr]
combine l r = [App o l r | o <- [Add,Sub,Mul,Div]]
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]
solution :: Expr -> [Int] -> Int -> Bool -- Problem definition
solution e ns n = elem (values e) (choices ns)
&& eval e == [n]
solutions :: [Int] -> Int -> [Expr] -- Brute Force Solver
solutions ns n = [e | ns' <- choices ns,
e <- exprs ns',
eval e == [n]]
-- Second Solver
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 <- [Add,Sub,Mul,Div],
valid o x y]
solutions' :: [Int] -> Int -> [Expr] -- Improved Solver
solutions' ns n = [e | ns' <- choices ns,
(e,m) <- results ns',
m == n]
-- Function for third solver
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