Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly
Sign up
Appearance settings

Commit ac0c239

Browse files
committed
Part I completed
1 parent 55973d0 commit ac0c239

File tree

3 files changed

+156
-10
lines changed

3 files changed

+156
-10
lines changed

‎README.md

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,8 @@ My solutions to the exercices provided in the book *Programming in Haskell 2nd E
44

55
## Contents
66

7+
### Part I - Basic concepts
8+
79
1. [Introduction](https://github.com/Forensor/programming-in-haskell-exercices/blob/master/src/Ch1.hs)
810
2. [First steps](https://github.com/Forensor/programming-in-haskell-exercices/blob/master/src/Ch2.hs)
911
3. [Types and classes](https://github.com/Forensor/programming-in-haskell-exercices/blob/master/src/Ch3.hs)
@@ -12,3 +14,4 @@ My solutions to the exercices provided in the book *Programming in Haskell 2nd E
1214
6. [Recursive functions](https://github.com/Forensor/programming-in-haskell-exercices/blob/master/src/Ch6.hs)
1315
7. [Higher-order functions](https://github.com/Forensor/programming-in-haskell-exercices/blob/master/src/Ch7.hs)
1416
8. [Declaring types and classes](https://github.com/Forensor/programming-in-haskell-exercices/blob/master/src/Ch8.hs)
17+
9. [The countdown problem](https://github.com/Forensor/programming-in-haskell-exercices/blob/master/src/Ch9.hs)

‎src/Ch8.hs

Lines changed: 65 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -68,13 +68,68 @@ size :: Expr -> Int
6868
size = folde (const 1) (+)
6969

7070
-- 7. Complete the following instance declarations:
71-
instance Eq a => Eq (Maybe a) where
72-
Nothing == Nothing = True
73-
(Just a) == (Just b) = a == b
74-
_ == _ = False
75-
76-
instance Eq a => Eq [a] where
77-
[] == [] = True
78-
[a] == [b] = a == b
79-
(a:as) == (b:bs) = a == b && as == bs
80-
_ == _ = False
71+
--instance Eq a => Eq (Maybe a) where
72+
-- Nothing == Nothing = True
73+
-- (Just a) == (Just b) = a == b
74+
-- _ == _ = False
75+
76+
--instance Eq a => Eq [a] where
77+
-- [] == [] = True
78+
-- [a] == [b] = a == b
79+
-- (a:as) == (b:bs) = a == b && as == bs
80+
-- _ == _ = False
81+
82+
-- 8. Extend the tautology checker to support the use of logical disjunction and
83+
-- equivalence in propositions.
84+
85+
data Prop
86+
= Const Bool
87+
| Var Char
88+
| Not Prop
89+
| And Prop Prop
90+
| Or Prop Prop
91+
| Imply Prop Prop
92+
| Equiv Prop Prop
93+
94+
type Assoc k v = [(k, v)]
95+
96+
find :: Eq k => k -> Assoc k v -> v
97+
find k t = head [v | (k', v) <- t, k == k']
98+
99+
type Subst = Assoc Char Bool
100+
101+
eval' :: Subst -> Prop -> Bool
102+
eval' _ (Const b) = b
103+
eval' s (Var x) = find x s
104+
eval' s (Not p) = not (eval' s p)
105+
eval' s (And p q) = eval' s p && eval' s q
106+
eval' s (Or p q) = eval' s p || eval' s q
107+
eval' s (Imply p q) = eval' s p <= eval' s q
108+
eval' s (Equiv p q) = eval' s p == eval' s q
109+
110+
vars :: Prop -> [Char]
111+
vars (Const _) = []
112+
vars (Var x) = [x]
113+
vars (Not p) = vars p
114+
vars (And p q) = vars p ++ vars q
115+
vars (Or p q) = vars p ++ vars q
116+
vars (Imply p q) = vars p ++ vars q
117+
vars (Equiv p q) = vars p ++ vars q
118+
119+
bools :: Int -> [[Bool]]
120+
bools 0 = [[]]
121+
bools n = map (False :) bss ++ map (True :) bss
122+
where
123+
bss = bools (n - 1)
124+
125+
rmdups :: Eq a => [a] -> [a]
126+
rmdups [] = []
127+
rmdups (x:xs) = x : rmdups (filter (/= x) xs)
128+
129+
substs :: Prop -> [Subst]
130+
substs p = map (zip vs) (bools (length vs))
131+
where
132+
vs = rmdups (vars p)
133+
134+
isTaut :: Prop -> Bool
135+
isTaut p = and [eval' s p | s <- substs p]

‎src/Ch9.hs

Lines changed: 88 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,88 @@
1+
module Ch9 where
2+
3+
-- 1. Redefine the combinatorial function choices using a list comprehension rather than
4+
-- using composition, concat and map.
5+
subs :: [a] -> [[a]]
6+
subs [] = [[]]
7+
subs (x:xs) = yss ++ map (x:) yss
8+
where yss = subs xs
9+
10+
interleave :: a -> [a] -> [[a]]
11+
interleave x [] = [[x]]
12+
interleave x (y:ys) = (x:y:ys) : map (y:) (interleave x ys)
13+
14+
perms :: [a] -> [[a]]
15+
perms = foldr (concatMap . interleave) [[]]
16+
17+
choices :: [a] -> [[a]]
18+
choices ns = [x | x <- concat (map perms (subs ns))]
19+
20+
-- 2. Define a recursive function isChoice that decides if one list is chosen from
21+
-- another, without using the functions perms and subs.
22+
removeFst :: Eq a => a -> [a] -> [a]
23+
removeFst x [] = []
24+
removeFst x (y:ys) = case x == y of
25+
True -> ys
26+
_ -> y : removeFst x ys
27+
28+
isChoice :: Eq a => [a] -> [a] -> Bool
29+
isChoice (x:xs) [] = False
30+
isChoice (x:xs) ys = elem x ys && isChoice xs (removeFst x ys)
31+
32+
-- 3. What effect would generalising the function split to also return pairs containing
33+
-- the empty list have on the behaivour of solutions.
34+
-- It would cause infinite loops because the length of the list wouldn't be reduced.
35+
36+
-- 4. Using the functions provided, verify that there are 33 665 406 possible expressions
37+
-- over the numbers 1, 3, 7, 10, 25, 50, and that only 4 672 540 of these expressions
38+
-- evaluate successfully.
39+
data Op
40+
= Add
41+
| Sub
42+
| Mul
43+
| Div
44+
45+
data Expr
46+
= Val Int
47+
| App Op Expr Expr
48+
49+
apply :: Op -> Int -> Int -> Int
50+
apply Add x y = x + y
51+
apply Sub x y = x - y
52+
apply Mul x y = x * y
53+
apply Div x y = x `div` y
54+
55+
valid :: Op -> Int -> Int -> Bool
56+
valid Add _ _ = True
57+
valid Sub x y = x > y
58+
valid Mul _ _ = True
59+
valid Div x y = x `mod` y == 0
60+
61+
split :: [a] -> [([a], [a])]
62+
split [] = []
63+
split [_] = []
64+
split (x:xs) = ([x], xs) : [(x : ls, rs) | (ls, rs) <- split xs]
65+
66+
exprs :: [Int] -> [Expr]
67+
exprs [] = []
68+
exprs [n] = [Val n]
69+
exprs ns =
70+
[e | (ls, rs) <- split ns, l <- exprs ls, r <- exprs rs, e <- combine l r]
71+
72+
combine :: Expr -> Expr -> [Expr]
73+
combine l r = [App o l r | o <- [Add, Sub, Mul, Div]]
74+
75+
eval :: Expr -> [Int]
76+
eval (Val n) = [n | n > 0]
77+
eval (App o l r) = [apply o x y | x <- eval l, y <- eval r, valid o x y]
78+
79+
-- These two below take a while to evaluate.
80+
81+
expressions :: Int
82+
expressions = length [x | ns' <- choices [1, 3, 7, 10, 25, 50],
83+
e <- exprs ns',
84+
x <- eval e] -- -> 33 665 406
85+
86+
successful :: Int
87+
successful = length [x | ns' <- choices [1, 3, 7, 10, 25, 50],
88+
x <- exprs ns'] -- -> 4 672 540

0 commit comments

Comments
(0)

AltStyle によって変換されたページ (->オリジナル) /