Expr.hs (1320B)
1 2 module Deanie.Expr ( 3 -- * utilities 4 5 product 6 , iid 7 , indep 8 9 -- * distributions 10 11 , binomial 12 , uniform 13 , exponential 14 , chisq 15 , coin 16 , lgaussian 17 , invgamma 18 , geometric 19 ) where 20 21 import Control.Applicative.Extended 22 import qualified Control.Foldl as L 23 import Control.Monad 24 import Data.Function (fix) 25 import Deanie.Language 26 import Prelude hiding (product) 27 28 product :: Ap (Free ProgramF) a -> Program a 29 product term = liftF (ProgramF (InR term)) 30 31 iid :: Int -> Program a -> Program [a] 32 iid n term = product (replicateA n (liftAp term)) 33 34 indep :: f a -> Ap f a 35 indep = liftAp 36 37 binomial :: Int -> Double -> Program Int 38 binomial n p = fmap count (replicateM n (bernoulli p)) where 39 count = L.fold (L.handles (L.filtered id) L.length) 40 41 uniform :: Program Double 42 uniform = beta 1 1 43 44 exponential :: Double -> Program Double 45 exponential = gamma 1 46 47 chisq :: Integral a => a -> Program Double 48 chisq k = gamma (fromIntegral k / 2) (1 / 2) 49 50 coin :: Program Bool 51 coin = bernoulli 0.5 52 53 lgaussian :: Double -> Double -> Program Double 54 lgaussian m sd = fmap exp (gaussian m sd) 55 56 invgamma :: Double -> Double -> Program Double 57 invgamma a b = fmap recip (gamma a b) 58 59 geometric :: Double -> Program Int 60 geometric p = fix $ \count -> do 61 accept <- bernoulli p 62 if accept 63 then return 1 64 else fmap succ count 65