# New monads/MonadRandom

### From HaskellWiki

(→The code: reformatted to fit in browser.) |
|||

Line 3: | Line 3: | ||

A simple monad transformer to allow computations in the transformed monad to generate random values. |
A simple monad transformer to allow computations in the transformed monad to generate random values. |
||

− | {-#LANGUAGE MultiParamTypeClasses, UndecidableInstances #-} |
+ | ==The code== |

− | {-#LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances #-} |
+ | <haskell> |

+ | {-# LANGUAGE MultiParamTypeClasses, UndecidableInstances, GeneralizedNewtypeDeriving, FlexibleInstances #-} |
||

module MonadRandom ( |
module MonadRandom ( |
||

Line 25: | Line 25: | ||

import Control.Monad.Reader |
import Control.Monad.Reader |
||

import Control.Arrow |
import Control.Arrow |
||

− | + | ||

class (Monad m) => MonadRandom m where |
class (Monad m) => MonadRandom m where |
||

− | getRandom :: (Random a) => m a |
+ | getRandom :: (Random a) => m a |

− | getRandoms :: (Random a) => m [a] |
+ | getRandoms :: (Random a) => m [a] |

− | getRandomR :: (Random a) => (a,a) -> m a |
+ | getRandomR :: (Random a) => (a,a) -> m a |

getRandomRs :: (Random a) => (a,a) -> m [a] |
getRandomRs :: (Random a) => (a,a) -> m [a] |
||

− | newtype RandT g m a = RandT (StateT g m a) |
+ | newtype (RandomGen g) => RandT g m a = RandT (StateT g m a) |

deriving (Functor, Monad, MonadTrans, MonadIO) |
deriving (Functor, Monad, MonadTrans, MonadIO) |
||

Line 42: | Line 42: | ||

instance (Monad m, RandomGen g) => MonadRandom (RandT g m) where |
instance (Monad m, RandomGen g) => MonadRandom (RandT g m) where |
||

− | getRandom = RandT $ liftState random |
+ | getRandom = RandT . liftState $ random |

− | getRandoms = RandT $ liftState $ first randoms . split |
+ | getRandoms = RandT . liftState $ first randoms . split |

− | getRandomR (x,y) = RandT $ liftState $ randomR (x,y) |
+ | getRandomR (x,y) = RandT . liftState $ randomR (x,y) |

− | getRandomRs (x,y) = RandT $ liftState $ |
+ | getRandomRs (x,y) = RandT . liftState $ |

first (randomRs (x,y)) . split |
first (randomRs (x,y)) . split |
||

Line 62: | Line 62: | ||

runRand :: (RandomGen g) => Rand g a -> g -> (a, g) |
runRand :: (RandomGen g) => Rand g a -> g -> (a, g) |
||

− | runRand (Rand x) g = runIdentity (runRandT x g) |
+ | runRand (Rand x) g = runIdentity (runRandT x g) |

evalRandIO :: Rand StdGen a -> IO a |
evalRandIO :: Rand StdGen a -> IO a |
||

evalRandIO (Rand (RandT x)) = getStdRandom (runIdentity . runStateT x) |
evalRandIO (Rand (RandT x)) = getStdRandom (runIdentity . runStateT x) |
||

− | + | ||

fromList :: (MonadRandom m) => [(a,Rational)] -> m a |
fromList :: (MonadRandom m) => [(a,Rational)] -> m a |
||

fromList [] = error "MonadRandom.fromList called with empty list" |
fromList [] = error "MonadRandom.fromList called with empty list" |
||

fromList [(x,_)] = return x |
fromList [(x,_)] = return x |
||

− | fromList xs = do |
+ | fromList xs = do let s = fromRational $ sum (map snd xs) -- total weight |

− | let total = fromRational $ sum (map snd xs) :: Double -- total weight |
+ | cs = scanl1 (\(x,q) (y,s) -> (y, s+q)) xs -- cumulative weight |

− | cumulative = scanl1 (\(x,q) (y,s) -> (y, s+q)) xs -- cumulative weights |
+ | p <- liftM toRational $ getRandomR (0.0,s :: Double) |

− | p <- liftM toRational $ getRandomR (0.0, total) |
+ | return . fst . head $ dropWhile (\(x,q) -> q < p) cs |

− | return $ fst . head . dropWhile (\(x,q) -> q < p) $ cumulative |
+ | </haskell> |

+ | |||

+ | To make use of common transformer stacks involving Rand and RandT, the following definitions may prove useful: |
||

+ | |||

+ | <haskell> |
||

+ | instance (MonadRandom m) => MonadRandom (StateT s m) where |
||

+ | getRandom = lift getRandom |
||

+ | getRandomR = lift . getRandomR |
||

+ | getRandoms = lift getRandoms |
||

+ | getRandomRs = lift . getRandomRs |
||

+ | |||

+ | instance (MonadRandom m, Monoid w) => MonadRandom (WriterT w m) where |
||

+ | getRandom = lift getRandom |
||

+ | getRandomR = lift . getRandomR |
||

+ | getRandoms = lift getRandoms |
||

+ | getRandomRs = lift . getRandomRs |
||

+ | |||

+ | instance (MonadRandom m) => MonadRandom (ReaderT r m) where |
||

+ | getRandom = lift getRandom |
||

+ | getRandomR = lift . getRandomR |
||

+ | getRandoms = lift getRandoms |
||

+ | getRandomRs = lift . getRandomRs |
||

+ | |||

+ | instance (MonadState s m, RandomGen g) => MonadState s (RandT g m) where |
||

+ | get = lift get |
||

+ | put = lift . put |
||

+ | |||

+ | instance (MonadReader r m, RandomGen g) => MonadReader r (RandT g m) where |
||

+ | ask = lift ask |
||

+ | local f (RandT m) = RandT $ local f m |
||

+ | |||

+ | instance (MonadWriter w m, RandomGen g, Monoid w) => MonadWriter w (RandT g m) where |
||

+ | tell = lift . tell |
||

+ | listen (RandT m) = RandT $ listen m |
||

+ | pass (RandT m) = RandT $ pass m |
||

+ | </haskell> |
||

+ | |||

+ | You may also want a MonadRandom instance for IO: |
||

+ | |||

+ | <haskell> |
||

+ | instance MonadRandom IO where |
||

+ | getRandom = randomIO |
||

+ | getRandomR = randomRIO |
||

+ | getRandoms = fmap randoms newStdGen |
||

+ | getRandomRs b = fmap (randomRs b) newStdGen |
||

+ | |||

+ | </haskell> |
||

+ | |||

== Connection to stochastics == |
== Connection to stochastics == |

## Revision as of 15:24, 30 October 2011

A simple monad transformer to allow computations in the transformed monad to generate random values.

## 1 The code

{-# LANGUAGE MultiParamTypeClasses, UndecidableInstances, GeneralizedNewtypeDeriving, FlexibleInstances #-} module MonadRandom ( MonadRandom, getRandom, getRandomR, getRandoms, getRandomRs, evalRandT, evalRand, evalRandIO, fromList, Rand, RandT -- but not the data constructors ) where import System.Random import Control.Monad.State import Control.Monad.Identity import Control.Monad.Writer import Control.Monad.Reader import Control.Arrow class (Monad m) => MonadRandom m where getRandom :: (Random a) => m a getRandoms :: (Random a) => m [a] getRandomR :: (Random a) => (a,a) -> m a getRandomRs :: (Random a) => (a,a) -> m [a] newtype (RandomGen g) => RandT g m a = RandT (StateT g m a) deriving (Functor, Monad, MonadTrans, MonadIO) liftState :: (MonadState s m) => (s -> (a,s)) -> m a liftState t = do v <- get let (x, v') = t v put v' return x instance (Monad m, RandomGen g) => MonadRandom (RandT g m) where getRandom = RandT . liftState $ random getRandoms = RandT . liftState $ first randoms . split getRandomR (x,y) = RandT . liftState $ randomR (x,y) getRandomRs (x,y) = RandT . liftState $ first (randomRs (x,y)) . split evalRandT :: (Monad m, RandomGen g) => RandT g m a -> g -> m a evalRandT (RandT x) g = evalStateT x g runRandT :: (Monad m, RandomGen g) => RandT g m a -> g -> m (a, g) runRandT (RandT x) g = runStateT x g -- Boring random monad :) newtype Rand g a = Rand (RandT g Identity a) deriving (Functor, Monad, MonadRandom) evalRand :: (RandomGen g) => Rand g a -> g -> a evalRand (Rand x) g = runIdentity (evalRandT x g) runRand :: (RandomGen g) => Rand g a -> g -> (a, g) runRand (Rand x) g = runIdentity (runRandT x g) evalRandIO :: Rand StdGen a -> IO a evalRandIO (Rand (RandT x)) = getStdRandom (runIdentity . runStateT x) fromList :: (MonadRandom m) => [(a,Rational)] -> m a fromList [] = error "MonadRandom.fromList called with empty list" fromList [(x,_)] = return x fromList xs = do let s = fromRational $ sum (map snd xs) -- total weight cs = scanl1 (\(x,q) (y,s) -> (y, s+q)) xs -- cumulative weight p <- liftM toRational $ getRandomR (0.0,s :: Double) return . fst . head $ dropWhile (\(x,q) -> q < p) cs

To make use of common transformer stacks involving Rand and RandT, the following definitions may prove useful:

instance (MonadRandom m) => MonadRandom (StateT s m) where getRandom = lift getRandom getRandomR = lift . getRandomR getRandoms = lift getRandoms getRandomRs = lift . getRandomRs instance (MonadRandom m, Monoid w) => MonadRandom (WriterT w m) where getRandom = lift getRandom getRandomR = lift . getRandomR getRandoms = lift getRandoms getRandomRs = lift . getRandomRs instance (MonadRandom m) => MonadRandom (ReaderT r m) where getRandom = lift getRandom getRandomR = lift . getRandomR getRandoms = lift getRandoms getRandomRs = lift . getRandomRs instance (MonadState s m, RandomGen g) => MonadState s (RandT g m) where get = lift get put = lift . put instance (MonadReader r m, RandomGen g) => MonadReader r (RandT g m) where ask = lift ask local f (RandT m) = RandT $ local f m instance (MonadWriter w m, RandomGen g, Monoid w) => MonadWriter w (RandT g m) where tell = lift . tell listen (RandT m) = RandT $ listen m pass (RandT m) = RandT $ pass m

You may also want a MonadRandom instance for IO:

instance MonadRandom IO where getRandom = randomIO getRandomR = randomRIO getRandoms = fmap randoms newStdGen getRandomRs b = fmap (randomRs b) newStdGen

## 2 Connection to stochastics

There is some correspondence between notions in programming and in mathematics:

random generator | ~ | random variable / probabilistic experiment |

result of a random generator | ~ | outcome of a probabilistic experiment |

Thus the signature

rx :: (MonadRandom m, Random a) => m a

`x <- rx`

In a language without higher order functions and using a random
generator "function" it is not possible to work with random variables, it
is only possible to compute with outcomes, e.g. `rand()+rand()`

. In a
language where random generators are implemented as objects, computing
with random variables is possible but still cumbersome.

In Haskell we have both options either computing with outcomes

do x <- rx y <- ry return (x+y)

or computing with random variables

liftM2 (+) rx ry

random variable arithmetic. But there is also some arithmetic on random variables which can not be performed on outcomes. For example, given a function that repeats an action until the result fulfills a certain property (I wonder if there is already something of this kind in the standard libraries)

untilM :: Monad m => (a -> Bool) -> m a -> m a untilM p m = do x <- m if p x then return x else untilM p m

we can suppress certain outcomes of an experiment. E.g. if

getRandomR (-10,10)

is a uniformly distributed random variable between −10 and 10, then

untilM (0/=) (getRandomR (-10,10))

is a random variable with a uniform distribution of {−10, …, −1, 1, …, 10}.