[Haskell-cafe] Explicit approach to lazy effects For probability monad?
Olaf Klinke
olf at aatal-apotheke.de
Sun Oct 20 20:45:38 UTC 2019
> It kind of seems like this can't work if >>= has type 'm a -> (a -> m b)
> -> mb', assuming m a = (a,state). The second argument needs to have
> type (m a -> m b) instead of (a -> m b), since the computation needs to
> have access to the state produced by the first "m a" computation, in
> order to (optionally) depend on the state thread for first computation.
My earlier suggestion of using the pure reader monad is not useful for two reasons:
(1) A single random number is shared among all sub-computations, which destroys statistical independence.
(2) Multi-dimensional distributions arguably require more than a single floating point number to parametrize.
Maybe the following two monads hint at a better way, although none of them exhibits the two desirable properties I suggested in my first reply. It seems that both exhibit the sequential nature that you want to avoid, if the underlying monad m is sequential (i.e. stateful).
(a) The free monad over the reader functor.
type Distribution a
= Free ((->) Double) a
= Pure a | Impure (r -> Free ((->) Double) a)
This is a reader monad of functions
(Double,Double,...,Double) -> a
where the tuple length may be any finite number.
-- @choose p@ chooses the first distribution with probability @p at .
choose :: Double -> Distribution a -> Distribution a -> Distribution a
choose p x y = Impure (\r -> if r <= p then x else y)
-- Feed a random number generator into a distribution.
-- You get to decide which monad that is.
sample :: Monad m => m r -> Free ((->) r) a -> m a
sample _ (Pure a) = pure a
sample gen (Impure f) = (sample gen) =<< (fmap f gen)
(b) A reader monad which passes copies of the random number generator around, not the generator state. Again, you get to choose which monad the random number generator lives in.
type DistrT m a
= ReaderT (m Double) m a
~ m Double -> m a
-- 'chooseT' queries the random number generator once
-- and then passes it down to either of the two choices.
chooseT :: Monad m => Double -> DistrT m a -> DistrT m a -> DistrT m a
chooseT p x y = ReaderT (\gen -> gen >>= (\r -> if r <= p then runReaderT x gen else runReaderT y gen))
sampleT = runReaderT :: DistrT m a -> m Double -> m a
Apologies that I can not be any more helpful at the moment. But the topic really interests me, please do post any progress on haskell-cafe.
Olaf
More information about the Haskell-Cafe
mailing list