**commit** 2c683db9f2d791dc8bf3e9bf6107f65844704dc2
**parent** c797f2a3b2edcb87b1a95a1c6091dc0f09492583
**Author:** Jared Tobin <jared@jtobin.ca>
**Date:** Mon, 21 Oct 2013 16:53:11 +1300
Add mixture model to examples.
**Diffstat:**

1 file changed, 33 insertions(+), 2 deletions(-)

**diff --git a/src/Examples.hs b/src/Examples.hs**
@@ -136,11 +136,37 @@ categoricalOnGroupDensity g
-- | Here's a measure defined on the Group data type.
categoricalOnGroupMeasure
- :: (Applicative m, Monad m, Fractional a)
- => MeasureT a m Group
+ :: (Applicative m, Monad m, Fractional r)
+ => MeasureT r m Group
categoricalOnGroupMeasure =
fromMassFunction (return . 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
+ :: (Fractional r, Applicative m, PrimMonad m)
+ => Int
+ -> [Group]
+ -> Gen (PrimState m)
+ -> MeasureT r m Double
+gaussianMixtureModel n observed g = do
+ s <- fromObservations 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
+
+ fromObservations samples
+
main :: IO ()
main = do
let nng = normalNormalGammaMeasure 30 2 6 1 0.5
@@ -168,6 +194,9 @@ main = do
groupsObservedProbBC <- expectation id
(containing [B, C] <$> categoricalFromObservationsMeasure)
+ mixtureModelMean <- withSystemRandom . asGenIO $ \g ->
+ expectation id (gaussianMixtureModel 30 groupsObserved g)
+
print m0
print m1
@@ -179,3 +208,5 @@ main = do
print groupProbBC
print groupsObservedProbBC
+ print mixtureModelMean
+