[Haskell-beginners] monads and mutants

Jürgen Doser jurgen.doser at gmail.com
Fri Aug 20 21:21:21 EDT 2010


El sáb, 21-08-2010 a las 01:21 +0100, Amy de Buitléir escribió:
> I'm dipping a toe in the shallow end of the monad pool. I would
> appreciate any feedback on the first function here, "mutateList". It
> seems to be working fine, but I have this feeling that I'm doing some
> unnecessary mucking about with state and I don't know how to fix it.
> Since both randomListSelection and mutateGene update the state, it
> seems unnecessary for mutateList to get and put the state as well.
> What do ye think?

Indeed. The whole point of using the State monad is that you do not have
to keep track of the state manually.

> I have a list of 16-bit unsigned words.
> I want to randomly select an element in the list.
> In the selected element, I want to flip a bit at random.
> 
> ---------- The code ----------
> 
> {-# LANGUAGE PackageImports #-}
> 
> import "mtl" Control.Monad.State
> import System.Random
> import Data.Word
> import Data.Bits
> 
> -- | ***** LOOK HERE *****
> -- | Flip a random bit in a random element in the list.
> mutateList :: [Word16] -> State StdGen [Word16]
> mutateList xs = do
>     g <- get
>     let ((i, x), g') = runState (randomListSelection xs) g
>     let (x', g'') = runState (mutateGene x) g'
>     put g''
>     return (replaceElement xs i x')
> -- | ***** LOOK HERE *****

This whole getting the state, passing it on, updating it, etc. is
exactly what the State monad allows you to avoid. Think about it this
way: A value of type State g a is conceptually sth. like a value of type
a that can read and write a state of type g. The do-notation for the
State monad then does the following:

x <- m (where m::State g a) 

translates to 

"x gets bound to the value of m in the current state, and in the next
line, the current state is updated according to what m does."

With that, your code can be simplified to:

mutateList xs = do
    (i, x) <- randomListSelection xs
    x' <- mutateGene x 
    return (replaceElement xs i x')

Implementationwise, State g a is basically g -> (a,g). The propagation
of updated states that you have done above is practically exactly what
(>>=) is defined to do in the State monad.


> -- | Choose an element at random from a list and return the element
> and its index
> randomListSelection :: [a] -> State StdGen (Int, a)
> randomListSelection xs = do
>     g <- get
>     let s = length xs
>     let (i, g') = randomR (0,s-1) g
>     put g'
>     return (i, xs !! i)

This can also be simplified. The only slight problem is that randomR
hasn't the precise type we want, but it is very close. Let's look at the
type of randomR:

randomR :: (Random a, RandomGen g) => (a, a) -> g -> (a, g)

In your case, a=Int, and g=StdGen, so 'randomR (a,b)' has type StdGen ->
(Int,StdGen) which is practically the same as State StdGen Int. The only
thing missing is some newtype wrapping:

randomListSelection xs = do
    i <- State $ randomR (0,length xs - 1) 
    return (i, xs !! i)

Same thing holds for mutateGene. I leave that simplification to you,
though.

Btw., If you want, you can get rid of this newtype wrapping by using the
MonadRandom package. But I guess it is instructive to see it working
this way first.

	Jürgen



More information about the Beginners mailing list