commit 46c6ae601d4af640215eb9aa86e6b53487e4d6e4
parent 793d0bba901f116754b8602bf3e042662c60d3bf
Author: Jared Tobin <jared@jtobin.ca>
Date: Mon, 21 Oct 2013 15:58:52 +1300
Drop trailing T from transformer-version names.
Diffstat:
2 files changed, 32 insertions(+), 25 deletions(-)
diff --git a/src/Examples.hs b/src/Examples.hs
@@ -47,10 +47,10 @@ normalGammaMeasure
-> MeasureT r m (Double, Double)
normalGammaMeasure n a b mu lambda g = do
gammaSamples <- lift $ genGammaSamples n a b g
- precision <- fromObservationsT gammaSamples
+ precision <- fromObservations gammaSamples
normalSamples <- lift $ genNormalSamples n mu (lambda * precision) g
- location <- fromObservationsT normalSamples
+ location <- fromObservations normalSamples
return (location, precision)
@@ -68,10 +68,10 @@ altNormalGammaMeasure
-> MeasureT r m (HashMap String Double)
altNormalGammaMeasure n a b mu lambda g = do
gammaSamples <- lift $ genGammaSamples n a b g
- precision <- fromObservationsT gammaSamples
+ precision <- fromObservations gammaSamples
normalSamples <- lift $ genNormalSamples n mu (lambda * precision) g
- location <- fromObservationsT normalSamples
+ location <- fromObservations normalSamples
return $ HashMap.fromList [("location", location), ("precision", precision)]
@@ -87,7 +87,7 @@ normalNormalGammaMeasure
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
+ fromObservations normalSamples
altNormalNormalGammaMeasure
:: (Fractional r, PrimMonad m)
@@ -105,7 +105,7 @@ altNormalNormalGammaMeasure n a b mu lambda g = do
t = fromMaybe (error "no precision!") $
HashMap.lookup "precision" parameterHash
normalSamples <- lift $ genNormalSamples n m t g
- fromObservationsT normalSamples
+ fromObservations normalSamples
-- | A binomial density (with respect to counting measure).
binom :: Double -> Int -> Int -> Double
@@ -121,7 +121,7 @@ binomMeasure
=> Int
-> Double
-> MeasureT Double m Int
-binomMeasure n p = fromMassFunctionT (return . binom p n) [0..n]
+binomMeasure n p = fromMassFunction (return . binom p n) [0..n]
-- | Note that we can handle all sorts of things that are densities w/respect
-- to counting measure. They don't necessarily have to have integral
@@ -139,29 +139,35 @@ categoricalOnGroupMeasure
:: (Applicative m, Monad m, Fractional a)
=> MeasureT a m Group
categoricalOnGroupMeasure =
- fromMassFunctionT (return . categoricalOnGroupDensity) [A, B, C]
+ fromMassFunction (return . categoricalOnGroupDensity) [A, B, C]
main :: IO ()
main = do
let nng = normalNormalGammaMeasure 30 2 6 1 0.5
anng = altNormalNormalGammaMeasure 30 2 6 1 0.5
m0 <- withSystemRandom . asGenIO $ \g ->
- expectationT id $ nng g
+ expectation id $ nng g
m1 <- withSystemRandom . asGenIO $ \g ->
- expectationT id $ anng g
+ expectation id $ anng g
p0 <- withSystemRandom . asGenIO $ \g ->
- expectationT id $ 2 `to` 3 <$> nng g
+ expectation id $ 2 `to` 3 <$> nng g
p1 <- withSystemRandom . asGenIO $ \g ->
- expectationT id $ 2 `to` 3 <$> anng g
+ expectation id $ 2 `to` 3 <$> anng g
- binomialMean <- expectationT fromIntegral (binomMeasure 10 0.5)
+ binomialMean <- expectation fromIntegral (binomMeasure 10 0.5)
- groupProbBC <- expectationT id
+ groupProbBC <- expectation id
(containing [B, C] <$> categoricalOnGroupMeasure)
+ let groupsObserved = [A, A, A, B, A, B, B, A, C, B, B, A, A, B, C, A, A]
+ categoricalFromObservationsMeasure = fromObservations groupsObserved
+
+ groupsObservedProbBC <- expectation id
+ (containing [B, C] <$> categoricalFromObservationsMeasure)
+
print m0
print m1
@@ -171,4 +177,5 @@ main = do
print binomialMean
print groupProbBC
+ print groupsObservedProbBC
diff --git a/src/Measurable/Generic.hs b/src/Measurable/Generic.hs
@@ -19,8 +19,8 @@ measureT :: MeasureT r m a -> (a -> m r) -> m r
measureT = runContT
-- | Create a measure from observations (samples) from some distribution.
-fromObservationsT :: (Monad m, Fractional r) => [a] -> ContT r m a
-fromObservationsT xs = ContT (`weightedAverageM` xs)
+fromObservations :: (Monad m, Fractional r) => [a] -> MeasureT r m a
+fromObservations xs = ContT (`weightedAverageM` xs)
-- A mass function is close to universal when dealing with discrete objects, but
-- the problem is that we need to create it over the entire support. In terms
@@ -29,12 +29,12 @@ fromObservationsT xs = ContT (`weightedAverageM` xs)
--
-- Maybe we can use something like an 'observed support'. You can probably get
-- inspiration from how the Dirichlet process is handled in practice.
-fromMassFunctionT
+fromMassFunction
:: (Num r, Applicative f)
=> (a -> f r)
-> [a]
- -> ContT r f a
-fromMassFunctionT p support = ContT $ \f ->
+ -> MeasureT r f a
+fromMassFunction p support = ContT $ \f ->
fmap sum . traverse (liftA2 (liftA2 (*)) f p) $ support
-- | Expectation is obtained by integrating against the identity function. We
@@ -43,19 +43,19 @@ fromMassFunctionT p support = ContT $ \f ->
--
-- NOTE should we have this transformation handled elsewhere? I.e. make fmap
-- responsible for transforming the type?
-expectationT :: Monad m => (a -> r) -> MeasureT r m a -> m r
-expectationT f = (`measureT` (return . f))
+expectation :: Monad m => (a -> r) -> MeasureT r m a -> m r
+expectation f = (`measureT` (return . f))
-- | The volume is obtained by integrating against a constant. This is '1' for
-- any probability measure.
-volumeT :: (Num r, Monad m) => MeasureT r m r -> m r
-volumeT mu = measureT mu (return . const 1)
+volume :: (Num r, Monad m) => MeasureT r m r -> m r
+volume mu = measureT mu (return . const 1)
-- | Cumulative distribution function. Only makes sense for Fractional/Ord
-- inputs. Lots of potentially interesting cases where this isn't necessarily
-- true.
-cdfT :: (Fractional r, Ord r, Monad m) => MeasureT r m r -> r -> m r
-cdfT mu x = expectationT id $ (negativeInfinity `to` x) <$> mu
+cdf :: (Fractional r, Ord r, Monad m) => MeasureT r m r -> r -> m r
+cdf mu x = expectation id $ (negativeInfinity `to` x) <$> mu
-- | Integrate from a to b.
to :: (Num a, Ord a) => a -> a -> a -> a
