New monads/MonadRandom
From HaskellWiki
(→Connection to stochastics) |
|||
| (12 intermediate revisions not shown.) | |||
| Line 4: | Line 4: | ||
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. | ||
==The code== | ==The code== | ||
| - | <haskell> | + | <haskell>{-#LANGUAGE MultiParamTypeClasses, UndecidableInstances #-} |
| - | {-# | + | {-#LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances #-} |
module MonadRandom ( | module MonadRandom ( | ||
| Line 23: | Line 23: | ||
import Control.Monad.State | import Control.Monad.State | ||
import Control.Monad.Identity | import Control.Monad.Identity | ||
| + | import Control.Monad.Writer | ||
| + | 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 | + | newtype RandT g m a = RandT (StateT g m a) |
deriving (Functor, Monad, MonadTrans, MonadIO) | deriving (Functor, Monad, MonadTrans, MonadIO) | ||
| Line 41: | Line 43: | ||
instance (Monad m, RandomGen g) => MonadRandom (RandT g m) where | instance (Monad m, RandomGen g) => MonadRandom (RandT g m) where | ||
| - | getRandom = RandT | + | getRandom = RandT $ liftState random |
| - | getRandoms = RandT | + | getRandoms = RandT $ liftState $ first randoms . split |
| - | getRandomR (x,y) = RandT | + | getRandomR (x,y) = RandT $ liftState $ randomR (x,y) |
| - | getRandomRs (x,y) = RandT | + | getRandomRs (x,y) = RandT $ liftState $ |
first (randomRs (x,y)) . split | first (randomRs (x,y)) . split | ||
| Line 61: | Line 63: | ||
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 let | + | fromList xs = do |
| - | + | let total = fromRational $ sum (map snd xs) :: Double -- total weight | |
| - | + | cumulative = scanl1 (\(x,q) (y,s) -> (y, s+q)) xs -- cumulative weights | |
| - | + | p <- liftM toRational $ getRandomR (0.0, total) | |
| + | return $ fst . head . dropWhile (\(x,q) -> q < p) $ cumulative | ||
</haskell> | </haskell> | ||
| Line 80: | Line 83: | ||
instance (MonadRandom m) => MonadRandom (StateT s m) where | instance (MonadRandom m) => MonadRandom (StateT s m) where | ||
getRandom = lift getRandom | getRandom = lift getRandom | ||
| - | getRandomR | + | getRandomR = lift . getRandomR |
| + | getRandoms = lift getRandoms | ||
| + | getRandomRs = lift . getRandomRs | ||
instance (MonadRandom m, Monoid w) => MonadRandom (WriterT w m) where | instance (MonadRandom m, Monoid w) => MonadRandom (WriterT w m) where | ||
getRandom = lift getRandom | getRandom = lift getRandom | ||
| - | getRandomR | + | getRandomR = lift . getRandomR |
| + | getRandoms = lift getRandoms | ||
| + | getRandomRs = lift . getRandomRs | ||
instance (MonadRandom m) => MonadRandom (ReaderT r m) where | instance (MonadRandom m) => MonadRandom (ReaderT r m) where | ||
getRandom = lift getRandom | getRandom = lift getRandom | ||
| - | getRandomR | + | getRandomR = lift . getRandomR |
| + | getRandoms = lift getRandoms | ||
| + | getRandomRs = lift . getRandomRs | ||
instance (MonadState s m, RandomGen g) => MonadState s (RandT g m) where | instance (MonadState s m, RandomGen g) => MonadState s (RandT g m) where | ||
get = lift get | get = lift get | ||
| - | put | + | put = lift . put |
instance (MonadReader r m, RandomGen g) => MonadReader r (RandT g m) where | instance (MonadReader r m, RandomGen g) => MonadReader r (RandT g m) where | ||
ask = lift ask | ask = lift ask | ||
| - | local f (RandT m) = | + | local f (RandT m) = RandT $ local f m |
instance (MonadWriter w m, RandomGen g, Monoid w) => MonadWriter w (RandT g m) where | instance (MonadWriter w m, RandomGen g, Monoid w) => MonadWriter w (RandT g m) where | ||
| - | tell | + | tell = lift . tell |
listen (RandT m) = RandT $ listen m | listen (RandT m) = RandT $ listen m | ||
pass (RandT m) = RandT $ pass m | pass (RandT m) = RandT $ pass m | ||
| Line 110: | Line 119: | ||
getRandom = randomIO | getRandom = randomIO | ||
getRandomR = randomRIO | getRandomR = randomRIO | ||
| + | getRandoms = fmap randoms newStdGen | ||
| + | getRandomRs b = fmap (randomRs b) newStdGen | ||
| + | |||
</haskell> | </haskell> | ||
| - | |||
== Connection to stochastics == | == Connection to stochastics == | ||
| Line 138: | Line 149: | ||
In Haskell we have both options either computing with outcomes | In Haskell we have both options either computing with outcomes | ||
<haskell> | <haskell> | ||
| - | + | do x <- rx | |
| - | + | y <- ry | |
| - | + | return (x+y) | |
</haskell> | </haskell> | ||
or computing with random variables | or computing with random variables | ||
| Line 163: | Line 174: | ||
getRandomR (-10,10) | getRandomR (-10,10) | ||
</haskell> | </haskell> | ||
| - | is a uniformly distributed random variable between | + | is a uniformly distributed random variable between −10 and 10, then |
<haskell> | <haskell> | ||
untilM (0/=) (getRandomR (-10,10)) | untilM (0/=) (getRandomR (-10,10)) | ||
</haskell> | </haskell> | ||
| - | is a random variable with a uniform distribution of | + | is a random variable with a uniform distribution of {−10, …, −1, 1, …, 10}. |
| - | + | ||
==See also== | ==See also== | ||
| Line 174: | Line 184: | ||
* http://www.haskell.org/pipermail/haskell-cafe/2005-May/009775.html | * http://www.haskell.org/pipermail/haskell-cafe/2005-May/009775.html | ||
* [[New monads/MonadRandomSplittable]] | * [[New monads/MonadRandomSplittable]] | ||
| + | * [http://hackage.haskell.org/packages/archive/pkg-list.html#cat:Control The package list of Hackage] | ||
| + | * [http://hackage.haskell.org/cgi-bin/hackage-scripts/package/MonadRandom The MonadRandom package on Hackage] | ||
| + | * http://code.haskell.org/monadrandom/ | ||
Current revision
A simple monad transformer to allow computations in the transformed monad to generate random values.
1 The code
{-#LANGUAGE MultiParamTypeClasses, UndecidableInstances #-} {-#LANGUAGE 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 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 total = fromRational $ sum (map snd xs) :: Double -- total weight cumulative = scanl1 (\(x,q) (y,s) -> (y, s+q)) xs -- cumulative weights p <- liftM toRational $ getRandomR (0.0, total) return $ fst . head . dropWhile (\(x,q) -> q < p) $ cumulative
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 <- rxIn 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}.
