ProbabilityMonads (empty) → 0.1.0

raw patch · 10 files changed

+598/−0 lines, 10 filesdep +MaybeTdep +MonadRandomdep +basebuild-type:Customsetup-changed

Dependencies added: MaybeT, MonadRandom, base, mtl

Files

• Control/Monad/Distribution.hs +41/−0
• Control/Monad/Distribution/Base.hs +282/−0
• Control/Monad/Distribution/Rational.hs +36/−0
• Control/Monad/MonoidValue.hs +86/−0
• Data/Probability.hs +37/−0
• Data/Probability/Base.hs +39/−0
• Data/Probability/Rational.hs +26/−0
• LICENSE +26/−0
• ProbabilityMonads.cabal +23/−0
• Setup.hs +2/−0

@@ -0,0 +1,41 @@+{- |+Copyright    : 2007 Eric Kidd+License      : BSD3+Stability    : experimental++This module is a wrapper around @Control.Monad.Distribution.Base@.  It+provides definitions of 'DDist', 'ddist', 'BDDist' and 'bddist' based on+double-precion floating point numbers.++For the main API, see @Control.Monad.Distribution.Base@.  For alternative+versions of 'DDist', etc., based on exact rational numbers, see+@Control.Monad.Distribution.Rational@.++-}++module Control.Monad.Distribution (+    module Control.Monad.Distribution.Base,+    DDist, ddist, BDDist, bddist+  ) where++import Control.Monad.Distribution.Base+import Control.Monad.Maybe+import Control.Monad.MonoidValue+import Data.Probability++-- | A discrete, finite probability distribution implemented using rational+-- numbers.+type DDist = MVT Prob []++-- | Force a value to be interpreted as having type 'DDist'.+ddist :: DDist a -> DDist a+ddist d = d++-- | A version of 'BDDist' with support for Bayes' theorem.+type BDDist = MaybeT DDist++-- | Force a value to be interpreted as having type 'BDDist', and apply+-- Bayes' rule.  Returns 'Nothing' if no possible combination of events+-- will satisfy the guard conditions specified in 'BDDist'.+bddist :: BDDist a -> Maybe (DDist a)+bddist d = bayes d

@@ -0,0 +1,282 @@+{-# LANGUAGE MultiParamTypeClasses, UndecidableInstances #-}++{- |+Copyright    : 2007 Eric Kidd+License      : BSD3+Stability    : experimental++Common interface for probability distribution monads.  Heavily inspired by+Martin Erwig's and Steve Kollmansberger's /Probabilistic Functional+Programming/, which can be found at+<http://web.engr.oregonstate.edu/~erwig/pfp/>.++For background, see Michele Giry, /A Categorical Approach to Probability+Theory/.++-}++module Control.Monad.Distribution.Base (+    -- * Common interface+    -- $Interface+    Dist, weighted, uniform,+    -- * Bayes' rule+    -- $Bayes+    MonadPlus, mzero, mplus, guard, -- Re-exported from Control.Monad.+    -- * Random sampling functions+    -- $Rand+    module Control.Monad.Random,+    sample, sampleIO,+    BRand, sampleBayes, sampleBayesIO,+    -- * Discrete, finite distributions+    -- $DDist+    bayes+  ) where++import Control.Monad+import Control.Monad.Maybe+import Control.Monad.MonoidValue+import Control.Monad.Random+import Control.Monad.Trans+import Data.List+import Data.Maybe+import Data.Probability++{- $Interface++Common interfaces to probability monads.  For example, if we assume that a+family has two children, each a boy or a girl, we can build a probability+distribution representing all such families.++>{-# LANGUAGE NoMonomorphismRestriction #-}+>+>import Control.Monad.Distribution+>+>data Child = Girl | Boy+>  deriving (Show, Eq, Ord)+>+>child = uniform [Girl, Boy]+>+>family = do+>  child1 <- child+>  child2 <- child+>  return [child1, child2]++The use of @NoMonomorphismRestriction@ is optional.  It eliminates the need+for type declarations on @child@ and @family@:++>child :: (Dist d) => d Child+>child = uniform [Girl, Boy]+>+>family :: (Dist d) => d [Child]+>family = ...++Unfortunately, using @NoMonomorphismRestriction@ may hide potential+performance issues.  In either of the above examples, Haskell compilers may+recompute @child@ from scratch each time it is called, because the actual+type of the distribution @d@ is unknown.  Normally, Haskell requires an+explicit type declaration in this case, in hope that you will notice the+potential performance issue.  By enabling @NoMonomorphismRestriction@, you+indicate that you intended the code to work this way, and don't wish to use+type declarations on every definition.++-}++-- | Represents a probability distribution.+class (Functor d, Monad d) => Dist d where+  -- | Creates a new distribution from a weighted list of values.  The+  -- individual weights must be non-negative, and they must sum to a+  -- positive number.+  weighted :: [(a, Rational)] -> d a+  -- TODO: What order do we want weighted's arguments in?++-- | Creates a new distribution from a list of values, weighting it evenly.+uniform :: Dist d => [a] -> d a+uniform = weighted . map (\x -> (x, 1))++{- $Bayes++Using 'Control.Monad.guard', it's possible to calculate conditional+probabilities using Bayes' rule.  In the example below, we choose to+@Control.Monad.Distribution.Rational@, which calculates probabilities using+exact rational numbers.  This is useful for small, interactive programs+where you want answers like 1/3 and 2/3 instead of 0.3333333 and 0.6666666.++>{-# LANGUAGE NoMonomorphismRestriction #-}+>+>import Control.Monad+>import Control.Monad.Distribution.Rational+>import Data.List+>+>data Coin = Heads | Tails+>  deriving (Eq, Ord, Show)+>+>toss = uniform [Heads, Tails]+>+>tosses n = sequence (replicate n toss)+>+>tossesWithAtLeastOneHead n = do+>  result <- tosses n+>  guard (Heads `elem` result)+>  return result++In this example, we use 'Control.Monad.guard' to discard possible outcomes+where no coin comes up heads.++-}+++-- | A distribution which supports 'Dist' and 'Control.Monad.MonadPlus'+-- supports Bayes' rule.  Use 'Control.Monad.guard' to calculate a+-- conditional probability.+class (Dist d, MonadPlus d) => BayesDist d+  -- TODO: Do we want to add an associated type here, pointing to the+  -- underlying distribution type?++-- Applying MaybeT to a distribution gives you another distribution, but+-- with support for Bayes' rule.+instance (Dist d) => Dist (MaybeT d) where+  weighted wvs = lift (weighted wvs)++{- $Rand++Support for probability distributions represented by sampling functions.+This API is heavily inspired by Sungwoo Park and colleagues'+$\lambda_{\bigcirc}$ caculus <http://citeseer.ist.psu.edu/752237.html>.++Two sampling-function monads are available: 'Control.Monad.Random.Rand' and+'BRand'.  The former provides ordinary sampling functions, and the latter+supports Bayesian reasoning.++It's possible run code in the 'Control.Monad.Random.Rand' monad using+either 'sample' or 'sampleIO'.++>sampleIO family 3+>-- [[Boy,Girl],[Boy,Girl],[Girl,Girl]]++If the probability distribution uses 'Control.Monad.guard', you can run it+using 'sampleBayesIO'.  Note that one of the outcomes below was discarded,+leaving 3 outcomes instead of the expected 4:++>sampleBayesIO (tossesWithAtLeastOneHead 2) 4+>-- [[Tails,Heads],[Heads,Heads],[Tails,Heads]]++-}++-- Make all the standard instances of MonadRandom into probability+-- distributions.+instance (RandomGen g) => Dist (Rand g) where+  weighted = fromList+instance (Monad m, RandomGen g) => Dist (RandT g m) where +  weighted = fromList++-- | Take @n@ samples from the distribution @r@.+sample :: (MonadRandom m) => m a -> Int -> m [a]+sample d n = sequence (replicate n d)++-- | Take @n@ samples from the distribution @r@ using the IO monad.+sampleIO :: Rand StdGen a -> Int -> IO [a]+sampleIO d n = evalRandIO (sample d n)++-- | A random distribution where some samples may be discarded.+type BRand g = MaybeT (Rand g)++instance (RandomGen g) => BayesDist (MaybeT (Rand g))+instance (RandomGen g, Monad m) => BayesDist (MaybeT (RandT g m))++instance (RandomGen g) => MonadPlus (MaybeT (Rand g)) where+  mzero = randMZero+  mplus = randMPlus++instance (RandomGen g, Monad m) => MonadPlus (MaybeT (RandT g m)) where+  mzero = randMZero+  mplus = randMPlus++randMZero :: (MonadRandom m) => (MaybeT m a)+randMZero = MaybeT (return Nothing)++-- TODO: I'm not sure this is particularly sensible or useful.+randMPlus :: (MonadRandom m) => (MaybeT m a) -> (MaybeT m a) -> (MaybeT m a)+randMPlus d1 d2 = MaybeT choose+  where choose = do+          x1 <- runMaybeT d1+          case x1 of+            Nothing -> runMaybeT d2+            Just _  -> return x1+++-- | Take @n@ samples from the distribution @r@, and eliminate any samples+-- which fail a 'Control.Monad.guard' condition.+sampleBayes :: (MonadRandom m) => MaybeT m a -> Int -> m [a]+sampleBayes d n = liftM catMaybes (sample (runMaybeT d) n)++-- | Take @n@ samples from the distribution @r@ using the IO monad, and+-- eliminate any samples which fail a 'Control.Monad.guard' condition.+sampleBayesIO :: BRand StdGen a -> Int -> IO [a]+sampleBayesIO d n = evalRandIO (sampleBayes d n)++{- $DDist++Using the 'Control.Monad.Distribution.DDist' and+'Control.Monad.Distribution.BDDist' monads, you can compute exact+distributions. For example:++>ddist family+>-- [MV 0.25 [Girl,Girl],+>--  MV 0.25 [Girl,Boy],+>--  MV 0.25 [Boy,Girl],+>--  MV 0.25 [Boy,Boy]]++If the probability distribution uses 'Control.Monad.guard', you can run it+using 'Control.Monad.Distribution.bddist'.++>bddist (tossesWithAtLeastOneHead 2)+>-- Just [MV 1%3 [Heads,Heads],+>--       MV 1%3 [Heads,Tails],+>--       MV 1%3 [Tails,Heads]]++Note that we see rational numbers in this second example, because we used+@Control.Monad.Distribution.Rational@ above.++-}++instance (Probability p) => Dist (MVT p []) where+  weighted wvs = MVT (map toMV wvs)+    where toMV (v, w) = MV (prob (w / total)) v +          total = sum (map snd wvs)++instance (Show a, Ord a, Show p, Probability p) => Show (MVT p [] a) where+  show = show . simplify . runMVT++simplify :: (Probability p, Ord a) => [MV p a] -> [MV p a]+simplify = map (foldr1 merge) . groupEvents . sortEvents+  where sortEvents = sortBy (liftOp compare)+        groupEvents = groupBy (liftOp (==))+        liftOp op  (MV _   v1) (MV _   v2)  = op v1 v2+        merge      (MV w1  v1) (MV w2  _)   = MV (w1 `padd` w2) v1++instance (Probability p) => BayesDist (MaybeT (MVT p []))++instance (Probability p) => MonadPlus (MaybeT (MVT p [])) where+  mzero = MaybeT (return Nothing)+  -- TODO: I'm not sure this is particularly sensible or useful.+  d1 `mplus` d2+     | isNothing (bayes d1)  = d2+     | otherwise             = d1++catMaybes' :: (Monoid w) => [MV w (Maybe a)] -> [MV w a]+catMaybes' = map (liftM fromJust) . filter (isJust . mvValue)++-- | Apply Bayes' rule, discarding impossible outcomes and normalizing the+-- probabilities that remain.+--+-- TODO: It's entirely possible that this method should be moved to a type+-- class.+bayes :: (Probability p) =>+         MaybeT (MVT p []) a -> Maybe ((MVT p []) a)+bayes bfd+    | total == prob 0 = Nothing+    | otherwise       = Just (weighted (map unpack events))+  where+    events = catMaybes' (runMVT (runMaybeT bfd))+    total  = foldl' padd (prob 0) (map mvMonoid events)+    unpack (MV p v) = (v, fromProb p)

@@ -0,0 +1,36 @@+{- |+Copyright    : 2007 Eric Kidd+License      : BSD3+Stability    : experimental++An alternative version of @Control.Monad.Distribution@ based on exact+rational numbers.++-}++module Control.Monad.Distribution.Rational (+    module Control.Monad.Distribution.Base,+    DDist, ddist, BDDist, bddist+  ) where++import Control.Monad.Distribution.Base+import Control.Monad.Maybe+import Control.Monad.MonoidValue+import Data.Probability.Rational++-- | A discrete, finite probability distribution implemented using+-- double-precision floating-point numbers.+type DDist = MVT Prob []++-- | Force a value to be interpreted as having type 'DDist'.+ddist :: DDist a -> DDist a+ddist d = d++-- | A version of 'BDDist' with support for Bayes' theorem.+type BDDist = MaybeT DDist++-- | Force a value to be interpreted as having type 'BDDist', and apply+-- Bayes' rule.  Returns 'Nothing' if no possible combination of events+-- will satisfy the guard conditions specified in 'BDDist'.+bddist :: BDDist a -> Maybe (DDist a)+bddist d = bayes d

@@ -0,0 +1,86 @@+{-# LANGUAGE MultiParamTypeClasses, UndecidableInstances #-}++{- |+Copyright    : 2007 Eric Kidd+License      : BSD3+Stability    : experimental+Portability  : non-portable (multi-parameter type classes, undecidable instances)++This module provides stripped-down versions of+'Control.Monad.Writer.Writer' and 'Control.Monad.Writer.WriterT', minus the+operations 'Control.Monad.Writer.tell', 'Control.Monad.Writer.listen' and+'Control.Monad.Writer.pass'.  It a useful building block for monads+representing probability distributions or quantum states, where the extra+functions provided by 'Control.Monad.Writer.Class.MonadWriter' are+irrelevant or inappropriate.++The 'MV' monad and the 'MVT' monad transformer were proposed by Dan Piponi+as a way of representing M-sets in Haskell.  An /M-set/ is a set with a+monoid action (by analogy to the more common G-sets found in group theory).+Here, 'MV' represents an element in a /free M-set/.  This is essentially a+(monoid,value) pair.++[Computation type:] Computations with an associated monoid action.++[Binding strategy:] The @return@ function lifts a value into the monad by+pairing it with @mempty@.  The @bind@ function uses @mappend@ to implement+the monoid action.++[Useful for:] Building probability distribution monads.++-}++module Control.Monad.MonoidValue (+    module Data.Monoid,+    MV(MV), mvMonoid, mvValue, MVT(MVT), runMVT+  ) where++import Control.Monad.Trans+import Data.Monoid++-- | A value annotated with a monoid.  Represents an element in a free+-- M-set.+data (Monoid w) => MV w a =+  MV { mvMonoid :: w, mvValue :: a }++instance (Monoid w, Show w, Show a) => Show (MV w a) where+  show (MV w a) = "MV " ++ show w ++ " " ++ show a++-- We build our functor and monad instances from 'mapMV' and 'joinMV' for+-- simplicity.+mapMV :: (Monoid w) => (a -> b) -> MV w a -> MV w b+mapMV f (MV w v) = MV w (f v)++joinMV :: (Monoid w) => MV w (MV w a) -> MV w a+joinMV (MV w1 (MV w2 v)) = MV (w1 `mappend` w2) v++instance (Monoid w) => Functor (MV w) where+  fmap = mapMV++instance (Monoid w) => Monad (MV w) where+  return v = MV mempty v+  mv >>= f = joinMV (mapMV f mv)++-- | Transforms a monad @m@ to associate a monoid value with the+-- computation.+newtype (Monoid w, Monad m) => MVT w m a =+  MVT { runMVT :: m (MV w a) }++instance (Monoid w) => MonadTrans (MVT w) where+  lift mv = MVT (do v <- mv+                    return (MV mempty v))++instance (Monoid w, Monad m) => Functor (MVT w m) where+  fmap f ma = MVT mapped+    where mapped = do+            (MV w v) <- runMVT ma+            return (MV w (f v))++instance (Monoid w, Monad m) => Monad (MVT w m) where+  return   = lift . return+  ma >>= f = MVT bound+    where  bound = do+             (MV w1 v1) <- runMVT ma+             (MV w2 v2) <- runMVT (f v1)+             return (MV (w1 `mappend` w2) v2)+

@@ -0,0 +1,37 @@+{- |+Copyright    : 2007 Eric Kidd+License      : BSD3+Stability    : experimental++This API is very limited, and only suited to use within the+ProbabilityMonad library.  If you're interested in redesigning this, your+input would be appreciated.++-}++module Data.Probability (+    module Data.Probability.Base,+    Prob()+  ) where++import Data.Monoid+import Data.Probability.Base++-- | An implementation of 'Data.Probability.Probability' using+-- double-precision floating-point numbers.+newtype Prob = Prob Double+  deriving (Eq)++instance Probability Prob where+  prob = Prob . fromRational+  fromProb (Prob p) = toRational p+  pnot (Prob p) = Prob (1-p)+  padd (Prob p1) (Prob p2) = Prob (p1 + p2)+  pmul (Prob p1) (Prob p2) = Prob (p1 * p2)++instance Monoid Prob where+  mempty = prob 1+  mappend = pmul++instance Show Prob where+  show (Prob p) = show p

@@ -0,0 +1,39 @@+{- |+Copyright    : 2007 Eric Kidd+License      : BSD3+Stability    : experimental+Portability  : non-portable (newtype deriving)++Support for probability values.+-}++module Data.Probability.Base (+    Probability,+    prob, fromProb,+    pnot, padd, pmul+  ) where++import Data.Monoid++-- | The probability of an event occuring.  We provide this as a type+-- class, allowing users of this library to choose among various+-- representations of probability.+class (Eq p, Monoid p) => Probability p where+  -- TODO: Should 'prob' and 'fromProb' work with Rational or another type?+  -- They exist mostly to interface with+  -- 'Control.Monad.Distribution.weighted'.++  -- | Create a probability from a rational number between 0 and 1, inclusive.+  prob :: Rational -> p+  -- | Convert a probability to a rational number.+  fromProb :: p -> Rational++  -- | Given the probability of an event occuring, calculate the+  -- probability of the event /not/ occuring.+  pnot :: p -> p+  -- | Given the probabilities of two disjoint events, calculate the+  -- probability of either event occuring.+  padd :: p -> p -> p+  -- | Given the probabilities of two indepedent events, calculate the+  -- probability of both events occuring.+  pmul :: p -> p -> p

@@ -0,0 +1,26 @@+module Data.Probability.Rational (+    module Data.Probability.Base,+    Prob()+  ) where++import Data.Monoid+import Data.Probability.Base++-- | An implementation of 'Data.Probability.Probability' using rational+-- numbers.+newtype Prob = Prob Rational+  deriving (Eq)++instance Probability Prob where+  prob = Prob+  fromProb (Prob p) = p+  pnot (Prob p) = Prob (1-p)+  padd (Prob p1) (Prob p2) = Prob (p1 + p2)+  pmul (Prob p1) (Prob p2) = Prob (p1 * p2)++instance Monoid Prob where+  mempty = prob 1+  mappend = pmul++instance Show Prob where+  show (Prob p) = show p

@@ -0,0 +1,26 @@+Probability library for Haskell.+Copyright 2007 Eric Kidd.  All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++  * Redistributions of source code must retain the above copyright notice,+    this list of conditions and the following disclaimer.+  * Redistributions in binary form must reproduce the above copyright+    notice, this list of conditions and the following disclaimer in the+    documentation and/or other materials provided with the distribution.+  * The names of this library's contributors may not be used to endorse or+    promote products derived from this software without specific prior+    written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,23 @@+Name:                ProbabilityMonads+Version:             0.1.0+Synopsis:            Probability distribution monads.+Description:         Tools for random sampling, explicit enumeration of possible+                     outcomes, and applying Bayes' rule.  Highly experimental,+                     and subject to change.  In particular, the+                     Data.Probability API is rather poor and could stand an+                     overhaul.+License:             BSD3+License-file:        LICENSE+Category:            Control+Author:              Eric Kidd <haskell@randomhacks.net>+Maintainer:          Eric Kidd <haskell@randomhacks.net>+Stability:           experimental+Build-Depends:       base, mtl, MaybeT, MonadRandom+Exposed-modules:     Data.Probability.Base,+                     Data.Probability,+                     Data.Probability.Rational,+                     Control.Monad.MonoidValue,+                     Control.Monad.Distribution.Base,+                     Control.Monad.Distribution,+                     Control.Monad.Distribution.Rational+ghc-options:         -Wall -fno-warn-orphans -O

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain