[Haskell-cafe] Re: Importance of MonadRandom
Yitzchak Gale
gale at sefer.org
Tue Feb 6 05:30:43 EST 2007
I wrote:
> Cale Gibbard's MonadRandom... I would like to suggest
> a change to the interface...
> class (Monad m) => MonadRandom m where
> nextR :: m Int
> splitR :: m (m ())
> rangeR :: m (Int, Int)
> getR :: (forall g . RandomGen g => g -> a) -> m a
I see that I have inadvertently done two things
differently than Cale with regard to split: Cale
used a different type, and he put it into a
separate monad.
The separate monad idea is a very good one.
My type is bit more general than Cale's, and it
emphasizes the amusing fact that split is a kind
of inverse to monadic join. (Actually, a section.)
But Cale's type looks more convenient to use.
I am modifying my proposal accordingly on both
points.
Below are the new versions of the classes. Any
comments?
Thanks,
Yitz
\begin{code}
class Monad m => MonadRandom m where
nextR :: m Int
rangeR :: m (Int, Int)
getR :: (forall g . RandomGen g => g -> a) -> m a
-- Minimum complete definition: nextR and rangeR
getR f = do
r <- nextR
(lo, hi) <- rangeR
return $ f $ TrivalGen r lo hi
class MonadRandom m => MonadRandomSplittable m where
splitR :: m a -> m (m a)
splitRandom :: m a -> m a
-- Use the following default method definitions only
-- when splitting is a trivial operation, such as for
-- hardware-based random generators.
splitR = return
splitRandom = id
instance Monad m => MonadRandomSplittable (RandT m) where
splitR x = RandT (StateT split) >>= return . (>> x) . RandT . put
splitRandom x = RandT (StateT split) >>= lift . evalRandT x
instance MonadRandomSplittable Rand where
splitR = liftState split >>= return . liftState . put
splitRandom x = Rand (State split) >>= return . evalRand x
\end{code}
More information about the Haskell-Cafe
mailing list