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 2b68f3b

Browse files
committed
Added Ch14
1 parent c67c864 commit 2b68f3b

File tree

3 files changed

+98
-20
lines changed

3 files changed

+98
-20
lines changed

‎README.md

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -22,6 +22,7 @@ My solutions to the exercices provided in the book *Programming in Haskell 2nd E
2222
11. [Unbeatable tic-tac-toe](https://github.com/Forensor/programming-in-haskell-exercices/blob/master/src/Ch11.hs)
2323
12. [Monads and more](https://github.com/Forensor/programming-in-haskell-exercices/blob/master/src/Ch12.hs)
2424
13. [Monadic parsing](https://github.com/Forensor/programming-in-haskell-exercices/blob/master/src/Ch13.hs)
25+
14. [Foldables and friends](https://github.com/Forensor/programming-in-haskell-exercices/blob/master/src/Ch14.hs)
2526

2627
### Additionals
2728

‎src/Ch14.hs

Lines changed: 67 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,67 @@
1+
module Ch14 where
2+
3+
import Data.Foldable
4+
5+
-- 1. Complete the following instance declaration from Data.Monoid to make a pair type
6+
-- into a monoid provided the two component types are monoids:
7+
-- instance (Monoid a, Monoid b) => Monoid (a, b) where
8+
-- mempty = (mempty, mempty)
9+
-- (x1, y1) `mappend` (x2, y2) = (x1 `mappend` x2, y1 `mappend` y2)
10+
11+
-- 2. In a similar manner, show how a function type a -> b can be made into a monoid
12+
-- provided that the result type b is a monoid.
13+
-- instance Monoid b => Monoid (a -> b) where
14+
-- mempty = const mempty
15+
-- fl `mappend` fr = \x -> fl x `mappend` fr x
16+
17+
-- 3. Show how the Maybe type can be made foldable and traversable, by giving explicit
18+
-- definitions for fold, foldMap, foldr, foldl and traverse.
19+
-- instance Foldable Maybe where
20+
-- fold Nothing = mempty
21+
-- fold (Just a) = a
22+
23+
-- foldMap _ Nothing = mempty
24+
-- foldMap f (Just a) = f a
25+
26+
-- foldr _ _ Nothing = mempty
27+
-- foldr f v (Just a) = f a v
28+
29+
-- foldl _ _ Nothing = mempty
30+
-- foldl f v (Just b) = f v b
31+
32+
-- instance Traversable Maybe where
33+
-- traverse g Nothing = pure Nothing
34+
-- traverse g (Just a) = Just <$> g a
35+
36+
-- 4. In a similar manner, show how the following type of binary trees with data in their
37+
-- nodes can be made into a foldable and traversable type:
38+
data Tree a
39+
= Leaf
40+
| Node (Tree a) a (Tree a)
41+
deriving (Show)
42+
43+
instance Functor Tree where
44+
fmap g Leaf = Leaf
45+
fmap g (Node l x r) = Node (fmap g l) (g x) (fmap g r)
46+
47+
instance Foldable Tree where
48+
fold Leaf = mempty
49+
fold (Node l a r) = fold l `mappend` a `mappend` fold r
50+
51+
foldMap _ Leaf = mempty
52+
foldMap f (Node l a r) = foldMap f l `mappend` f a `mappend` foldMap f r
53+
54+
foldr _ v Leaf = v
55+
foldr f v (Node l a r) = foldr f (foldr f (f a v) r) l
56+
57+
foldl _ v Leaf = v
58+
foldl f v (Node l b r) = foldl f (foldl f (f v b) l) r
59+
60+
instance Traversable Tree where
61+
traverse g Leaf = pure Leaf
62+
traverse g (Node l a r) = Node <$> traverse g l <*> g a <*> traverse g r
63+
64+
-- 5. Using foldMap, define a generic version of the higher-order function filter on
65+
-- lists that can be used with any foldable type:
66+
filterF :: Foldable t => (a -> Bool) -> t a -> [a]
67+
filterF f = foldMap (\x -> if f x then [x] else mempty)

‎src/GameOfLife.hs

Lines changed: 30 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,8 @@
11
module GameOfLife where
22

33
import Control.Concurrent (threadDelay)
4-
import System.Process (system)
54
import GHC.IO.Exception (ExitCode)
5+
import System.Process (system)
66

77
height :: Int
88
height = 30
@@ -21,43 +21,53 @@ type Grid = [Pos]
2121
-- PRE-BUILT GRIDS --
2222

2323
gliderCol :: Grid
24-
gliderCol = [(0,2),(1,0),(1,2),(2,1),(2,2),(3,11),(4,9),(4,10),(5,10),(5,11)]
24+
gliderCol = [(0,2),(1,0),(1,2),(2,1),(2,2),(3,11),(4,9),(4,10),(5,10),(5,11)]
2525

2626
glider :: Grid
27-
glider = [(0,2),(1,0),(1,2),(2,1),(2,2)]
27+
glider = [(0,2),(1,0),(1,2),(2,1),(2,2)]
2828

2929
ship :: Grid
30-
ship = [(0,0),(0,3),(1,4),(2,0),(2,4),(3,1),(3,2),(3,3),(3,4)]
30+
ship = [(0,0),(0,3),(1,4),(2,0),(2,4),(3,1),(3,2),(3,3),(3,4)]
3131

3232
-- PRE-BUILT GRIDS --
3333

3434
showPos :: Pos -> Grid -> Char
35-
showPos pos grid | pos `elem` grid = '0'
36-
| otherwise = ' '
35+
showPos pos grid
36+
| pos `elem` grid = '0'
37+
| otherwise = ' '
3738

3839
rowLines :: String -> String
39-
rowLines "" = ""
40+
rowLines "" = ""
4041
rowLines gridStr = take width gridStr ++ "\n" ++ rowLines (drop width gridStr)
4142

4243
showGrid :: Grid -> String
43-
showGrid grid = rowLines [showPos (r,c) grid | r <- [0..(height - 1)],
44-
c <- [0..(width - 1)]]
44+
showGrid grid =
45+
rowLines
46+
[ showPos (r, c) grid | r <- [0 .. (height - 1)], c <- [0 .. (width - 1)]
47+
]
4548

4649
neighbors :: Pos -> [Pos]
47-
neighbors (r,c) = [(r-1,c-1),(r-1,c),(r-1,c+1),
48-
(r,c-1) ,(r,c+1),
49-
(r+1,c-1),(r+1,c),(r+1,c+1)]
50+
neighbors (r, c) =
51+
[ (r - 1, c - 1),
52+
(r - 1, c),
53+
(r - 1, c + 1),
54+
(r, c - 1),
55+
(r, c + 1),
56+
(r + 1, c - 1),
57+
(r + 1, c),
58+
(r + 1, c + 1)
59+
]
5060

5161
livingNeighs :: Pos -> Grid -> Int
5262
livingNeighs pos grid = length $ filter (`elem` grid) (neighbors pos)
5363

5464
survivors :: Grid -> Grid
55-
survivors grid = filter (\x -> livingNeighs x grid `elem` [2,3]) grid
65+
survivors grid = filter (\x -> livingNeighs x grid `elem` [2,3]) grid
5666

5767
births :: Grid -> Grid
58-
births grid = [(r,c) | r <- [0..(height -1)],
59-
c <- [0..(width - 1)],
60-
livingNeighs (r,c) grid ==3&& (r,c) `notElem` grid]
68+
births grid =
69+
[ (r, c) | r <- [0.. (height -1)], c <- [0..(width - 1)], livingNeighs (r, c) grid ==3&& (r, c) `notElem` grid
70+
]
6171

6272
nextGen :: Grid -> Grid
6373
nextGen grid = survivors grid ++ births grid
@@ -67,10 +77,10 @@ cls = system "cls"
6777

6878
play :: Grid -> IO ()
6979
play grid = do
70-
cls
71-
putStr $ showGrid grid
72-
threadDelay $ speed*10^3
73-
play $ nextGen grid
80+
cls
81+
putStr $ showGrid grid
82+
threadDelay $ speed*10^3
83+
play $ nextGen grid
7484

7585
-- Choose any pre-built grid or customize your own!
7686
main :: IO ()

0 commit comments

Comments
(0)

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