Thinking Functionally with Haskell (43 page)

BOOK: Thinking Functionally with Haskell
10.96Mb size Format: txt, pdf, ePub

The function
join :: m (m a) -> m a
flattens two layers of monadic structure into one. Define
join
in terms of
>>=
. What familiar functions do
join
and
liftM
give for the list monad?

Finally, using
join
and
liftM
, define
(>>=)
. It follows that instead of defining monads in terms of
return
and
>>=
, we can also define them in terms of
return
,
liftM
and
join
.

Exercise E

A number of useful monadic functions are provided in the
Control.Monad
library. For instance:

sequence_ :: Monad m => [m a] -> m ()

sequence_ = foldr (>>) done

(The underscore convention is used in a number of places in Haskell to signify that the result of the action is the null tuple.) Define the related function
sequence :: Monad m => [m a] -> m [a]

Using these two functions, define

mapM_ :: Monad m => (a -> m b) -> [a] -> m ()

mapM :: Monad m => (a -> m b) -> [a] -> m [b]

Also, define

foldM :: Monad m => (b -> a -> m b) -> b -> [a] -> m b
In the text we made use of a function
repeatFor n
that repeated an action
n
times. Generalise this function to
for_ :: Monad m => [a] -> (a -> m b) -> m ()

Exercise F

Here is an exercise in monadic equational reasoning. Consider the function

add :: Int -> State Int ()

add n = do {m <- get; put (m+n)}

The task is to prove that

sequence_ . map add = add . sum

where
sequence_
was defined in the previous exercise and
sum
sums a list of integers. You will need the fusion law of
foldr
, some simple laws of
put
and
get
, and the monad law
do {stmts1} >> do {stmts2} = do {stmts1;stmts2}

which is valid provided the variables in
stmts1
and
stmts2
are disjoint.

Exercise G

Prove the leapfrog rule:
(f >=> g) . h = (f . h) >=> g
. Using this rule, prove:
(return . h) >=> g = g . h
.

Exercise H

Prove that

liftM f = id >=> (return . f)

join = id >=> id

A fourth way of describing the monad laws is in terms of the two functions
liftM
and
join
of Exercise D. There are seven laws governing these two functions, all of which have a familiar ring:

liftM id
= id

liftM (f . g) = liftM f . liftM g

 

liftM f . return = return . f

liftM f . join
= join . liftM (liftM f)

 

join . return
= id

join . liftM return = id

join . liftM join
= join . join

Prove the fourth rule.

Exercise I

What does
build []
do (see
Section 10.3
)?

Exercise J

Write an interactive program to play hangman. An example session:

ghci> hangman

I am thinking of a word:

-----

Try and guess it.

guess: break

-a---

guess: parties

Wrong number of letters!

guess: party

-appy

guess: happy

You got it!

Play again? (yes or no)

no

Bye!

Assume that a list of secret words is stored in a file called
Words
, so that the action
xs <- readFile "Words"
reads the file as a list of characters. By the way,
readFile
is lazy in that its contents are read on demand.

Exercise K

Write another version of
fib
in terms of a
fibST
that uses a single
STRef
.

Exercise L

One way of defining the greatest common divisor (
gcd
) of two positive integers is:

gcd (x,y) | x==y = x

| x

| x>y = gcd (x-y,y)

Translate this definition into two other programs, one of which uses the
State
monad and the other the
ST
monad.

Exercise M

Here is a concrete puzzle you can solve using breadth-first search. A cut-down version of Sam Loyd’s famous 15 puzzle is the 8 puzzle. You are given a 3 × 3 array containing tiles numbered from 1 to 8 and one blank space. You move by sliding an adjacent tile into the blank space. Depending on where the blank space is, you can slide tiles upwards, downwards, to the left or to the right. At the start the blank space is in the top left corner and the tiles read from 1 to 8. At the end the blank space is in the bottom right corner, but the tiles are still neatly arranged in the order 1 to 8.

Your mission, should you choose to accept it, is to settle on a suitable representation of positions and moves, and to define the functions
moves
,
move
,
solved
and
encode
.

10.8 Answers

Answer to Exercise A

We claim that
(>>) :: IO () -> IO () -> IO ()
is associative with identity element
done
. That means
putStr xs = foldl (>>) done (map putChar xs)

for all finite strings
xs

We concentrate on the proof of associativity. Firstly, for actions in
IO ()
we have
p >> q = p >>= const q

where
const x y = x
. Now we can reason:

(p >> q) >> r

=
{definition of
(>>)
}

(p >>= const q) >>= const r

=
{third monad law}

p >>= const (q >>= const r)

=
{definition of
(>>)
}

p >>= const (q >> r)

=
{definition of
(>>)
}

p >> (q >> r)

Answer to Exercise B

The direct version uses pattern matching with a wild-card:

add3 Nothing
= Nothing

add3 (Just x) Nothing _
= Nothing

add3 (Just x) (Just y) Nothing
= Nothing

add3 (Just x) (Just y) (Just z) = Just (x+y+z)

This definition ensures that
add Nothing undefined = Nothing
.

The monadic version reads:

add3 mx my mz

= do {x <- mx; y <- my; z <- mz;

return (x + y + z)}

Answer to Exercise C

Yes. The commutative law states that

p >>= \x -> q >>= \y -> f x y

= q >>= \y -> p >>= \x -> f x y

In the
Maybe
monad there are four possible cases to check. For example, both sides simplify to
Nothing
if
p = Nothing
and
q = Just y
, . The other cases are similar.

Answer to Exercise D

We have

fmap f p = p >>= (return . f)

join p = p >>= id

For the list monad we have
liftM = map
and
join = concat
.

In the other direction

p >>= f = join (liftM f p)

Answer to Exercise E

The function
sequence
is defined by

sequence :: Monad m => [m a] -> m [a]

sequence = foldr k (return [])

where k p q = do {x <- p; xs <- q; return (x:xs)}

The two new map functions are:

mapM_ f = sequence_ . map f

mapM f
= sequence . map f

The function
foldM
is defined by

foldM :: Monad m => (b -> a -> m b) ->

b -> [a] -> m b

foldM f e []
= return e

foldM f e (x:xs) = do {y <- f e x; foldM f y xs}

Note that
foldM
is analogous to
foldl
in that it works from left to right. Finally
for = flip mapM_
.

Answer to Exercise F

The first thing to note is that

sequence_ . map add

= foldr (>>) done . map add

= foldr ((>>) . add) done

using the fusion law of
foldr
and
map
given in
Section 6.3
. Moreover,
((>>) . add) n p = add n >> p

Since
sum = foldr (+) 0
that means we have to prove

foldr (\ n p -> add n >> p) = add . foldr (+) 0

That looks like an instance of the fusion law of
foldr
. We therefore have to show that
add
is strict (which it is), and

add 0 = done

add (n + n') = add n >> add n'

Here goes:

add 0

=
{definition}

do
{
m <- get; put (m+0)
}

=
{arithmetic}

do
{
m <- get; put m
}

=
{simple law of
put
and
get
}

done

That disposes of the first condition. For the second we start with the more complicated side and reason:

add n >> add n’

=
{definition}

do
{
l <- get; put (l + n)
}
>>
do
{
m <- get; put (m + n’)
}

=
{monad law}

do
{
l <- get; put (l + n); m <- get; put (m + n’)
}

=
{simple law of
put
and
get
}

do
{
l <- get; put ((l + n) + n’)
}

=
{associativity of
(+); definition of add
}

add (n + n’)

Answer to Exercise G

We can reason:

(f >=> g) (h x)

=
{definition of
(>=>)
}

f (h x) >>= g

=
{definition of
(>=>)
}

(f . h >=> g) x

For the second part:

(return . h) >=> g

=
{leapfrog rule}

(return >=> g) . h

=
{monad law}

g . h

Answer to Exercise H

For the fourth rule we simplify both sides. For the left-hand side:

liftM f . join

=
{definitions}

(id >=> (return . f)) . (id >=> id)

=
{leapfrog rule and
id . f = f
}

(id >=> id) >=> (return . f)

For the right-hand side:

join . liftM (liftM f)

=
{definitions}

(id >=> id) . (id >=> return . (id >=> (return . f)))
=
{leapfrog rule, and associativity of
(>=>)
}

id >=> (return . (id >=> (return . f))) >=> id

=
{since
(return . h) >=> g = g . h
}

id >=> id >=> (return . f)

The two sides are equal because
(>=>)
is associative.

Answer to Exercise I

build []
causes an infinite loop, so its value is ⊥.

Answer to Exercise J

For the main function we can define

hangman :: IO ()

hangman = do {xs <- readFile "Words";

play (words xs)}

The function
play
plays as many rounds of the game as desired with different words from the file (which we quietly suppose always has enough words):

play (w:ws)

= do {putStrLn "I am thinking of a word:";

putStrLn (replicate (length w) '-');

putStrLn "Try and guess it.";

guess w ws}

The function
guess
deals with a single guess, but keeps the remaining words for any subsequent round of play:

guess w ws

= do {putStr "guess: ";

w' <- getLine;

if length w' /= length w then

do {putStrLn "Wrong number of letters!";

guess w ws}

else if w' == w

then

do {putStrLn "You got it!";

putStrLn "Play again? (yes or no)";

ans <- getLine;

if ans == "yes"

then play ws

else putStrLn "Bye!"}

else do {putStrLn (match w' w);

Other books

Kissing Cousins: A Memory by Hortense Calisher
Reckless Secrets by Gina Robinson
Butterfly Winter by W.P. Kinsella
Mirabile by Janet Kagan
Riverine by Angela Palm
Losing Me by Sue Margolis
Ridiculous by Carter, D.L.
Dick Francis's Damage by Felix Francis