measurable

commit 572c5a6952e16a4ab410953b224f0932c6c834a7
parent 998b4f890ef96e65a353c7a36ff7d7d6c89f5405
Author: Jared Tobin <jared@jtobin.ca>
Date:   Fri,  3 Apr 2015 17:20:45 +1000

Fix fromMassFunction bug, add custom binom pmf.

* The distributions from Statistics don't behave well.  Not sure why.

Diffstat:
M
measurable.cabal
 | 
1
+
M
src/Measurable/Core.hs
 | 
9
+++++++--
M
src/Measurable/Measures.hs
 | 
7
++++++-

3 files changed, 14 insertions(+), 3 deletions(-)
diff --git a/measurable.cabal b/measurable.cabal
@@ -53,6 +53,7 @@ library
       base >= 4.7 && < 4.8
     , foldl
     , integration
+    , math-functions
     , mtl
     , statistics
     , transformers
diff --git a/src/Measurable/Core.hs b/src/Measurable/Core.hs
@@ -93,8 +93,13 @@ instance (Applicative m, Num a) => Num (ContT Double m a) where
 --   >>> let mu = fromMassFunction (binomialPmf 10 0.2) [0..10]
 --   >>> integrate fromIntegral mu
 --   2.0
-fromMassFunction :: Foldable f => (a -> Double) -> f a -> Measure a
-fromMassFunction f support = cont $ \g -> weightedAverage (g /* f) support
+fromMassFunction
+  :: (Functor f, Foldable f)
+  => (a -> Double)
+  -> f a
+  -> Measure a
+fromMassFunction f support = cont $ \g ->
+  Foldable.sum $ (g /* f) <$> support
 
 fromMassFunctionT :: (Applicative m, Traversable t)
   => (a -> Double)
diff --git a/src/Measurable/Measures.hs b/src/Measurable/Measures.hs
@@ -2,6 +2,7 @@
 module Measurable.Measures where
 
 import Measurable.Core
+import Numeric.SpecFunctions (choose)
 import Statistics.Distribution
 import qualified Statistics.Distribution.Beta as Statistics
 import qualified Statistics.Distribution.Binomial as Statistics
@@ -42,8 +43,12 @@ beta a b = fromDensityFunction pdf where
 
 binomial :: Int -> Double -> Measure Int
 binomial n p = fromMassFunction pmf [0..n] where
-  pmf = probability $ Statistics.binomial n p
+  pmf = binomialMass n p
 
 bernoulli :: Double -> Measure Int
 bernoulli = binomial 1
 
+binomialMass :: Int -> Double -> Int -> Double
+binomialMass n p k = bc * p ^ k * (1 - p) ^ (n - k) where
+  bc = n `choose` k
+