commit 35b056093e0b817dd0a7240416ce07b51287f5e1
parent 25747f9a09c03cfd4c3c6d53b4abaa11ce72b258
Author: Jared Tobin <jared@jtobin.ca>
Date: Sat, 19 Oct 2013 19:24:16 +1300
'push' -> 'fmap', Num operations in terms of liftA2.
Diffstat:
2 files changed, 15 insertions(+), 35 deletions(-)
diff --git a/src/Measurable.hs b/src/Measurable.hs
@@ -49,19 +49,19 @@ import Numeric.Integration.TanhSinh
newtype Measure a = Measure { measure :: (a -> Double) -> Double }
instance Num a => Num (Measure a) where
- (+) = convolute
- (-) = msubtract
- (*) = mproduct
+ (+) = liftA2 (+)
+ (-) = liftA2 (-)
+ (*) = liftA2 (*)
abs = id
signum mu = error "fromInteger: not supported for Measures"
fromInteger = error "fromInteger: not supported for Measures"
instance Fractional a => Monoid (Measure a) where
mempty = identityMeasure
- mappend = convolute
+ mappend = (+)
instance Functor Measure where
- fmap = push
+ fmap f mu = Measure $ \g -> measure mu $ g . f -- pushforward/image measure
instance Applicative Measure where
pure = return
@@ -73,12 +73,6 @@ instance Monad Measure where
measure mu $ \g ->
measure (f g) d
--- | The pushforward measure is obtained by 'pushing' a function onto an
--- existing measure.
-push :: (a -> b) -> Measure a -> Measure b
-push f mu = Measure pushforward
- where pushforward g = measure mu $ g . f
-
-- | The volume is obtained by integrating against a constant. This is '1' for
-- any probability measure.
volume :: Measure a -> Double
@@ -94,32 +88,13 @@ variance mu = measure mu (^ 2) - mean mu ^ 2
-- | Create a measure from a collection of observations from some distribution.
fromObservations :: Fractional a => [a] -> Measure a
-fromObservations xs = Measure $ \f ->
- average . map f $ xs
+fromObservations xs = Measure (`weightedAverage` xs)
-- | Create a measure from a density function.
fromDensity :: (Double -> Double) -> Measure Double
-fromDensity d = Measure $ \f -> quadratureTanhSinh $ liftM2 (*) f d
+fromDensity d = Measure $ \f -> quadratureTanhSinh $ liftA2 (*) f d
where quadratureTanhSinh = result . last . everywhere trap
--- | Measure addition is convolution. Assumes independence.
-convolute :: Num a => Measure a -> Measure a -> Measure a
-convolute mu nu = Measure $ \f -> measure nu
- $ \y -> measure mu
- $ \x -> f (x + y)
-
--- | Measure subtraction. Assumes independence.
-msubtract :: Num a => Measure a -> Measure a -> Measure a
-msubtract mu nu = Measure $ \f -> measure nu
- $ \y -> measure mu
- $ \x -> f (x - y)
-
--- | Measure multiplication. Assumes independence.
-mproduct :: Num a => Measure a -> Measure a -> Measure a
-mproduct mu nu = Measure $ \f -> measure nu
- $ \y -> measure mu
- $ \x -> f (x * y)
-
-- | The (sum) identity measure.
identityMeasure :: Fractional a => Measure a
identityMeasure = fromObservations []
@@ -130,3 +105,8 @@ average xs = fst $ foldl'
(\(!m, !n) x -> (m + (x - m) / fromIntegral (n + 1), n + 1)) (0, 0) xs
{-# INLINE mean #-}
+-- | Weighted average.
+weightedAverage :: Fractional c => (a -> c) -> [a] -> c
+weightedAverage f = average . map f
+{-# INLINE weightedAverage #-}
+
diff --git a/tests/Test.hs b/tests/Test.hs
@@ -20,8 +20,8 @@ main = do
let mu = fromDensity standardNormal
nu = fromObservations expSamples
- rho = (push cos mu) + (push sin nu)
- eta = push exp rho
+ rho = (fmap cos mu) + (fmap sin nu)
+ eta = fmap exp rho
putStrLn $ "mean of normal samples (should be around 0): " ++
show (mean . fromObservations $ normSamples)
@@ -57,5 +57,5 @@ main = do
let alpha = fromDensity $ density $ chiSquared 5
putStrLn $ "let X ~ N(2, 1), Y ~ chisq(5). variance of exp (tanh XY) " ++
- show (variance . push (exp . tanh) $ phi * alpha)
+ show (variance . fmap (exp . tanh) $ phi * alpha)
