diff --git a/monad-bayes.cabal b/monad-bayes.cabal index f4c26287..ab68cf98 100644 --- a/monad-bayes.cabal +++ b/monad-bayes.cabal @@ -101,6 +101,7 @@ library Control.Monad.Bayes.Inference.TUI Control.Monad.Bayes.Integrator Control.Monad.Bayes.Population + Control.Monad.Bayes.Population.Applicative Control.Monad.Bayes.Sampler.Lazy Control.Monad.Bayes.Sampler.Strict Control.Monad.Bayes.Sequential.Coroutine diff --git a/src/Control/Applicative/List.hs b/src/Control/Applicative/List.hs index 557c218a..a6a0a99a 100644 --- a/src/Control/Applicative/List.hs +++ b/src/Control/Applicative/List.hs @@ -4,11 +4,7 @@ module Control.Applicative.List where -- base import Control.Applicative --- transformers -import Control.Monad.Trans.Writer.Strict import Data.Functor.Compose --- log-domain -import Numeric.Log (Log) -- * Applicative ListT @@ -17,22 +13,11 @@ import Numeric.Log (Log) newtype ListT m a = ListT {getListT :: Compose m [] a} deriving newtype (Functor, Applicative, Alternative) +listT :: m [a] -> ListT m a +listT = ListT . Compose + lift :: (Functor m) => m a -> ListT m a lift = ListT . Compose . fmap pure runListT :: ListT m a -> m [a] runListT = getCompose . getListT - --- * Applicative Population transformer - --- WriterT has to be used instead of WeightedT, --- since WeightedT uses StateT under the hood, --- which requires a Monad (ListT m) constraint. -newtype PopulationT m a = PopulationT {getPopulationT :: WriterT (Log Double) (ListT m) a} - deriving newtype (Functor, Applicative, Alternative) - -runPopulationT :: PopulationT m a -> m [(a, Log Double)] -runPopulationT = runListT . runWriterT . getPopulationT - -fromWeightedList :: m [(a, Log Double)] -> PopulationT m a -fromWeightedList = PopulationT . WriterT . ListT . Compose diff --git a/src/Control/Monad/Bayes/Population.hs b/src/Control/Monad/Bayes/Population.hs index 9b97dc31..aa177de1 100644 --- a/src/Control/Monad/Bayes/Population.hs +++ b/src/Control/Monad/Bayes/Population.hs @@ -40,7 +40,6 @@ module Control.Monad.Bayes.Population where import Control.Applicative (Alternative) -import Control.Applicative.List qualified as ApplicativeListT import Control.Arrow (second) import Control.Monad (MonadPlus, replicateM) import Control.Monad.Bayes.Class @@ -49,6 +48,7 @@ import Control.Monad.Bayes.Class MonadMeasure, factor, ) +import Control.Monad.Bayes.Population.Applicative qualified as Applicative import Control.Monad.Bayes.Weighted ( WeightedT, applyWeight, @@ -70,6 +70,11 @@ import Numeric.Log qualified as Log import Prelude hiding (all, sum) -- | A collection of weighted samples, or particles. +-- +-- This monad transformer is internally represented as a free monad, +-- which means that each layer of its computation contains a collection of weighted samples. +-- These can be flattened with 'flatten', +-- but the result is not a monad anymore. newtype PopulationT m a = PopulationT {getPopulationT :: WeightedT (FreeT [] m) a} deriving newtype (Functor, Applicative, Alternative, Monad, MonadIO, MonadPlus, MonadDistribution, MonadFactor, MonadMeasure) @@ -278,12 +283,12 @@ hoist :: PopulationT n a hoist f = PopulationT . Weighted.hoist (hoistFreeT f) . getPopulationT --- | Flatten all layers of the free structure -flatten :: (Monad m) => PopulationT m a -> ApplicativeListT.PopulationT m a -flatten = ApplicativeListT.fromWeightedList . runPopulationT +-- | Flatten all layers of the free structure. +flatten :: (Monad m) => PopulationT m a -> Applicative.PopulationT m a +flatten = Applicative.fromWeightedList . runPopulationT -- | Create a population from a single layer of branching computations. -- -- Similar to 'fromWeightedListT'. -single :: (Monad m) => ApplicativeListT.PopulationT m a -> PopulationT m a -single = fromWeightedList . ApplicativeListT.runPopulationT +single :: (Monad m) => Applicative.PopulationT m a -> PopulationT m a +single = fromWeightedList . Applicative.runPopulationT diff --git a/src/Control/Monad/Bayes/Population/Applicative.hs b/src/Control/Monad/Bayes/Population/Applicative.hs new file mode 100644 index 00000000..7f13d484 --- /dev/null +++ b/src/Control/Monad/Bayes/Population/Applicative.hs @@ -0,0 +1,29 @@ +-- | 'PopulationT' turns a single sample into a collection of weighted samples. +-- +-- This module contains an _'Applicative'_ transformer corresponding to the Population monad transformer from the article. +-- It is based on the old-fashioned 'ListT', which is not a valid monad transformer, but a valid applicative transformer. +-- The corresponding monad transformer is contained in 'Control.Monad.Bayes.Population'. +-- One can convert from the monad transformer to the applicative transformer by 'flatten'ing. +module Control.Monad.Bayes.Population.Applicative where + +import Control.Applicative +import Control.Applicative.List +import Control.Monad.Trans.Writer.Strict +import Data.Functor.Compose +import Numeric.Log (Log) + +-- * Applicative Population transformer + +-- WriterT has to be used instead of WeightedT, +-- since WeightedT uses StateT under the hood, +-- which requires a Monad (ListT m) constraint. + +-- | A collection of weighted samples, or particles. +newtype PopulationT m a = PopulationT {getPopulationT :: WriterT (Log Double) (ListT m) a} + deriving newtype (Functor, Applicative, Alternative) + +runPopulationT :: PopulationT m a -> m [(a, Log Double)] +runPopulationT = runListT . runWriterT . getPopulationT + +fromWeightedList :: m [(a, Log Double)] -> PopulationT m a +fromWeightedList = PopulationT . WriterT . listT