commit35b056093e0b817dd0a7240416ce07b51287f5e1parent25747f9a09c03cfd4c3c6d53b4abaa11ce72b258Author:Jared Tobin <jared@jtobin.ca>Date:Sat, 19 Oct 2013 19:24:16 +1300 'push' -> 'fmap', Num operations in terms of liftA2.Diffstat:

M | src/Measurable.hs | | | 44 | ++++++++++++-------------------------------- |

M | tests/Test.hs | | | 6 | +++--- |

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)