commit f1d3241a83c33fa50056af7eb628696a2f8d46d9
parent e8480e19084267851e255e13bdfded08960c97de
Author: Jared Tobin <jared@jtobin.ca>
Date: Sat, 24 May 2014 23:36:25 +1000
Remove old examples module.
Diffstat:
| D | src/Examples.hs | | | 249 | ------------------------------------------------------------------------------- |
1 file changed, 0 insertions(+), 249 deletions(-)
diff --git a/src/Examples.hs b/src/Examples.hs
@@ -1,249 +0,0 @@
-import Control.Applicative
-import Control.Arrow
-import Control.Error
-import Control.Lens hiding (to)
-import Control.Monad
-import Control.Monad.Cont
-import Control.Monad.Primitive
-import Control.Monad.Trans
-import Data.HashMap.Strict (HashMap)
-import qualified Data.HashMap.Strict as HashMap
-import Data.IntMap.Strict (IntMap)
-import qualified Data.IntMap.Strict as IntMap
-import Data.Vector (singleton)
-import qualified Data.Traversable as Traversable
-import Measurable.Core
-import Numeric.SpecFunctions
-import Statistics.Distribution hiding (mean, variance)
-import Statistics.Distribution.Normal
-import Statistics.Distribution.Beta
-import Statistics.Distribution.ChiSquared
-import System.Random.MWC
-import System.Random.MWC.Distributions
-
--- | Some workhorse densities (with respect to Lebesgue measure).
-genNormal m v = density $ normalDistr m v
-genBeta a b = density $ betaDistr a b
-genChiSq d = density $ chiSquared d
-
--- | Measures created from densities. Notice that the binomial measure has to
--- be treated differently than the measures absolutely continuous WRT Lebesgue
--- measure.
-normalMeasure m v = fromDensityLebesgue $ genNormal m v
-betaMeasure a b = fromDensityLebesgue $ genBeta a b
-chiSqMeasure d = fromDensityLebesgue $ genChiSq d
-
--- | And a measure represented directly over a sampler.
-altBetaMeasure epochs a b g = do
- bs <- lift $ replicateM epochs (genContVar (betaDistr a b) g)
- fromObservationsT bs
-
-
-weirdFunction x
- | x < 0 = sin x
- | x >= 0 && x <= 1 = cos x
- | x > 1 = log x
-
--- | A standard beta-binomial conjugate model. Notice how naturally it's
--- expressed using do-notation!
-betaBinomialConjugate :: Double -> Double -> Int -> Measure Int
-betaBinomialConjugate a b n = do
- p <- betaMeasure a b
- binomMeasure n p
-
-altBetaBinomialConjugate a b n g = do
- p <- altBetaMeasure 1000 a b g
- binomMeasure n p
-
-
--- | Observe a binomial distribution.
-genBinomSamples
- :: (Applicative m, PrimMonad m)
- => Int
- -> Int
- -> Double
- -> Gen (PrimState m)
- -> m [Int]
-genBinomSamples n m p g = replicateM n $ genBinomial m p g
-
--- | Observe a beta distribution.
-genBetaSamples
- :: (Applicative m, PrimMonad m)
- => Int
- -> Double
- -> Double
- -> Gen (PrimState m)
- -> m [Double]
-genBetaSamples n a b g = replicateM n $ genContVar (betaDistr a b) g
-
--- | Observe a gamma distribution.
-genGammaSamples
- :: (Applicative m, PrimMonad m)
- => Int
- -> Double
- -> Double
- -> Gen (PrimState m)
- -> m [Double]
-genGammaSamples n a b g = replicateM n $ gamma a b g
-
--- | Observe a normal distributions.
-genNormalSamples
- :: (Applicative m, PrimMonad m)
- => Int
- -> Double
- -> Double
- -> Gen (PrimState m)
- -> m [Double]
-genNormalSamples n m t g = replicateM n $ normal m (1 / t) g
-
--- | Normal-gamma model. Note the resulting type is a probability measure on
--- tuples.
---
--- X | t ~ N(mu, 1/(lambda * t))
--- t ~ gamma(a, b)
--- (X, t) ~ NormalGamma(mu, lambda, a, b)
-normalGammaMeasure
- :: (Applicative m, PrimMonad m)
- => Int
- -> Double
- -> Double
- -> Double
- -> Double
- -> Gen (PrimState m)
- -> MeasureT m (Double, Double)
-normalGammaMeasure n a b mu lambda g = do
- gammaSamples <- lift $ genGammaSamples n a b g
- precision <- fromObservationsT gammaSamples
-
- normalSamples <- lift $ genNormalSamples n mu (lambda * precision) g
- location <- fromObservationsT normalSamples
-
- return (location, precision)
-
--- | Alternate Normal-gamma model, to demonstrate probability measures over
--- various return types. Here we have a probability distribution over hash
--- maps.
-altNormalGammaMeasure
- :: (Applicative m, PrimMonad m)
- => Int
- -> Double
- -> Double
- -> Double
- -> Double
- -> Gen (PrimState m)
- -> MeasureT m (HashMap String Double)
-altNormalGammaMeasure n a b mu lambda g = do
- gammaSamples <- lift $ genGammaSamples n a b g
- precision <- fromObservationsT gammaSamples
-
- normalSamples <- lift $ genNormalSamples n mu (lambda * precision) g
- location <- fromObservationsT normalSamples
-
- return $ HashMap.fromList [("location", location), ("precision", precision)]
-
--- | A normal-normal gamma conjugate model
-normalNormalGammaMeasure
- :: (Applicative m, PrimMonad m)
- => Int
- -> Double
- -> Double
- -> Double
- -> Double
- -> Gen (PrimState m)
- -> MeasureT m Double
-normalNormalGammaMeasure n a b mu lambda g = do
- (m, t) <- normalGammaMeasure n a b mu lambda g
- normalSamples <- lift $ genNormalSamples n m t g
- fromObservationsT normalSamples
-
--- | Alternate normal-normal gamma conjugate model.
-altNormalNormalGammaMeasure
- :: (Applicative m, PrimMonad m)
- => Int
- -> Double
- -> Double
- -> Double
- -> Double
- -> Gen (PrimState m)
- -> MeasureT m Double
-altNormalNormalGammaMeasure n a b mu lambda g = do
- parameterHash <- altNormalGammaMeasure n a b mu lambda g
- let m = fromMaybe (error "no location!") $
- HashMap.lookup "location" parameterHash
- t = fromMaybe (error "no precision!") $
- HashMap.lookup "precision" parameterHash
- normalSamples <- lift $ genNormalSamples n m t g
- fromObservationsT normalSamples
-
--- | The binomial density.
-binom :: Double -> Int -> Int -> Double
-binom p n k
- | n <= 0 = 0
- | k < 0 = 0
- | n < k = 0
- | otherwise = n `choose` k * p ^ k * (1 - p) ^ (n - k)
-
--- | Generate a measure from the binomial density.
-binomMeasure
- :: (Applicative m, Monad m)
- => Int
- -> Double
- -> MeasureT m Int
-binomMeasure n p = fromDensityCountingT (binom p n) [0..n]
-
--- | Note that we can handle all sorts of things that have densities w/respect
--- to counting measure. They don't necessarily have to have domains that
--- are instances of Num (or even have Ordered domains, though that's the case
--- here).
-data Group = A | B | C deriving (Eq, Show)
-
--- | Density of a categorical measure.
-categoricalOnGroupDensity :: Fractional a => Group -> a
-categoricalOnGroupDensity g
- | g == A = 0.3
- | g == B = 0.6
- | g == C = 0.1
-
--- | Here's a measure defined on the Group data type.
-categoricalOnGroupMeasure
- :: (Applicative m, Monad m)
- => MeasureT m Group
-categoricalOnGroupMeasure =
- fromDensityCountingT categoricalOnGroupDensity [A, B, C]
-
--- | A gaussian mixture model, with mixing probabilities based on observed
--- groups. Again, note that Group is not an instance of Num! We can compose
--- measures of various types, so long as our 'end type' is Fractional.
---
--- X | S ~ case S of
--- A -> observed from N(-2, 1)
--- B -> observed from N( 0, 1)
--- C -> observed from N( 1, 1)
---
--- S ~ observed from categorical
---
-gaussianMixtureModel
- :: (Applicative m, PrimMonad m)
- => Int
- -> [Group]
- -> Gen (PrimState m)
- -> MeasureT m Double
-gaussianMixtureModel n observed g = do
- s <- fromObservationsT observed
- samples <- case s of
- A -> lift $ genNormalSamples n (-2) 1 g
- B -> lift $ genNormalSamples n 0 1 g
- C -> lift $ genNormalSamples n 1 1 g
-
- fromObservationsT samples
-
--- | Count the number of Trues in a list.
-countTrue :: [Bool] -> Int
-countTrue = length . filter id
-
-genBernoulli :: PrimMonad m => Double -> Gen (PrimState m) -> m Bool
-genBernoulli p g = liftM (< p) (uniform g)
-
-genBinomial :: PrimMonad m => Int -> Double -> Gen (PrimState m) -> m Int
-genBinomial n p g = liftM countTrue (replicateM n $ genBernoulli p g)
-
