Part 3: State Monad Implementation of Cannibals and Missionaries

Well here is part 2 of the Cannibals and Missionaries problem. I'll start with a(n) introduction/tutorial of the state monad. Hopefully this will enlighten some readers and myself a bit about how the state monad works. For the next explanations I assume you have seen some monads and now some of the basics such as the bind operator (>>=) and return. But you might learn something too if you've never seen monads before.

Readers more comfortable with the state monad could skip to the implementation of the problem (Cannibals, Missionaries and the State Monad pt. 3).

Introduction to the State Monad

In this section I will give a motivation for the existence of the state monad by using random generators as an example(thanks to [1]). After that motivation we'll try to define our own state monad. In the section we will again motivate the use of the state monad by trying to renumber trees, define some more helper functions for the state monad and then implement the renumber example with the state monad.

Motivation for implicit state

Say we would like to implement a random number generator. How would a function that generates a random number look like? In contrast to stateful languages such as C, Haskell can't have a function such as

randomNumber :: IntThis function would not be referential transparant unless of course randomNumber always returns the same number (possibly chosen by a fair dice roll[2]).

Therefore instead we provide an explicit state for our randomNumber function. We can use a pseudorandomgenerator on this state So the function type definition would look like:

randomNumber :: RandomState -> (Int, RandomState)

This function randomNumber takes a RandomState, possibly a seed value, and uses that RandomState to generate a pseudorandom Int and also returns the new seed value or changed RandomState.

Let's pretend that randomNumber function already exists, and we wanted to define our own random function that takes a RandomState and returns two random numbers and the new RandomState.

Exercise: Define the function

twoRandomNumbers :: RandomState -> ((Int,Int), RandomState)

Try define it yourself first by using the "predefined" function and datatype below.

-- to test at least the types check use this:-- our predefined function

randomNumber :: RandomState -> (Int, RandomState)

randomNumber = undefined-- another placeholderdataRandomState = RandomState

Solution:

We would have to explicitly thread the state like this:

-- return two random numbers and the new RandomState

twoRandomNumbers :: RandomState -> ((Int,Int), RandomState)

twoRandomNumbers s =let(i, s') = randomNumber s

(i', s'') = randomNumber s'

in((i,i'),s'')

Our function twoRandomNumbers calls randomNumber with it's state, this produces a (pseudo)random Int and the new RandomState, this new state is then threaded in randomNumber again for another Int and newer state. These Int's are tupled and returned with the newest state.

It is easy to make mistakes in this threading. We could accidentally thread an older state to our second randomNumber call (and always get the two same numbers) or return and older state as the final result.

To avoid these kind of errors we woukd like to avoid this explicit passing of s, s' and s'' by abstracting this state and making it implicit.

First we have to see a pattern in our code. The type of randomNumber indicates a common pattern for state passing. Namely, randomNumber takes a state and returns the changed state along with a result. So:

(s -> (a, s))

In this type signature s is the state, and a is the result. We would like to turn this general type signature into a datatype and then somehow use it for implicit state. We will do this by just trying to make this datatype a monad and see how useful it is and how we can improve on it.

Now to define our own State Monad!

Let's capture this s -> (a, s) pattern and just make it a new data type (you could also use newtype here).

dataState s a = State (s -> (a, s))

(By simply following the types our randomFunction would now be of type State RandomState Int.)

Now we try to make this datatype into a Monad. Remember that a Monad has a kind of * -> *, this means a monad type can still have a type applied to it. State takes two type parameters, namely s and a, and is therefore of kind * -> * -> * (takes two types and returns one type), so we can only make a Monad out of State s and not out of State or State s a. (See [3] for a small explanation of kinds.)

So let's just start with defining our monad instance. The function stubs would look like this:

instanceMonad (State s)where

-- return :: (Monad m) => x -> m x

return x = undefined

--(>>=) :: (Monad m) => m x -> (x -> m y) -> m y

(State s) >>= f = undefined

Exercise: Try to define return and bind (>>=).

Hint:

I have used the general type signatures on purpose here, try to specialize this type signatures for the State Monad yourself. The return function should then follow quite easily. The bind operator is quite a bit harder though, so don't worry if you don't get it at once.

Solution:

Let's look at the type of return. It's general type is x -> M x. Think what this x could mean. We can only really touch the second type parameter of our State datatype. Therefore that x must be the type of our result (a), and therefore can't be the type of our first type parameter. So the detailed type of return would be

-- return :: a -> State s a

This reduces our problem to: if we have a value a, how to make it into a State (s -> (a,s))? We will have to make it into a function s -> (a,s) and then wrap it with State. So:

return a = State $ \s -> (a, s)There isn't another sensible implementation really.

And now the bind operator (>>=). Again specializing types we get:

-- (>>=) :: State s a -> (a -> State s b) -> State s b

Now to reason a bit about what the bind should do. The result of the function is State s b and gives a bit of an intuition of how the final result should look like.

State s b is just a function s -> (b, s) with a State wrapper around it, right?. So let's start with that:

(State x) >>= f = State (\s -> (..., ...))Now we at least have a result that has a State wrapper and a function in it. But now what?

We will need to pass the state to our first argument, State s a, get out the new state and result, and then use that for the next argument. So:

(State x) >>= f = State (\s -> (let(a, s1) = x sin...))

Great now we've got the result of the first state computation, now to pass it to our function f to generate a State b.

(State x) >>= f = State (\s -> (Okay that's that, but now we still need to apply our newest state to our State b. Thus:let(a, s1) = x sin...))

(State x) >>= f = State (\s -> (let(a, s1) = x s; State y = f ainy s1))

Possibly reread it 2/3 times and let it take some time to sink in.

Now to rewrite our randomNumber example. It is still a bit contrived because we haven't really implemented the randomNumber function itself, but forget that for now. We will implement a larger fully working and testable example later. So for now we keep pretending someone has implemented randomNumber for us. and we want to use it with our freshly made State Monad. So instead of randomNumber :: RandomState -> (Int, RandomState) we want: randomNumber' :: State RandomState Int.

Exercise: Define the function:

randomNumber' :: State RandomState Int

Think for a second, it really is quite trivial.

Solution:

-- our State Monad randomNumber function

randomNumber' :: State RandomState Int

randomNumber' = State randomNumber

Yup that's all it takes. Now to use our randomNumber' function and our monadic functions return and bind (>>=) to implicitly pass the state.

Exercise: Like before, define the function:

twoRandomNumbers' :: State RandomState (Int,Int)

Hint:

Remember >>= is used for passing the state, and return is used to make a value (or result) into a State monad. You will need lambda abstractions after the bind to be able to use the value as a result.

Solution:

-- State Monad implementation: return two random numbers and the new RandomState

twoRandomNumbers' :: State RandomState (Int,Int)

twoRandomNumbers' = randomNumber' >>= \ a ->

randomNumber' >>= \ b ->

return (a,b)-- or equivalently:-- do a <- randomNumber'-- b <- randomNumber'-- return (a,b)

That looks a lot cleaner doesn't it :-)?

We just call randomNumber' and bind the result to a, then the state is implicitly passed to the other randomNumber' call, we bind that result to b, implicitly pass that state again, and finally use return to make a State Monad out of (a,b). (The state is passed to this monad.)

You might have noticed we're now stuck in a state monad. We will define some functions that enable us to peel of the wrapper and run the state in the next section.

Take some deep breaths and then we will continue with another example and define some helpful functions for making the use of the state monad a lot easier.

Renumbering trees

I hope the previous example already showed some of the uses of the state monad. We will now continue with another example for the movation of use of the state monad by implementing a function that gives a binary tree number labels. We will define this function ourselves to undergo some of the difficulties of explicit state passing.

Say we have a binary tree:

dataTree a = Leaf a | Node (Tree a) (Tree a)

derivingShow

And instead of using the elements a, we would like to give all the Leafs a different number. The type signature of our function could therefore be:

renumberTree :: Tree a -> Tree Int

First consider the base case when a Leaf is given a number. The problem is how do we give all Leafs a different number and where do get that number from? We will need to keep the label number with us in the function by keeping it as an explicit argument. So instead we get:

renumberTree :: (Tree a, Int) -> (Tree Int, Int)

To keep the Int argument out of the function call we will keep our old renumberTree and define a helper function renumberTreeHelper inside, which will be called by renumberTree.

renumberHelper :: (Tree a, Int) -> (Tree Int, Int)

As you can see renumberHelper takes a tuple (Tree a, Int). The Int denotes the current label number. After renumbering a Leaf the relabeled Leaf should be returned along with an incremented integer. Try to define the rest yourself first!

The base case for Leafs is quite easy, try that one first. The other case will need some pattern matching on the recursive calls.

Solution:

First we try to solve the base case, namely the case of a Leaf. As said the relabeled Leaf should be returned along with an incremented integer.

renumberHelper ((Leaf x), n) = (Leaf n, n+1)

The Node case is a bit harder though. Because we have to keep track of our current label number and we need to recursively call our two children (left and right) we will have to do some passing of our label number (Int).

So first we do a pattern match on the Node as we did we the Leaf:

renumberHelper ((Node l r), n) =

Now we have access to the left and right children of this node, and importantly to the current integer label, n. The right hand side (rhs) can now be defined by applying renumberHelper to the left node, taking the resulting label number, then applying renumberHelper to the right node with the NEW label number from the left node, and then we produce our result by using our Node constructor, the new left and right children, and importantly the new label number returned by the call on the right child. Therefore:

whererenumberHelper :: (Tree a, Int) -> (Tree Int, Int)

renumberHelper ((Leaf x), n) = (Leaf n, n+1)

renumberHelper ((Node l r), n) =let(t1, n1) = renumberHelper (l,n)

(t2, n2) = renumberHelper (r, n1)

in((Node t1 t2), n2)

(We have used renumberHelper as a local definition in renumberTree.) Now to define the renumberTree. We only have to call renumberHelper with the tree argument, a starting number (we will take 0) and then take the tree out of the result of renumberHelper.

Thus:

-- take a tree and give all leafs a unique number.-- I number the leafs in depth first order, any order is fine though

renumberTree :: Tree a -> Tree Int

renumberTree tree = fst $ renumberHelper (tree, 0)

And now for an example tree with example run (load it up in GHCi yourself!):

tree1 = Node (Node (Leaf 'a') (Node (Leaf 'b') (Leaf 'd'))) (Leaf 'c')

tree2 = Node (Leaf 'a') (Leaf 'b')

> renumberTree tree1

Node (Node (Leaf 0) (Node (Leaf 1) (Leaf 2))) (Leaf 3)

Well that works :)!

But as you might have noticed, the let bindings and explicitly passing of our integer argument can be quite susceptible to mistakes. Especially when using names such as n, n' and n''. So instead we would like to have the integer argument passed implicitly. This again can be solved with the state monad.

So let's start thinking how to implicitly thread our state. We want to pass our Int argument as the state and will therefore be our s argument in State s a. The result a should be the Tree Int. So a good type for our State Monad would be State Int (Tree Int). This would give us a type of Tree a -> State Int (Tree Int). Now what? We're stuck in a monad! We would like our upper function to have the type:

renumberTree' :: Tree a -> Tree Int

Well that isn't a problem with this monad. We don't have any side effects so pulling of our State wrapper shouldn't give any problems such as launching missiles. We'll define a function that just does this with one simple pattern match:

-- pull of the State wrapper

runState :: State s a -> (s -> (a, s))

runState (State s) = s

So now we can pull out the function out of the wrapper. This gives us the opportunity to actually apply some state to this function and get results! So given that we have defined a helper function, this time of type:

renumberHelper :: Tree a -> State Int (Tree Int)

Exercise: Define the function:

renumberTree' :: Tree a -> Tree Int

Hint:

Use runState and supply the state.

Solution:

We will need supply the renumberHelper function with the tree (giving us State s a), pull of the State wrapper (giving us s -> (a, s) , supply the state it needs to compute our result, such as 0, (giving (a,s)), and then just pull out the result out of the tuple by using fst.

-- State Monad implementation: take a tree and give all leafs a unique number.-- I number the leafs in depth first order, any order is fine though

renumberTree' :: Tree a -> Tree Int

renumberTree' tree = fst $ runState (renumberHelper tree) 0

Some helper functions:

One can imagine that calling runState (to pull of the wrapper) and supplying a state and then getting out the result or the new state will be a common use case. We will therefore define some methods that implement these use cases.

-- pull of the State wrapper, supply a state resulting in a (value, newState) pair-- and take out the resulting value

evalState :: State s a -> s -> a

evalState m s = fst (runState m s)-- pull of the State wrapper, supply a state resulting in a (value, newState) pair-- and take out the resulting new state

execState :: State s a -> s -> s

execState m s = snd (runState m s)

We can therefore rewrite our renumberTree' call to:

evalState (renumberHelper tree) 0

Explicit implicit state

Before defining the renumberHelper function we will define more functions that will help us use the State Monad. Sometimes we do want to explicitly use the state and we will define some helper functions for that purpose.

What if we want to know what the current state is? Remember the datatype of our Monad, data State s a = State (s -> (a, s))

So if we're in the middle of a ((State s) >>= \ x -> ...), how do we get the state out? State should most of the times be implicit but if we want to make the state explicit the only way is to return it as a result. So let's define a get function which returns the state as result. So we just replace our type of the result, a, by the type of the state, s. So the only possibly type for our get function is:

get :: State s s

The function itself shouldn't be hard to define now either, give it a try!

Exercise: Define the get function:

Solution:

-- return the current state by copying it as a value

get :: State s s

get = State (\ c -> (c, c))

Now for a similar function: put. When we use the get function and get the current state, we sometimes want to change that state and put it back in a state monad.

So given a state s, we would like to see a computation that results in that new state s. But what do we do with the result? Because there really isn't a result from putting our new state in the state monad there isn't a sensible value to use for that so we'll just use ().

Exercise: Define put

Hint: Again look at the possible types!

Solution:

-- put the given state s as current state

put :: s -> State s ()

put s = State (\_-> ((), s))

put takes a state as argument and constructs a State which ignores the next state and puts () as value.

Now let's try putting these two functions to use. Let's try to define a function inc, that takes a State Monad with an Int as state, and increases that Int it.

You do need to take a State Monad as argument, this can instead be done inside the monad so the type of inc becomes:

inc :: State Int ()

Exercise: Define inc

Hint:

Use a combination of get and put and bind.

Solution:

-- increase the state with 1

inc :: State Int ()

inc = get >>= \ x -> put (x + 1)-- or equivalently:-- inc = do x <- get-- put $ x + 1

As you can see inc uses get to get the current state out as a value and then puts it back after incrementing it by 1.

A short sidenote: you can probably imagine that the combination of get and put will often be used when a modification of the state is necessary. Instead of using get and put we can use a convenience function modify which will do the getting and putting for us. The only thing we will need to do is supply modify with our state changing function. Thus modify would look like this:

modify :: (s -> s) -> State s ()

modify f =dox <- get

put $ f x

Defining inc now gets even easier:

inc = modify (+1)

We have now defined all the functions we need for the State Monad version of renumberTree'. Have a go at defining the renumberHelper using our functions inc, get, return and bind. Try to use do notation for a more readable implementation!

Exercise: Define renumberHelper.

Hint:

Remember the type of the helper function:

renumberHelper :: Tree a -> State Int (Tree Int)

Solution:

-- State Monad implementation: take a tree and give all leafs a unique number.-- I number the leafs in depth first order, any order is fine though

renumberTree' :: Tree a -> Tree Int

renumberTree' tree = fst $ runState (renumberHelper tree) 0

whererenumberHelper :: Tree a -> State Int (Tree Int)

renumberHelper (Leaf x) =don <- get

inc

return (Leaf n)

renumberHelper (Node l r) =dol' <- renumberHelper l

r' <- renumberHelper r

return (Node l' r')

Well here's the complete implementation of renumberTree'. renumberTree' is as we defined it earlier, renumberHelper again is splitted in two cases, Leaf and Node cases.

The actual changing of the state happens at the Leaf case, we first use get to take out our current counter value, call inc to increment our counter, construct a Leaf with our initial counter value and finally return that Leaf as a State Monad.

The Node case has gotten a lot easier and more readable now, we just call renumberHelper two times and use the results in our Node constructor, which we then return as a State Monad.

That's all folks!

For another simple but sweet example of Fibonacci numbers see here.

In the next blog post I will finally implement the Cannibals and Missionaries problem by using the State Monad. Try to make an implementation yourself if you think you're capable now!

Just import Control.Monad.State and you'll be able to use all the state monad functions defined in this blog post.

References:

[1] http://ertes.de/articles/monads.html#section-6

Understanding Haskell Monads by Ertugrul SÃ¶ylemez

Random number generator example and some good explanations of the state monad and monads in general.

[2] http://xkcd.com/221/

[3] http://en.wikibooks.org/wiki/Haskell/Kinds

Explanation of kinds.

Acknowledgements:

I'd like to thank kosmikus for his help with the state monad.

The final code:

moduleStatewhere-- to test at least the types check use this:-- our predefined function

randomNumber :: RandomState -> (Int, RandomState)

randomNumber = undefined-- another placeholderdataRandomState = RandomState-- return two random numbers and the new RandomState

twoRandomNumbers :: RandomState -> ((Int,Int), RandomState)

twoRandomNumbers s =let(i, s') = randomNumber s

(i', s'') = randomNumber s'

in((i,i'),s'')-- our datatypedataState s a = State (s -> (a, s))instanceMonad (State s)where

-- return :: (Monad m) => x -> m x

-- specialized: return :: a -> State s a

return x = State $ \s -> (x, s)

--(>>=) :: (Monad m) => m x -> (x -> m y) -> m y

-- specialized: (>>=) :: State s a -> (a -> State s b) -> State s b

(State x) >>= f = State (\s -> (let(a, s1) = x s; State y = f ainy s1))

-- our State Monad randomNumber function

randomNumber' :: State RandomState Int

randomNumber' = State randomNumber-- State Monad implementation: return two random numbers and the new RandomState

twoRandomNumbers' :: State RandomState (Int,Int)

twoRandomNumbers' = randomNumber' >>= \ a ->

randomNumber' >>= \ b ->

return (a,b)-- or equivalently:-- do a <- randomNumber'-- b <- randomNumber'-- return (a,b)-- our tree type (a simple binary tree with values at the Leafs)dataTree a = Leaf a | Node (Tree a) (Tree a)

derivingShow-- take a tree and give all leafs a unique number.-- I number the leafs in depth first order, any order is fine though

renumberTree :: Tree a -> Tree Int

renumberTree tree = fst $ renumberHelper (tree, 0)

whererenumberHelper :: (Tree a, Int) -> (Tree Int, Int)

renumberHelper ((Leaf x), n) = (Leaf n, n+1)

renumberHelper ((Node l r), n) =let(t1, n1) = renumberHelper (l,n)

(t2, n2) = renumberHelper (r, n1)

in((Node t1 t2), n2)

tree1 = Node (Node (Leaf 'a') (Node (Leaf 'b') (Leaf 'd'))) (Leaf 'c')

tree2 = Node (Leaf 'a') (Leaf 'b')-- useful State Monad functions:-- pull of the State wrapper

runState :: State s a -> (s -> (a, s))

runState (State s) = s-- pull of the State wrapper, supply a state resulting in a (value, newState) pair-- and take out the resulting value

evalState :: State s a -> s -> a

evalState m s = fst (runState m s)-- pull of the State wrapper, supply a state resulting in a (value, newState) pair-- and take out the resulting new state

execState :: State s a -> s -> s

execState m s = snd (runState m s)-- return the current state by copying it as a value

get :: State s s

get = State (\ c -> (c, c))-- put the given state s as current state

put :: s -> State s ()

put s = State (\_-> ((), s))

modify :: (s -> s) -> State s ()

modify f =dox <- get

put $ f x-- increase the state with 1

inc :: State Int ()

inc = get >>= \ x -> put (x + 1)-- or equivalently:-- inc = do x <- get-- put $ x + 1-- or even better:-- inc = modify (+1)-- State Monad implementation: take a tree and give all leafs a unique number.-- I number the leafs in depth first order, any order is fine though

renumberTree' :: Tree a -> Tree Int

renumberTree' tree = fst $ runState (renumberHelper tree) 0

-- or equivalently: evalState (renumberHelper tree) 0

whererenumberHelper :: Tree a -> State Int (Tree Int)

renumberHelper (Leaf x) =don <- get

inc

return (Leaf n)

renumberHelper (Node l r) =dol' <- renumberHelper l

r' <- renumberHelper r

return (Node l' r')

Edit: Added modify, evalState, execState and changed renumberHelper' to function the same as renumberHelper.

Edit: Rephrasing.

(Last edit: August 7th)