packages feed

statistics 0.4.1 → 0.16.5.0

raw patch · 88 files changed

Files

LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2009, Bryan O'Sullivan+Copyright (c) 2009, 2010 Bryan O'Sullivan All rights reserved.  Redistribution and use in source and binary forms, with or without
− README 
@@ -1,47 +0,0 @@-Statistics: efficient, general purpose statistics----------------------------------------------------This package provides the Statistics module, a Haskell library for-working with statistical data in a space- and time-efficient way.--Where possible, we give citations and computational complexity-estimates for the algorithms used.---Performance--------------This library has been carefully optimised for high performance.  To-obtain the best runtime efficiency, it is imperative to compile-libraries and applications that use this library using a high level of-optimisation.--Suggested GHC options:--  -O -fvia-C -funbox-strict-fields--To illustrate, here are the times (in seconds) to generate and sum 250-million random Word32 values, on a laptop with a 2.4GHz Core2 Duo-P8600 processor, running Fedora 11 and GHC 6.10.3:--  no flags   200+-  -O           1.249-  -O -fvia-C   0.991--As the numbers above suggest, compiling without optimisation will-yield unacceptable performance.---Get involved!----------------Please feel welcome to contribute new code or bug fixes.  You can-fetch the source repository from here:--darcs get http://darcs.serpentine.com/statistics---Authors----------Bryan O'Sullivan <bos@serpentine.com>
+ README.markdown view
@@ -0,0 +1,30 @@+# Statistics: efficient, general purpose statistics++This package provides the Statistics module, a Haskell library for+working with statistical data in a space- and time-efficient way.++Where possible, we give citations and computational complexity+estimates for the algorithms used.+++# Performance++This library has been carefully optimised for high performance.  To+obtain the best runtime efficiency, it is imperative to compile+libraries and applications that use this library using a high level of+optimisation.+++# Get involved!++Please report bugs via the+[github issue tracker](https://github.com/haskell/statistics/issues).++Master [git mirror](https://github.com/haskell/statistics):++* `git clone git://github.com/haskell/statistics.git`++# Authors++This library is written and maintained by Bryan O'Sullivan,+<bos@serpentine.com>.
− Setup.lhs 
@@ -1,3 +0,0 @@-#!/usr/bin/env runhaskell-> import Distribution.Simple-> main = defaultMain
Statistics/Autocorrelation.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleContexts #-} -- | -- Module    : Statistics.Autocorrelation -- Copyright : (c) 2009 Bryan O'Sullivan@@ -16,31 +17,33 @@     , autocorrelation     ) where -import Data.Array.Vector-import Statistics.Sample (Sample, mean)+import Prelude hiding (sum)+import Statistics.Function (square)+import Statistics.Sample (mean)+import Statistics.Sample.Internal (sum)+import qualified Data.Vector.Generic as G  -- | Compute the autocovariance of a sample, i.e. the covariance of -- the sample against a shifted version of itself.-autocovariance :: Sample -> UArr Double-autocovariance a = mapU f . enumFromToU 0 $ l-2+autocovariance :: (G.Vector v Double, G.Vector v Int) => v Double -> v Double+autocovariance a = G.map f . G.enumFromTo 0 $ l-2   where-    f k = sumU (zipWithU (*) (takeU (l-k) c) (sliceU c k (l-k)))+    f k = sum (G.zipWith (*) (G.take (l-k) c) (G.slice k (l-k) c))           / fromIntegral l-    c   = mapU (subtract (mean a)) a-    l   = lengthU a+    c   = G.map (subtract (mean a)) a+    l   = G.length a  -- | Compute the autocorrelation function of a sample, and the upper -- and lower bounds of confidence intervals for each element. -- -- /Note/: The calculation of the 95% confidence interval assumes a -- stationary Gaussian process.-autocorrelation :: Sample -> (UArr Double, UArr Double, UArr Double)+autocorrelation :: (G.Vector v Double, G.Vector v Int) => v Double -> (v Double, v Double, v Double) autocorrelation a = (r, ci (-), ci (+))   where-    r           = mapU (/ headU c) c+    r           = G.map (/ G.head c) c       where c   = autocovariance a-    dllse       = mapU f . scanl1U (+) . mapU square $ r+    dllse       = G.map f . G.scanl1 (+) . G.map square $ r       where f v = 1.96 * sqrt ((v * 2 + 1) / l)-    l           = fromIntegral (lengthU a)-    ci f        = consU 1 . tailU . mapU (f (-1/l)) $ dllse-    square x    = x * x+    l           = fromIntegral (G.length a)+    ci f        = G.cons 1 . G.tail . G.map (f (-1/l)) $ dllse
+ Statistics/ConfidenceInt.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE ViewPatterns #-}+-- | Calculation of confidence intervals+module Statistics.ConfidenceInt (+    poissonCI+  , poissonNormalCI+  , binomialCI+  , naiveBinomialCI+    -- * References+    -- $references+  ) where++import Statistics.Distribution+import Statistics.Distribution.ChiSquared+import Statistics.Distribution.Beta+import Statistics.Types++++-- | Calculate confidence intervals for Poisson-distributed value+-- using normal approximation+poissonNormalCI :: Int -> Estimate NormalErr Double+poissonNormalCI n+  | n < 0     = error "Statistics.ConfidenceInt.poissonNormalCI negative number of trials"+  | otherwise = estimateNormErr n' (sqrt n')+  where+    n' = fromIntegral n++-- | Calculate confidence intervals for Poisson-distributed value for+--   single measurement. These are exact confidence intervals+poissonCI :: CL Double -> Int -> Estimate ConfInt Double+poissonCI cl@(significanceLevel -> p) n+  | n <  0    = error "Statistics.ConfidenceInt.poissonCI: negative number of trials"+  | n == 0    = estimateFromInterval m (0 ,m2) cl+  | otherwise = estimateFromInterval m (m1,m2) cl+  where+    m  = fromIntegral n+    m1 = 0.5 * quantile      (chiSquared (2*n  )) (p/2)+    m2 = 0.5 * complQuantile (chiSquared (2*n+2)) (p/2)++-- | Calculate confidence interval using normal approximation. Note+--   that this approximation breaks down when /p/ is either close to 0+--   or to 1. In particular if @np < 5@ or @1 - np < 5@ this+--   approximation shouldn't be used.+naiveBinomialCI :: Int         -- ^ Number of trials+                -> Int         -- ^ Number of successes+                -> Estimate NormalErr Double+naiveBinomialCI n k+  | n <= 0 || k < 0 = error "Statistics.ConfidenceInt.naiveBinomialCI: negative number of events"+  | k > n           = error "Statistics.ConfidenceInt.naiveBinomialCI: more successes than trials"+  | otherwise       = estimateNormErr p σ+  where+    p = fromIntegral k / fromIntegral n+    σ = sqrt $ p * (1 - p) / fromIntegral n+++-- | Clopper-Pearson confidence interval also known as exact+--   confidence intervals.+binomialCI :: CL Double+           -> Int               -- ^ Number of trials+           -> Int               -- ^ Number of successes+           -> Estimate ConfInt Double+binomialCI cl@(significanceLevel -> p) ni ki+  | ni <= 0 || ki < 0 = error "Statistics.ConfidenceInt.binomialCI: negative number of events"+  | ki > ni           = error "Statistics.ConfidenceInt.binomialCI: more successes than trials"+  | ki == 0           = estimateFromInterval eff (0, ub) cl+  | ni == ki          = estimateFromInterval eff (lb,0 ) cl+  | otherwise         = estimateFromInterval eff (lb,ub) cl+  where+    k   = fromIntegral ki+    n   = fromIntegral ni+    eff = k / n+    lb  = quantile      (betaDistr  k      (n - k + 1)) (p/2)+    ub  = complQuantile (betaDistr (k + 1) (n - k)    ) (p/2)+++-- $references+--+--  * Clopper, C.; Pearson, E. S. (1934). "The use of confidence or+--    fiducial limits illustrated in the case of the+--    binomial". Biometrika 26: 404–413. doi:10.1093/biomet/26.4.404+--+--  * Brown, Lawrence D.; Cai, T. Tony; DasGupta, Anirban+--    (2001). "Interval Estimation for a Binomial Proportion". Statistical+--    Science 16 (2): 101–133. doi:10.1214/ss/1009213286. MR 1861069.+--    Zbl 02068924.
− Statistics/Constants.hs 
@@ -1,56 +0,0 @@--- |--- Module    : Statistics.Constants--- Copyright : (c) 2009 Bryan O'Sullivan--- License   : BSD3------ Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : portable------ Constant values common to much statistics code.--module Statistics.Constants-    (-      m_epsilon-    , m_huge-    , m_1_sqrt_2-    , m_2_sqrt_pi-    , m_max_exp-    , m_sqrt_2-    , m_sqrt_2_pi-    ) where---- | A very large number.-m_huge :: Double-m_huge = 1.7976931348623157e308-{-# INLINE m_huge #-}---- | The largest 'Int' /x/ such that 2**(/x/-1) is approximately--- representable as a 'Double'.-m_max_exp :: Int-m_max_exp = 1024---- | @sqrt 2@-m_sqrt_2 :: Double-m_sqrt_2 = 1.4142135623730950488016887242096980785696718753769480731766-{-# INLINE m_sqrt_2 #-}---- | @sqrt (2 * pi)@-m_sqrt_2_pi :: Double-m_sqrt_2_pi = 2.5066282746310005024157652848110452530069867406099383166299-{-# INLINE m_sqrt_2_pi #-}---- | @2 / sqrt pi@-m_2_sqrt_pi :: Double-m_2_sqrt_pi = 1.1283791670955125738961589031215451716881012586579977136881-{-# INLINE m_2_sqrt_pi #-}---- | @1 / sqrt 2@-m_1_sqrt_2 :: Double-m_1_sqrt_2 = 0.7071067811865475244008443621048490392848359376884740365883-{-# INLINE m_1_sqrt_2 #-}---- | The smallest 'Double' larger than 1.-m_epsilon :: Double-m_epsilon = encodeFloat (signif+1) expo - 1.0-    where (signif,expo) = decodeFloat (1.0::Double)
+ Statistics/Correlation.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE BangPatterns #-}+-- |+-- Module      : Statistics.Correlation.Pearson+--+module Statistics.Correlation+    ( -- * Pearson correlation+      pearson+    , pearson2+    , pearsonMatByRow+      -- * Spearman correlation+    , spearman+    , spearman2+    , spearmanMatByRow+    ) where++import qualified Data.Vector.Generic as G+import qualified Data.Vector.Unboxed as U+import Statistics.Matrix+import Statistics.Sample+import Statistics.Test.Internal (rankUnsorted)+++----------------------------------------------------------------+-- Pearson+----------------------------------------------------------------++-- | Pearson correlation for sample of pairs. Exactly same as+-- 'Statistics.Sample.correlation'+pearson :: (G.Vector v (Double, Double))+        => v (Double, Double) -> Double+pearson = correlation+{-# INLINE pearson #-}++-- | Pearson correlation for sample of pairs. Exactly same as+-- 'Statistics.Sample.correlation'+pearson2 :: (G.Vector v Double)+         => v Double -> v Double -> Double+pearson2 = correlation2+{-# INLINE pearson2 #-}++-- | Compute pairwise Pearson correlation between rows of a matrix+pearsonMatByRow :: Matrix -> Matrix+pearsonMatByRow m+  = generateSym (rows m)+      (\i j -> pearson $ row m i `U.zip` row m j)+{-# INLINE pearsonMatByRow #-}++++----------------------------------------------------------------+-- Spearman+----------------------------------------------------------------++-- | Compute Spearman correlation between two samples+spearman :: ( Ord a+            , Ord b+            , G.Vector v a+            , G.Vector v b+            , G.Vector v (a, b)+            , G.Vector v Int+            , G.Vector v (Int, a)+            , G.Vector v (Int, b)+            )+         => v (a, b)+         -> Double+spearman xy+  = pearson+  $ G.zip (rankUnsorted x) (rankUnsorted y)+  where+    (x, y) = G.unzip xy+{-# INLINE spearman #-}++-- | Compute Spearman correlation between two samples. Samples must+--   have same length.+spearman2 :: ( Ord a+            , Ord b+            , G.Vector v a+            , G.Vector v b+            , G.Vector v Int+            , G.Vector v (Int, a)+            , G.Vector v (Int, b)+            )+         => v a+         -> v b+         -> Double+spearman2 xs ys+  | nx /= ny  = error "Statistics.Correlation.spearman2: samples must have same length"+  | otherwise = pearson $ G.zip (rankUnsorted xs) (rankUnsorted ys)+  where+    nx = G.length xs+    ny = G.length ys+{-# INLINE spearman2 #-}++-- | compute pairwise Spearman correlation between rows of a matrix+spearmanMatByRow :: Matrix -> Matrix+spearmanMatByRow+  = pearsonMatByRow . fromRows . fmap rankUnsorted . toRows+{-# INLINE spearmanMatByRow #-}
+ Statistics/Correlation/Kendall.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE BangPatterns, FlexibleContexts #-}+-- |+-- Module      : Statistics.Correlation.Kendall+--+-- Fast O(NlogN) implementation of+-- <http://en.wikipedia.org/wiki/Kendall_tau_rank_correlation_coefficient Kendall's tau>.+--+-- This module implements Kendall's tau form b which allows ties in the data.+-- This is the same formula used by other statistical packages, e.g., R, matlab.+--+-- > \tau = \frac{n_c - n_d}{\sqrt{(n_0 - n_1)(n_0 - n_2)}}+--+-- where n_0 = n(n-1)\/2, n_1 = number of pairs tied for the first quantify,+-- n_2 = number of pairs tied for the second quantify,+-- n_c = number of concordant pairs$, n_d = number of discordant pairs.++module Statistics.Correlation.Kendall+    ( kendall++    -- * References+    -- $references+    ) where++import Control.Monad.ST (ST, runST)+import Data.Bits (shiftR)+import Data.Function (on)+import Data.STRef+import qualified Data.Vector.Algorithms.Intro as I+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Generic.Mutable as GM++-- | /O(nlogn)/ Compute the Kendall's tau from a vector of paired data.+-- Return NaN when number of pairs <= 1.+kendall :: (Ord a, Ord b, G.Vector v (a, b)) => v (a, b) -> Double+kendall xy'+  | G.length xy' <= 1 = 0/0+  | otherwise  = runST $ do+    xy <- G.thaw xy'+    let n = GM.length xy+    n_dRef <- newSTRef 0+    I.sort xy+    tieX <- numOfTiesBy ((==) `on` fst) xy+    tieXY <- numOfTiesBy (==) xy+    tmp <- GM.new n+    mergeSort (compare `on` snd) xy tmp n_dRef+    tieY <- numOfTiesBy ((==) `on` snd) xy+    n_d <- readSTRef n_dRef+    let n_0 = (fromIntegral n * (fromIntegral n-1)) `shiftR` 1 :: Integer+        n_c = n_0 - n_d - tieX - tieY + tieXY+    return $ fromIntegral (n_c - n_d) /+             (sqrt.fromIntegral) ((n_0 - tieX) * (n_0 - tieY))+{-# INLINE kendall #-}++-- calculate number of tied pairs in a sorted vector+numOfTiesBy :: GM.MVector v a+            => (a -> a -> Bool) -> v s a -> ST s Integer+numOfTiesBy f xs = do count <- newSTRef (0::Integer)+                      loop count (1::Int) (0::Int)+                      readSTRef count+  where+    n = GM.length xs+    loop c !acc !i | i >= n - 1 = modifySTRef' c (+ g acc)+                   | otherwise = do+                       x1 <- GM.unsafeRead xs i+                       x2 <- GM.unsafeRead xs (i+1)+                       if f x1 x2+                          then loop c (acc+1) (i+1)+                          else modifySTRef' c (+ g acc) >> loop c 1 (i+1)+    g x = fromIntegral ((x * (x - 1)) `shiftR` 1)+{-# INLINE numOfTiesBy #-}++-- Implementation of Knight's merge sort (adapted from vector-algorithm). This+-- function is used to count the number of discordant pairs.+mergeSort :: GM.MVector v e+          => (e -> e -> Ordering)+          -> v s e+          -> v s e+          -> STRef s Integer+          -> ST s ()+mergeSort cmp src buf count = loop 0 (GM.length src - 1)+  where+    loop l u+      | u == l = return ()+      | u - l == 1 = do+          eL <- GM.unsafeRead src l+          eU <- GM.unsafeRead src u+          case cmp eL eU of+              GT -> do GM.unsafeWrite src l eU+                       GM.unsafeWrite src u eL+                       modifySTRef' count (+1)+              _ -> return ()+      | otherwise  = do+          let mid = (u + l) `shiftR` 1+          loop l mid+          loop mid u+          merge cmp (GM.unsafeSlice l (u-l+1) src) buf (mid - l) count+{-# INLINE mergeSort #-}++merge :: GM.MVector v e+      => (e -> e -> Ordering)+      -> v s e+      -> v s e+      -> Int+      -> STRef s Integer+      -> ST s ()+merge cmp src buf mid count = do GM.unsafeCopy tmp lower+                                 eTmp <- GM.unsafeRead tmp 0+                                 eUpp <- GM.unsafeRead upper 0+                                 loop tmp 0 eTmp upper 0 eUpp 0+  where+    lower = GM.unsafeSlice 0 mid src+    upper = GM.unsafeSlice mid (GM.length src - mid) src+    tmp = GM.unsafeSlice 0 mid buf+    wroteHigh low iLow eLow high iHigh iIns+      | iHigh >= GM.length high =+          GM.unsafeCopy (GM.unsafeSlice iIns (GM.length low - iLow) src)+                        (GM.unsafeSlice iLow (GM.length low - iLow) low)+      | otherwise = do eHigh <- GM.unsafeRead high iHigh+                       loop low iLow eLow high iHigh eHigh iIns++    wroteLow low iLow high iHigh eHigh iIns+      | iLow  >= GM.length low  = return ()+      | otherwise = do eLow <- GM.unsafeRead low iLow+                       loop low iLow eLow high iHigh eHigh iIns++    loop !low !iLow !eLow !high !iHigh !eHigh !iIns = case cmp eHigh eLow of+        LT -> do GM.unsafeWrite src iIns eHigh+                 modifySTRef' count (+ fromIntegral (GM.length low - iLow))+                 wroteHigh low iLow eLow high (iHigh+1) (iIns+1)+        _  -> do GM.unsafeWrite src iIns eLow+                 wroteLow low (iLow+1) high iHigh eHigh (iIns+1)+{-# INLINE merge #-}++-- $references+--+-- * William R. Knight. (1966) A computer method for calculating Kendall's Tau+--   with ungrouped data. /Journal of the American Statistical Association/,+--   Vol. 61, No. 314, Part 1, pp. 436-439. <http://www.jstor.org/pss/2282833>+--
Statistics/Distribution.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE BangPatterns, ScopedTypeVariables #-} -- | -- Module    : Statistics.Distribution@@ -8,36 +9,182 @@ -- Stability   : experimental -- Portability : portable ----- Types and functions common to many probability distributions.+-- Type classes for probability distributions  module Statistics.Distribution     (+      -- * Type classes       Distribution(..)+    , DiscreteDistr(..)+    , ContDistr(..)+      -- ** Distribution statistics+    , MaybeMean(..)     , Mean(..)+    , MaybeVariance(..)     , Variance(..)+    , MaybeEntropy(..)+    , Entropy(..)+    , FromSample(..)+      -- ** Random number generation+    , ContGen(..)+    , DiscreteGen(..)+    , genContinuous+      -- * Helper functions     , findRoot+    , sumProbabilities     ) where --- | The interface shared by all probability distributions.-class Distribution d where-    -- | Probability density function. The probability that a-    -- the random variable /X/ has the value /x/, i.e. P(/X/=/x/).-    density :: d -> Double -> Double+import Prelude hiding (sum)+import Statistics.Function        (square)+import Statistics.Sample.Internal (sum)+import System.Random.Stateful     (StatefulGen, uniformDouble01M)+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Generic as G ++-- | Type class common to all distributions. Only c.d.f. could be+-- defined for both discrete and continuous distributions.+class Distribution d where     -- | Cumulative distribution function.  The probability that a-    -- random variable /X/ is less than /x/, i.e. P(/X/&#8804;/x/).+    -- random variable /X/ is less or equal than /x/,+    -- i.e. P(/X/≤/x/). Cumulative should be defined for+    -- infinities as well:+    --+    -- > cumulative d +∞ = 1+    -- > cumulative d -∞ = 0     cumulative :: d -> Double -> Double+    cumulative d x = 1 - complCumulative d x+    -- | One's complement of cumulative distribution:+    --+    -- > complCumulative d x = 1 - cumulative d x+    --+    -- It's useful when one is interested in P(/X/>/x/) and+    -- expression on the right side begin to lose precision. This+    -- function have default implementation but implementors are+    -- encouraged to provide more precise implementation.+    complCumulative :: d -> Double -> Double+    complCumulative d x = 1 - cumulative d x+    {-# MINIMAL (cumulative | complCumulative) #-} -    -- | Inverse of the cumulative distribution function.  The value-    -- /x/ for which P(/X/&#8804;/x/).++-- | Discrete probability distribution.+class Distribution  d => DiscreteDistr d where+    -- | Probability of n-th outcome.+    probability :: d -> Int -> Double+    probability d = exp . logProbability d+    -- | Logarithm of probability of n-th outcome+    logProbability :: d -> Int -> Double+    logProbability d = log . probability d+    {-# MINIMAL (probability | logProbability) #-}++-- | Continuous probability distribution.+--+--   Minimal complete definition is 'quantile' and either 'density' or+--   'logDensity'.+class Distribution d => ContDistr d where+    -- | Probability density function. Probability that random+    -- variable /X/ lies in the infinitesimal interval+    -- [/x/,/x+/δ/x/) equal to /density(x)/⋅δ/x/+    density :: d -> Double -> Double+    density d = exp . logDensity d+    -- | Natural logarithm of density.+    logDensity :: d -> Double -> Double+    logDensity d = log . density d+    -- | Inverse of the cumulative distribution function. The value+    -- /x/ for which P(/X/≤/x/) = /p/. If probability is outside+    -- of [0,1] range function should call 'error'     quantile :: d -> Double -> Double+    quantile d x = complQuantile d (1 - x)+    -- | 1-complement of @quantile@:+    --+    -- > complQuantile x ≡ quantile (1 - x)+    complQuantile :: d -> Double -> Double+    complQuantile d x = quantile d (1 - x)+    {-# MINIMAL (density | logDensity), (quantile | complQuantile) #-} -class Distribution d => Mean d where+-- | Type class for distributions with mean. 'maybeMean' should return+--   'Nothing' if it's undefined for current value of data+class Distribution d => MaybeMean d where+    maybeMean :: d -> Maybe Double++-- | Type class for distributions with mean. If a distribution has+--   finite mean for all valid values of parameters it should be+--   instance of this type class.+class MaybeMean d => Mean d where     mean :: d -> Double -class Mean d => Variance d where+++-- | Type class for distributions with variance. If variance is+--   undefined for some parameter values both 'maybeVariance' and+--   'maybeStdDev' should return Nothing.+--+--   Minimal complete definition is 'maybeVariance' or 'maybeStdDev'+class MaybeMean d => MaybeVariance d where+    maybeVariance :: d -> Maybe Double+    maybeVariance = fmap square . maybeStdDev+    maybeStdDev   :: d -> Maybe Double+    maybeStdDev   = fmap sqrt . maybeVariance+    {-# MINIMAL (maybeVariance | maybeStdDev) #-}++-- | Type class for distributions with variance. If distribution have+--   finite variance for all valid parameter values it should be+--   instance of this type class.+--+--   Minimal complete definition is 'variance' or 'stdDev'+class (Mean d, MaybeVariance d) => Variance d where     variance :: d -> Double+    variance d = square (stdDev d)+    stdDev   :: d -> Double+    stdDev = sqrt . variance+    {-# MINIMAL (variance | stdDev) #-} ++-- | Type class for distributions with entropy, meaning Shannon entropy+--   in the case of a discrete distribution, or differential entropy in the+--   case of a continuous one.  'maybeEntropy' should return 'Nothing' if+--   entropy is undefined for the chosen parameter values.+class (Distribution d) => MaybeEntropy d where+  -- | Returns the entropy of a distribution, in nats, if such is defined.+  maybeEntropy :: d -> Maybe Double++-- | Type class for distributions with entropy, meaning Shannon+--   entropy in the case of a discrete distribution, or differential+--   entropy in the case of a continuous one.  If the distribution has+--   well-defined entropy for all valid parameter values then it+--   should be an instance of this type class.+class (MaybeEntropy d) => Entropy d where+  -- | Returns the entropy of a distribution, in nats.+  entropy :: d -> Double++-- | Generate discrete random variates which have given+--   distribution.+class Distribution d => ContGen d where+  genContVar :: (StatefulGen g m) => d -> g -> m Double++-- | Generate discrete random variates which have given+--   distribution. 'ContGen' is superclass because it's always possible+--   to generate real-valued variates from integer values+class (DiscreteDistr d, ContGen d) => DiscreteGen d where+  genDiscreteVar :: (StatefulGen g m) => d -> g -> m Int++-- | Estimate distribution from sample. First parameter in sample is+--   distribution type and second is element type.+class FromSample d a where+  -- | Estimate distribution from sample. Returns 'Nothing' if there is+  --   not enough data, or if no usable fit results from the method+  --   used, e.g., the estimated distribution parameters would be+  --   invalid or inaccurate.+  fromSample :: G.Vector v a => v a -> Maybe d+++-- | Generate variates from continuous distribution using inverse+--   transform rule.+genContinuous :: (ContDistr d, StatefulGen g m) => d -> g -> m Double+genContinuous d gen = do+  x <- uniformDouble01M gen+  return $! quantile d x+ data P = P {-# UNPACK #-} !Double {-# UNPACK #-} !Double  -- | Approximate the value of /X/ for which P(/x/>/X/)=/p/.@@ -46,7 +193,8 @@ -- bisection with the given guess as a starting point.  The upper and -- lower bounds specify the interval in which the probability -- distribution reaches the value /p/.-findRoot :: Distribution d => d+findRoot :: ContDistr d =>+            d                   -- ^ Distribution          -> Double              -- ^ Probability /p/          -> Double              -- ^ Initial guess          -> Double              -- ^ Lower bound on interval@@ -70,3 +218,10 @@             | otherwise                        = P dx' x'     accuracy = 1e-15     maxIters = 150++-- | Sum probabilities in inclusive interval.+sumProbabilities :: DiscreteDistr d => d -> Int -> Int -> Double+sumProbabilities d low hi =+  -- Return value is forced to be less than 1 to guard against roundoff errors.+  -- ATTENTION! this check should be removed for testing or it could mask bugs.+  min 1 . sum . U.map (probability d) $ U.enumFromTo low hi
+ Statistics/Distribution/Beta.hs view
@@ -0,0 +1,174 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Statistics.Distribution.Beta+-- Copyright   :  (C) 2012 Edward Kmett,+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  DeriveDataTypeable+--+----------------------------------------------------------------------------+module Statistics.Distribution.Beta+  ( BetaDistribution+    -- * Constructor+  , betaDistr+  , betaDistrE+  , improperBetaDistr+  , improperBetaDistrE+    -- * Accessors+  , bdAlpha+  , bdBeta+  ) where++import Control.Applicative+import Data.Aeson            (FromJSON(..), ToJSON, Value(..), (.:))+import Data.Binary           (Binary(..))+import Data.Data             (Data, Typeable)+import GHC.Generics          (Generic)+import Numeric.SpecFunctions (+  incompleteBeta, invIncompleteBeta, logBeta, digamma, log1p)+import Numeric.MathFunctions.Constants (m_NaN,m_neg_inf)+import qualified Statistics.Distribution as D+import Statistics.Internal+++-- | The beta distribution+data BetaDistribution = BD+ { bdAlpha :: {-# UNPACK #-} !Double+   -- ^ Alpha shape parameter+ , bdBeta  :: {-# UNPACK #-} !Double+   -- ^ Beta shape parameter+ } deriving (Eq, Typeable, Data, Generic)++instance Show BetaDistribution where+  showsPrec n (BD a b) = defaultShow2 "improperBetaDistr" a b n+instance Read BetaDistribution where+  readPrec = defaultReadPrecM2 "improperBetaDistr" improperBetaDistrE++instance ToJSON BetaDistribution+instance FromJSON BetaDistribution where+  parseJSON (Object v) = do+    a <- v .: "bdAlpha"+    b <- v .: "bdBeta"+    maybe (fail $ errMsgI a b) return $ improperBetaDistrE a b+  parseJSON _ = empty++instance Binary BetaDistribution where+  put (BD a b) = put a >> put b+  get = do+    a <- get+    b <- get+    maybe (fail $ errMsgI a b) return $ improperBetaDistrE a b+++-- | Create beta distribution. Both shape parameters must be positive.+betaDistr :: Double             -- ^ Shape parameter alpha+          -> Double             -- ^ Shape parameter beta+          -> BetaDistribution+betaDistr a b = maybe (error $ errMsg a b) id $ betaDistrE a b++-- | Create beta distribution. Both shape parameters must be positive.+betaDistrE :: Double             -- ^ Shape parameter alpha+          -> Double             -- ^ Shape parameter beta+          -> Maybe BetaDistribution+betaDistrE a b+  | a > 0 && b > 0 = Just (BD a b)+  | otherwise      = Nothing++errMsg :: Double -> Double -> String+errMsg a b = "Statistics.Distribution.Beta.betaDistr: "+          ++ "shape parameters must be positive. Got a = "+          ++ show a+          ++ " b = "+          ++ show b+++-- | Create beta distribution. Both shape parameters must be+-- non-negative. So it allows to construct improper beta distribution+-- which could be used as improper prior.+improperBetaDistr :: Double             -- ^ Shape parameter alpha+                  -> Double             -- ^ Shape parameter beta+                  -> BetaDistribution+improperBetaDistr a b+  = maybe (error $ errMsgI a b) id $ improperBetaDistrE a b++-- | Create beta distribution. Both shape parameters must be+-- non-negative. So it allows to construct improper beta distribution+-- which could be used as improper prior.+improperBetaDistrE :: Double             -- ^ Shape parameter alpha+                   -> Double             -- ^ Shape parameter beta+                   -> Maybe BetaDistribution+improperBetaDistrE a b+  | a >= 0 && b >= 0 = Just (BD a b)+  | otherwise        = Nothing++errMsgI :: Double -> Double -> String+errMsgI a b+  =  "Statistics.Distribution.Beta.betaDistr: "+  ++ "shape parameters must be non-negative. Got a = " ++ show a+  ++ " b = " ++ show b++++instance D.Distribution BetaDistribution where+  cumulative (BD a b) x+    | x <= 0    = 0+    | x >= 1    = 1+    | otherwise = incompleteBeta a b x+  complCumulative (BD a b) x+    | x <= 0    = 1+    | x >= 1    = 0+    -- For small x we use direct computation to avoid precision loss+    -- when computing (1-x)+    | x <  0.5  = 1 - incompleteBeta a b x+    -- Otherwise we use property of incomplete beta:+    --  > I(x,a,b) = 1 - I(1-x,b,a)+    | otherwise = incompleteBeta b a (1-x)++instance D.Mean BetaDistribution where+  mean (BD a b) = a / (a + b)++instance D.MaybeMean BetaDistribution where+  maybeMean = Just . D.mean++instance D.Variance BetaDistribution where+  variance (BD a b) = a*b / (apb*apb*(apb+1))+    where apb = a + b++instance D.MaybeVariance BetaDistribution where+  maybeVariance = Just . D.variance++instance D.Entropy BetaDistribution where+  entropy (BD a b) =+    logBeta a b+    - (a-1) * digamma a+    - (b-1) * digamma b+    + (a+b-2) * digamma (a+b)++instance D.MaybeEntropy BetaDistribution where+  maybeEntropy = Just . D.entropy++instance D.ContDistr BetaDistribution where+  density (BD a b) x+    | a <= 0 || b <= 0 = m_NaN+    | x <= 0 = 0+    | x >= 1 = 0+    | otherwise = exp $ (a-1)*log x + (b-1) * log1p (-x) - logBeta a b+  logDensity (BD a b) x+    | a <= 0 || b <= 0 = m_NaN+    | x <= 0 = m_neg_inf+    | x >= 1 = m_neg_inf+    | otherwise = (a-1)*log x + (b-1)*log1p (-x) - logBeta a b++  quantile (BD a b) p+    | p == 0         = 0+    | p == 1         = 1+    | p > 0 && p < 1 = invIncompleteBeta a b p+    | otherwise      =+        error $ "Statistics.Distribution.Gamma.quantile: p must be in [0,1] range. Got: "++show p++instance D.ContGen BetaDistribution where+  genContVar = D.genContinuous
Statistics/Distribution/Binomial.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternGuards     #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} -- | -- Module    : Statistics.Distribution.Binomial -- Copyright : (c) 2009 Bryan O'Sullivan@@ -18,121 +20,165 @@       BinomialDistribution     -- * Constructors     , binomial+    , binomialE     -- * Accessors     , bdTrials     , bdProbability     ) where -import Control.Exception (assert)-import Data.Array.Vector-import Data.Int (Int64)-import Data.Typeable (Typeable)-import Statistics.Constants (m_epsilon)+import Control.Applicative+import Data.Aeson            (FromJSON(..), ToJSON, Value(..), (.:))+import Data.Binary           (Binary(..))+import Data.Data             (Data, Typeable)+import GHC.Generics          (Generic)+import Numeric.SpecFunctions           (choose,logChoose,incompleteBeta,log1p)+import Numeric.MathFunctions.Constants (m_epsilon,m_tiny)+ import qualified Statistics.Distribution as D-import Statistics.Distribution.Normal (standard)-import Statistics.Math (choose, logFactorial)+import qualified Statistics.Distribution.Poisson.Internal as I+import Statistics.Internal + -- | The binomial distribution. data BinomialDistribution = BD {       bdTrials      :: {-# UNPACK #-} !Int     -- ^ Number of trials.     , bdProbability :: {-# UNPACK #-} !Double     -- ^ Probability.-    } deriving (Eq, Read, Show, Typeable)+    } deriving (Eq, Typeable, Data, Generic) +instance Show BinomialDistribution where+  showsPrec i (BD n p) = defaultShow2 "binomial" n p i+instance Read BinomialDistribution where+  readPrec = defaultReadPrecM2 "binomial" binomialE++instance ToJSON BinomialDistribution+instance FromJSON BinomialDistribution where+  parseJSON (Object v) = do+    n <- v .: "bdTrials"+    p <- v .: "bdProbability"+    maybe (fail $ errMsg n p) return $ binomialE n p+  parseJSON _ = empty++instance Binary BinomialDistribution where+  put (BD x y) = put x >> put y+  get = do+    n <- get+    p <- get+    maybe (fail $ errMsg n p) return $ binomialE n p+++ instance D.Distribution BinomialDistribution where-    density    = density     cumulative = cumulative-    quantile   = quantile+    complCumulative = complCumulative -instance D.Variance BinomialDistribution where-    variance = variance+instance D.DiscreteDistr BinomialDistribution where+    probability    = probability+    logProbability = logProbability  instance D.Mean BinomialDistribution where     mean = mean -density :: BinomialDistribution -> Double -> Double-density (BD n p) x-    | not (isIntegral x) = integralError "density"-    | n == 0             = 1-    | x < 0 || x > n'    = 0-    | n <= 50 || x < 2   = sign * p'' ** x' * (n `choose` fx) * q'' ** nx'-    | otherwise          = sign * exp (x' * log p'' + nx' * log q'' + lf)-  where sign = oddX * oddNX-        (x',p',q') | x > n' / 2 = (n'-x, q, p)-                   | otherwise  = (x,    p, q)-        oddX | p' < 0 && odd fx     = -1-             | otherwise            = 1-        oddNX | q' < 0 && odd nx    = -1-              | otherwise           = 1-        p'' = abs p'-        q'' = abs q'-        q   = 1 - p-        nx  = n - fx-        nx' = fromIntegral nx-        fx  = floor x'-        n'  = fromIntegral n-        lf  = logFactorial n - logFactorial nx - logFactorial fx+instance D.Variance BinomialDistribution where+    variance = variance -cumulative :: BinomialDistribution -> Double -> Double-cumulative d x-  | isIntegral x = sumU . mapU (density d . fromIntegral) . enumFromToU (0::Int) . floor $ x-  | otherwise    = integralError "cumulative"+instance D.MaybeMean BinomialDistribution where+    maybeMean = Just . D.mean -isIntegral :: Double -> Bool-isIntegral x = x == floorf x+instance D.MaybeVariance BinomialDistribution where+    maybeStdDev   = Just . D.stdDev+    maybeVariance = Just . D.variance -floorf :: Double -> Double-floorf = fromIntegral . (floor :: Double -> Int64)+instance D.Entropy BinomialDistribution where+  entropy (BD n p)+    | n == 0 = 0+    | n <= 100 = directEntropy (BD n p)+    | otherwise = I.poissonEntropy (fromIntegral n * p) -quantile :: BinomialDistribution -> Double -> Double-quantile dist@(BD n p) prob-    | isNaN prob = prob-    | p == 1     = n'-    | n' < 1e5   = fst (search 1 y0 z0)-    | otherwise  = let dy = floorf (n' / 1000)-                   in  narrow dy (search dy y0 z0)-  where q  = 1 - p-        n' = fromIntegral n-        y0 = n' `min` floorf (µ + σ * (d + γ * (d * d - 1) / 6) + 0.5)-          where µ  = n' * p-                σ  = sqrt (n' * p * q)-                d = D.quantile standard prob-                γ  = (q - p) / σ-        z0 = cumulative dist y0-        search dy y1 z1 | z0 >= prob' = left y1 z1-                        | otherwise   = right y1-          where-            prob' = prob * (1 - 64 * m_epsilon)-            left y oldZ | y == 0 || z < prob' = (y, oldZ)-                        | otherwise           = left (max 0 y') z-                where z  = cumulative dist y'-                      y' = y - dy-            right y | y' >= n' || z >= prob' = (y', z)-                    | otherwise              = right y'-                where z  = cumulative dist y'-                      y' = y + dy-        narrow dy (y,z) | dy <= 1 || dy' <= n'/1e15 = y-                        | otherwise                 = narrow dy' (search dy y z)-            where dy' = floorf (dy / 100)+instance D.MaybeEntropy BinomialDistribution where+  maybeEntropy = Just . D.entropy +-- This could be slow for big n+probability :: BinomialDistribution -> Int -> Double+probability (BD n p) k+  | k < 0 || k > n = 0+  | n == 0         = 1+    -- choose could overflow Double for n >= 1030 so we switch to+    -- log-domain to calculate probability+    --+    -- We also want to avoid underflow when computing p^k &+    -- (1-p)^(n-k).+  | n < 1000+  , pK  >= m_tiny+  , pNK >= m_tiny = choose n k * pK * pNK+  | otherwise     = exp $ logChoose n k + log p * k' + log1p (-p) * nk'+  where+    pK  = p^k+    pNK = (1-p)^(n-k)+    k'  = fromIntegral k+    nk' = fromIntegral $ n - k++logProbability :: BinomialDistribution -> Int -> Double+logProbability (BD n p) k+  | k < 0 || k > n          = (-1)/0+  | n == 0                  = 0+  | otherwise               = logChoose n k + log p * k' + log1p (-p) * nk'+  where+    k'  = fromIntegral   k+    nk' = fromIntegral $ n - k++cumulative :: BinomialDistribution -> Double -> Double+cumulative (BD n p) x+  | isNaN x      = error "Statistics.Distribution.Binomial.cumulative: NaN input"+  | isInfinite x = if x > 0 then 1 else 0+  | k <  0       = 0+  | k >= n       = 1+  | otherwise    = incompleteBeta (fromIntegral (n-k)) (fromIntegral (k+1)) (1 - p)+  where+    k = floor x++complCumulative :: BinomialDistribution -> Double -> Double+complCumulative (BD n p) x+  | isNaN x      = error "Statistics.Distribution.Binomial.complCumulative: NaN input"+  | isInfinite x = if x > 0 then 0 else 1+  | k <  0       = 1+  | k >= n       = 0+  | otherwise    = incompleteBeta (fromIntegral (k+1)) (fromIntegral (n-k)) p+  where+    k = floor x+ mean :: BinomialDistribution -> Double mean (BD n p) = fromIntegral n * p-{-# INLINE mean #-}  variance :: BinomialDistribution -> Double variance (BD n p) = fromIntegral n * p * (1 - p)-{-# INLINE variance #-} +directEntropy :: BinomialDistribution -> Double+directEntropy d@(BD n _) =+  negate . sum $+  takeWhile (< negate m_epsilon) $+  dropWhile (not . (< negate m_epsilon)) $+  [ let x = probability d k in x * log x | k <- [0..n]]++-- | Construct binomial distribution. Number of trials must be+--   non-negative and probability must be in [0,1] range binomial :: Int                 -- ^ Number of trials.          -> Double              -- ^ Probability.          -> BinomialDistribution-binomial n p =-    assert (n > 0) .-    assert (p > 0 && p < 1) $-    BD n p-{-# INLINE binomial #-}+binomial n p = maybe (error $ errMsg n p) id $ binomialE n p -integralError :: String -> a-integralError f = error ("Statistics.Distribution.Binomial." ++ f ++-                         ": non-integer-valued input")+-- | Construct binomial distribution. Number of trials must be+--   non-negative and probability must be in [0,1] range+binomialE :: Int                 -- ^ Number of trials.+          -> Double              -- ^ Probability.+          -> Maybe BinomialDistribution+binomialE n p+  | n < 0            = Nothing+  | p >= 0 && p <= 1 = Just (BD n p)+  | otherwise        = Nothing++errMsg :: Int -> Double -> String+errMsg n p+  = "Statistics.Distribution.Binomial.binomial: n=" ++ show n+  ++ " p=" ++ show p ++ "but n>=0 and p in [0,1]"
+ Statistics/Distribution/CauchyLorentz.hs view
@@ -0,0 +1,142 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}+-- |+-- Module    : Statistics.Distribution.CauchyLorentz+-- Copyright : (c) 2011 Aleksey Khudyakov+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- The Cauchy-Lorentz distribution. It's also known as Lorentz+-- distribution or Breit–Wigner distribution.+--+-- It doesn't have mean and variance.+module Statistics.Distribution.CauchyLorentz (+    CauchyDistribution+  , cauchyDistribMedian+  , cauchyDistribScale+    -- * Constructors+  , cauchyDistribution+  , cauchyDistributionE+  , standardCauchy+  ) where++import Control.Applicative+import Data.Aeson             (FromJSON(..), ToJSON, Value(..), (.:))+import Data.Binary            (Binary(..))+import Data.Maybe             (fromMaybe)+import Data.Data              (Data, Typeable)+import GHC.Generics           (Generic)+import qualified Statistics.Distribution as D+import Statistics.Internal++-- | Cauchy-Lorentz distribution.+data CauchyDistribution = CD {+    -- | Central value of Cauchy-Lorentz distribution which is its+    --   mode and median. Distribution doesn't have mean so function+    --   is named after median.+    cauchyDistribMedian :: {-# UNPACK #-} !Double+    -- | Scale parameter of Cauchy-Lorentz distribution. It's+    --   different from variance and specify half width at half+    --   maximum (HWHM).+  , cauchyDistribScale  :: {-# UNPACK #-} !Double+  }+  deriving (Eq, Typeable, Data, Generic)++instance Show CauchyDistribution where+  showsPrec i (CD m s) = defaultShow2 "cauchyDistribution" m s i+instance Read CauchyDistribution where+  readPrec = defaultReadPrecM2 "cauchyDistribution" cauchyDistributionE++instance ToJSON   CauchyDistribution+instance FromJSON CauchyDistribution where+  parseJSON (Object v) = do+    m <- v .: "cauchyDistribMedian"+    s <- v .: "cauchyDistribScale"+    maybe (fail $ errMsg m s) return $ cauchyDistributionE m s+  parseJSON _ = empty++instance Binary CauchyDistribution where+    put (CD m s) = put m >> put s+    get = do+      m <- get+      s <- get+      maybe (error $ errMsg m s) return $ cauchyDistributionE m s+++-- | Cauchy distribution+cauchyDistribution :: Double    -- ^ Central point+                   -> Double    -- ^ Scale parameter (FWHM)+                   -> CauchyDistribution+cauchyDistribution m s+  = fromMaybe (error $ errMsg m s)+  $ cauchyDistributionE m s+++-- | Cauchy distribution+cauchyDistributionE :: Double    -- ^ Central point+                    -> Double    -- ^ Scale parameter (FWHM)+                    -> Maybe CauchyDistribution+cauchyDistributionE m s+  | s > 0     = Just (CD m s)+  | otherwise = Nothing++errMsg :: Double -> Double -> String+errMsg _ s+  = "Statistics.Distribution.CauchyLorentz.cauchyDistribution: FWHM must be positive. Got "+  ++ show s++-- | Standard Cauchy distribution. It's centered at 0 and have 1 FWHM+standardCauchy :: CauchyDistribution+standardCauchy = CD 0 1+++instance D.Distribution CauchyDistribution where+  cumulative (CD m s) x+    | y < -1    = atan (-1/y) / pi+    | otherwise = 0.5 + atan y / pi+    where+       y = (x - m) / s+  complCumulative (CD m s) x+    | y > 1     = atan (1/y) / pi+    | otherwise = 0.5 - atan y / pi+    where+       y = (x - m) / s++instance D.ContDistr CauchyDistribution where+  density (CD m s) x = (1 / pi) / (s * (1 + y*y))+    where y = (x - m) / s+  quantile (CD m s) p+    | p == 0    = -1 / 0+    | p == 1    =  1 / 0+    | p == 0.5  = m+    | p < 0     = err+    | p < 0.5   = m - s / tan( pi * p )+    | p < 1     = m + s / tan( pi * (1 - p) )+    | otherwise = err+    where+      err = error+          $ "Statistics.Distribution.CauchyLorentz.quantile: p must be in [0,1] range. Got: "++show p+  complQuantile (CD m s) p+    | p == 0    =  1 / 0+    | p == 1    = -1 / 0+    | p == 0.5  = m+    | p < 0     = err+    | p < 0.5   = m + s / tan( pi * p )+    | p < 1     = m - s / tan( pi * (1 - p) )+    | otherwise = err+    where+      err = error+          $ "Statistics.Distribution.CauchyLorentz.quantile: p must be in [0,1] range. Got: "++show p+++instance D.ContGen CauchyDistribution where+  genContVar = D.genContinuous++instance D.Entropy CauchyDistribution where+  entropy (CD _ s) = log s + log (4*pi)++instance D.MaybeEntropy CauchyDistribution where+  maybeEntropy = Just . D.entropy
+ Statistics/Distribution/ChiSquared.hs view
@@ -0,0 +1,140 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}+-- |+-- Module    : Statistics.Distribution.ChiSquared+-- Copyright : (c) 2010 Alexey Khudyakov+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- The chi-squared distribution. This is a continuous probability+-- distribution of sum of squares of k independent standard normal+-- distributions. It's commonly used in statistical tests+module Statistics.Distribution.ChiSquared (+          ChiSquared+        , chiSquaredNDF+        -- * Constructors+        , chiSquared+        , chiSquaredE+        ) where++import Control.Applicative+import Data.Aeson            (FromJSON(..), ToJSON, Value(..), (.:))+import Data.Binary           (Binary(..))+import Data.Data             (Data, Typeable)+import GHC.Generics          (Generic)+import Numeric.SpecFunctions ( incompleteGamma,invIncompleteGamma,logGamma,digamma)+import Numeric.MathFunctions.Constants (m_neg_inf)+import qualified System.Random.MWC.Distributions as MWC++import qualified Statistics.Distribution         as D+import Statistics.Internal++++-- | Chi-squared distribution+newtype ChiSquared = ChiSquared+  { chiSquaredNDF :: Int+    -- ^ Get number of degrees of freedom+  }+  deriving (Eq, Typeable, Data, Generic)++instance Show ChiSquared where+  showsPrec i (ChiSquared n) = defaultShow1 "chiSquared" n i+instance Read ChiSquared where+  readPrec = defaultReadPrecM1 "chiSquared" chiSquaredE++instance ToJSON ChiSquared+instance FromJSON ChiSquared where+  parseJSON (Object v) = do+    n <- v .: "chiSquaredNDF"+    maybe (fail $ errMsg n) return $ chiSquaredE n+  parseJSON _ = empty++instance Binary ChiSquared where+  put (ChiSquared x) = put x+  get = do n <- get+           maybe (fail $ errMsg n) return $ chiSquaredE n+++-- | Construct chi-squared distribution. Number of degrees of freedom+--   must be positive.+chiSquared :: Int -> ChiSquared+chiSquared n = maybe (error $ errMsg n) id $ chiSquaredE n++-- | Construct chi-squared distribution. Number of degrees of freedom+--   must be positive.+chiSquaredE :: Int -> Maybe ChiSquared+chiSquaredE n+  | n <= 0    = Nothing+  | otherwise = Just (ChiSquared n)++errMsg :: Int -> String+errMsg n = "Statistics.Distribution.ChiSquared.chiSquared: N.D.F. must be positive. Got " ++ show n++instance D.Distribution ChiSquared where+  cumulative = cumulative++instance D.ContDistr ChiSquared where+  density chi x+    | x <= 0    = 0+    | otherwise = exp $ log x * (ndf2 - 1) - x2 - logGamma ndf2 - log 2 * ndf2+    where+      ndf  = fromIntegral $ chiSquaredNDF chi+      ndf2 = ndf/2+      x2   = x/2++  logDensity chi x+    | x <= 0    = m_neg_inf+    | otherwise = log x * (ndf2 - 1) - x2 - logGamma ndf2 - log 2 * ndf2+    where+      ndf  = fromIntegral $ chiSquaredNDF chi+      ndf2 = ndf/2+      x2   = x/2++  quantile = quantile++instance D.Mean ChiSquared where+    mean (ChiSquared ndf) = fromIntegral ndf++instance D.Variance ChiSquared where+    variance (ChiSquared ndf) = fromIntegral (2*ndf)++instance D.MaybeMean ChiSquared where+    maybeMean = Just . D.mean++instance D.MaybeVariance ChiSquared where+    maybeStdDev   = Just . D.stdDev+    maybeVariance = Just . D.variance++instance D.Entropy ChiSquared where+  entropy (ChiSquared ndf) =+    let kHalf = 0.5 * fromIntegral ndf in+    kHalf+    + log 2+    + logGamma kHalf+    + (1-kHalf) * digamma kHalf++instance D.MaybeEntropy ChiSquared where+  maybeEntropy = Just . D.entropy++instance D.ContGen ChiSquared where+    genContVar (ChiSquared n) = MWC.chiSquare n+++cumulative :: ChiSquared -> Double -> Double+cumulative chi x+  | x <= 0    = 0+  | otherwise = incompleteGamma (ndf/2) (x/2)+  where+    ndf = fromIntegral $ chiSquaredNDF chi++quantile :: ChiSquared -> Double -> Double+quantile (ChiSquared ndf) p+  | p == 0         = 0+  | p == 1         = 1/0+  | p > 0 && p < 1 = 2 * invIncompleteGamma (fromIntegral ndf / 2) p+  | otherwise      =+    error $ "Statistics.Distribution.ChiSquared.quantile: p must be in [0,1] range. Got: "++show p
+ Statistics/Distribution/DiscreteUniform.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, OverloadedStrings #-}+-- |+-- Module    : Statistics.Distribution.DiscreteUniform+-- Copyright : (c) 2016 André Szabolcs Szelp+-- License   : BSD3+--+-- Maintainer  : a.sz.szelp@gmail.com+-- Stability   : experimental+-- Portability : portable+--+-- The discrete uniform distribution. There are two parametrizations of+-- this distribution. First is the probability distribution on an+-- inclusive interval {1, ..., n}. This is parametrized with n only,+-- where p_1, ..., p_n = 1/n. ('discreteUniform').+--+-- The second parametrization is the uniform distribution on {a, ..., b} with+-- probabilities p_a, ..., p_b = 1/(a-b+1). This is parametrized with+-- /a/ and /b/. ('discreteUniformAB')++module Statistics.Distribution.DiscreteUniform+    (+      DiscreteUniform+    -- * Constructors+    , discreteUniform+    , discreteUniformAB+    -- * Accessors+    , rangeFrom+    , rangeTo+    ) where++import Control.Applicative (empty)+import Data.Aeson   (FromJSON(..), ToJSON, Value(..), (.:))+import Data.Binary  (Binary(..))+import Data.Data    (Data, Typeable)+import System.Random.Stateful (uniformRM)+import GHC.Generics (Generic)++import qualified Statistics.Distribution as D+import Statistics.Internal++++-- | The discrete uniform distribution.+data DiscreteUniform = U {+      rangeFrom  :: {-# UNPACK #-} !Int+    -- ^ /a/, the lower bound of the support {a, ..., b}+    , rangeTo    :: {-# UNPACK #-} !Int+    -- ^ /b/, the upper bound of the support {a, ..., b}+    } deriving (Eq, Typeable, Data, Generic)++instance Show DiscreteUniform where+  showsPrec i (U a b) = defaultShow2 "discreteUniformAB" a b i+instance Read DiscreteUniform where+  readPrec = defaultReadPrecM2 "discreteUniformAB" (\a b -> Just (discreteUniformAB a b))++instance ToJSON   DiscreteUniform+instance FromJSON DiscreteUniform where+  parseJSON (Object v) = do+    a <- v .: "uniformA"+    b <- v .: "uniformB"+    return $ discreteUniformAB a b+  parseJSON _ = empty++instance Binary DiscreteUniform where+  put (U a b) = put a >> put b+  get         = discreteUniformAB <$> get <*> get++instance D.Distribution DiscreteUniform where+  cumulative (U a b) x+    | x < fromIntegral a = 0+    | x > fromIntegral b = 1+    | otherwise = fromIntegral (floor x - a + 1) / fromIntegral (b - a + 1)++instance D.DiscreteDistr DiscreteUniform where+  probability (U a b) k+    | k >= a && k <= b = 1 / fromIntegral (b - a + 1)+    | otherwise        = 0++instance D.Mean DiscreteUniform where+  mean (U a b) = fromIntegral (a+b)/2++instance D.Variance DiscreteUniform where+  variance (U a b) = (fromIntegral (b - a + 1)^(2::Int) - 1) / 12++instance D.MaybeMean DiscreteUniform where+  maybeMean = Just . D.mean++instance D.MaybeVariance DiscreteUniform where+  maybeStdDev   = Just . D.stdDev+  maybeVariance = Just . D.variance++instance D.Entropy DiscreteUniform where+  entropy (U a b) = log $ fromIntegral $ b - a + 1++instance D.MaybeEntropy DiscreteUniform where+  maybeEntropy = Just . D.entropy++instance D.ContGen DiscreteUniform where+  genContVar d = fmap fromIntegral . D.genDiscreteVar d++instance D.DiscreteGen DiscreteUniform where+  genDiscreteVar (U a b) = uniformRM (a,b)++-- | Construct discrete uniform distribution on support {1, ..., n}.+--   Range /n/ must be >0.+discreteUniform :: Int             -- ^ Range+                -> DiscreteUniform+discreteUniform n+  | n < 1     = error $ msg ++ "range must be > 0. Got " ++ show n+  | otherwise = U 1 n+  where msg = "Statistics.Distribution.DiscreteUniform.discreteUniform: "++-- | Construct discrete uniform distribution on support {a, ..., b}.+discreteUniformAB :: Int             -- ^ Lower boundary (inclusive)+                  -> Int             -- ^ Upper boundary (inclusive)+                  -> DiscreteUniform+discreteUniformAB a b+  | b < a     = U b a+  | otherwise = U a b
Statistics/Distribution/Exponential.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} -- | -- Module    : Statistics.Distribution.Exponential -- Copyright : (c) 2009 Bryan O'Sullivan@@ -8,8 +10,8 @@ -- Stability   : experimental -- Portability : portable ----- The exponential distribution.  This is the continunous probability--- distribution of the times between events in a poisson process, in+-- The exponential distribution.  This is the continuous probability+-- distribution of the times between events in a Poisson process, in -- which events occur continuously and independently at a constant -- average rate. @@ -17,42 +19,125 @@     (       ExponentialDistribution     -- * Constructors-    , fromLambda-    , fromSample+    , exponential+    , exponentialE     -- * Accessors     , edLambda     ) where -import Data.Typeable (Typeable)-import qualified Statistics.Distribution as D-import qualified Statistics.Sample as S-import Statistics.Types (Sample)+import Control.Applicative+import Data.Aeson                      (FromJSON(..),ToJSON,Value(..),(.:))+import Data.Binary                     (Binary, put, get)+import Data.Data                       (Data, Typeable)+import GHC.Generics                    (Generic)+import Numeric.SpecFunctions           (log1p,expm1)+import Numeric.MathFunctions.Constants (m_neg_inf)+import qualified System.Random.MWC.Distributions as MWC +import qualified Statistics.Distribution         as D+import qualified Statistics.Sample               as S+import Statistics.Internal+++ newtype ExponentialDistribution = ED {       edLambda :: Double-    } deriving (Eq, Read, Show, Typeable)+    } deriving (Eq, Typeable, Data, Generic) +instance Show ExponentialDistribution where+  showsPrec n (ED l) = defaultShow1 "exponential" l n+instance Read ExponentialDistribution where+  readPrec = defaultReadPrecM1 "exponential" exponentialE++instance ToJSON ExponentialDistribution+instance FromJSON ExponentialDistribution where+  parseJSON (Object v) = do+    l <- v .: "edLambda"+    maybe (fail $ errMsg l) return $ exponentialE l+  parseJSON _ = empty++instance Binary ExponentialDistribution where+  put = put . edLambda+  get = do+    l <- get+    maybe (fail $ errMsg l) return $ exponentialE l+ instance D.Distribution ExponentialDistribution where-    density (ED l) x    = l * exp (-l * x)-    {-# INLINE density #-}-    cumulative (ED l) x = 1 - exp (-l * x)-    {-# INLINE cumulative #-}-    quantile (ED l) p   = -log (1 - p) / l-    {-# INLINE quantile #-}+    cumulative      = cumulative+    complCumulative = complCumulative -instance D.Variance ExponentialDistribution where-    variance (ED l) = 1 / (l * l)-    {-# INLINE variance #-}+instance D.ContDistr ExponentialDistribution where+    density (ED l) x+      | x < 0     = 0+      | otherwise = l * exp (-l * x)+    logDensity (ED l) x+      | x < 0     = m_neg_inf+      | otherwise = log l + (-l * x)+    quantile      = quantile+    complQuantile = complQuantile  instance D.Mean ExponentialDistribution where     mean (ED l) = 1 / l-    {-# INLINE mean #-} -fromLambda :: Double            -- ^ &#955; (scale) parameter.-           -> ExponentialDistribution-fromLambda = ED-{-# INLINE fromLambda #-}+instance D.Variance ExponentialDistribution where+    variance (ED l) = 1 / (l * l) -fromSample :: Sample -> ExponentialDistribution-fromSample = ED . S.mean-{-# INLINE fromSample #-}+instance D.MaybeMean ExponentialDistribution where+    maybeMean = Just . D.mean++instance D.MaybeVariance ExponentialDistribution where+    maybeStdDev   = Just . D.stdDev+    maybeVariance = Just . D.variance++instance D.Entropy ExponentialDistribution where+  entropy (ED l) = 1 - log l++instance D.MaybeEntropy ExponentialDistribution where+  maybeEntropy = Just . D.entropy++instance D.ContGen ExponentialDistribution where+  genContVar = MWC.exponential . edLambda++cumulative :: ExponentialDistribution -> Double -> Double+cumulative (ED l) x | x <= 0    = 0+                    | otherwise = - expm1 (-l * x)++complCumulative :: ExponentialDistribution -> Double -> Double+complCumulative (ED l) x | x <= 0    = 1+                         | otherwise = exp (-l * x)+++quantile :: ExponentialDistribution -> Double -> Double+quantile (ED l) p+  | p >= 0 && p <= 1 = - log1p(-p) / l+  | otherwise        =+    error $ "Statistics.Distribution.Exponential.quantile: p must be in [0,1] range. Got: "++show p++complQuantile :: ExponentialDistribution -> Double -> Double+complQuantile (ED l) p+  | p == 0          = 0+  | p >= 0 && p < 1 = -log p / l+  | otherwise       =+    error $ "Statistics.Distribution.Exponential.quantile: p must be in [0,1] range. Got: "++show p++-- | Create an exponential distribution.+exponential :: Double            -- ^ Rate parameter.+            -> ExponentialDistribution+exponential l = maybe (error $ errMsg l) id $ exponentialE l++-- | Create an exponential distribution.+exponentialE :: Double            -- ^ Rate parameter.+             -> Maybe ExponentialDistribution+exponentialE l+  | l > 0     = Just (ED l)+  | otherwise = Nothing++errMsg :: Double -> String+errMsg l = "Statistics.Distribution.Exponential.exponential: scale parameter must be positive. Got " ++ show l++-- | Create exponential distribution from sample.  Estimates the rate+--   with the maximum likelihood estimator, which is biased. Returns+--   @Nothing@ if the sample mean does not exist or is not positive.+instance D.FromSample ExponentialDistribution Double where+  fromSample xs = let m = S.mean xs+                  in  if m > 0 then Just (ED (1/m)) else Nothing
+ Statistics/Distribution/FDistribution.hs view
@@ -0,0 +1,179 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}+-- |+-- Module    : Statistics.Distribution.FDistribution+-- Copyright : (c) 2011 Aleksey Khudyakov+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Fisher F distribution+module Statistics.Distribution.FDistribution (+    FDistribution+    -- * Constructors+  , fDistribution+  , fDistributionE+  , fDistributionReal+  , fDistributionRealE+    -- * Accessors+  , fDistributionNDF1+  , fDistributionNDF2+  ) where++import Control.Applicative+import Data.Aeson             (FromJSON(..), ToJSON, Value(..), (.:))+import Data.Binary            (Binary(..))+import Data.Data              (Data, Typeable)+import GHC.Generics           (Generic)+import Numeric.SpecFunctions (+  logBeta, incompleteBeta, invIncompleteBeta, digamma)+import Numeric.MathFunctions.Constants (m_neg_inf)++import qualified Statistics.Distribution as D+import Statistics.Function (square)+import Statistics.Internal+++-- | F distribution+data FDistribution = F { fDistributionNDF1 :: {-# UNPACK #-} !Double+                       , fDistributionNDF2 :: {-# UNPACK #-} !Double+                       , _pdfFactor        :: {-# UNPACK #-} !Double+                       }+                   deriving (Eq, Typeable, Data, Generic)++instance Show FDistribution where+  showsPrec i (F n m _) = defaultShow2 "fDistributionReal" n m i+instance Read FDistribution where+  readPrec = defaultReadPrecM2 "fDistributionReal" fDistributionRealE++instance ToJSON FDistribution+instance FromJSON FDistribution where+  parseJSON (Object v) = do+    n <- v .: "fDistributionNDF1"+    m <- v .: "fDistributionNDF2"+    maybe (fail $ errMsgR n m) return $ fDistributionRealE n m+  parseJSON _ = empty++instance Binary FDistribution where+  put (F n m _) = put n >> put m+  get = do+    n <- get+    m <- get+    maybe (fail $ errMsgR n m) return $ fDistributionRealE n m++fDistribution :: Int -> Int -> FDistribution+fDistribution n m = maybe (error $ errMsg n m) id $ fDistributionE n m++fDistributionReal :: Double -> Double -> FDistribution+fDistributionReal n m = maybe (error $ errMsgR n m) id $ fDistributionRealE n m++fDistributionE :: Int -> Int -> Maybe FDistribution+fDistributionE n m+  | n > 0 && m > 0 =+    let n' = fromIntegral n+        m' = fromIntegral m+        f' = 0.5 * (log m' * m' + log n' * n') - logBeta (0.5*n') (0.5*m')+    in Just $ F n' m' f'+  | otherwise = Nothing++fDistributionRealE :: Double -> Double -> Maybe FDistribution+fDistributionRealE n m+  | n > 0 && m > 0 =+    let f' = 0.5 * (log m * m + log n * n) - logBeta (0.5*n) (0.5*m)+    in Just $ F n m f'+  | otherwise = Nothing++errMsg :: Int -> Int -> String+errMsg _ _ = "Statistics.Distribution.FDistribution.fDistribution: non-positive number of degrees of freedom"++errMsgR :: Double -> Double -> String+errMsgR _ _ = "Statistics.Distribution.FDistribution.fDistribution: non-positive number of degrees of freedom"++++instance D.Distribution FDistribution where+  cumulative      = cumulative+  complCumulative = complCumulative++instance D.ContDistr FDistribution where+  density d x+    | x <= 0    = 0+    | otherwise = exp $ logDensity d x+  logDensity d x+    | x <= 0    = m_neg_inf+    | otherwise = logDensity d x+  quantile = quantile++cumulative :: FDistribution -> Double -> Double+cumulative (F n m _) x+  | x <= 0       = 0+  -- Only matches +∞+  | isInfinite x = 1+  -- NOTE: Here we rely on implementation detail of incompleteBeta. It+  --       computes using series expansion for sufficiently small x+  --       and uses following identity otherwise:+  --+  --           I(x; a, b) = 1 - I(1-x; b, a)+  --+  --       Point is we can compute 1-x as m/(m+y) without loss of+  --       precision for large x. Sadly this switchover point is+  --       implementation detail.+  | n >= (n+m)*bx = incompleteBeta (0.5 * n) (0.5 * m) bx+  | otherwise     = 1 - incompleteBeta (0.5 * m) (0.5 * n) bx1+  where+    y   = n * x+    bx  = y / (m + y)+    bx1 = m / (m + y)++complCumulative :: FDistribution -> Double -> Double+complCumulative (F n m _) x+  | x <= 0        = 1+  -- Only matches +∞+  | isInfinite x  = 0+  -- See NOTE at cumulative+  | m >= (n+m)*bx = incompleteBeta (0.5 * m) (0.5 * n) bx+  | otherwise     = 1 - incompleteBeta (0.5 * n) (0.5 * m) bx1+  where+    y   = n*x+    bx  = m / (m + y)+    bx1 = y / (m + y)++logDensity :: FDistribution -> Double -> Double+logDensity (F n m fac) x+  = fac + log x * (0.5 * n - 1) - log(m + n*x) * 0.5 * (n + m)++quantile :: FDistribution -> Double -> Double+quantile (F n m _) p+  | p >= 0 && p <= 1 =+    let x = invIncompleteBeta (0.5 * n) (0.5 * m) p+    in m * x / (n * (1 - x))+  | otherwise =+    error $ "Statistics.Distribution.Uniform.quantile: p must be in [0,1] range. Got: "++show p+++instance D.MaybeMean FDistribution where+  maybeMean (F _ m _) | m > 2     = Just $ m / (m - 2)+                      | otherwise = Nothing++instance D.MaybeVariance FDistribution where+  maybeStdDev (F n m _)+    | m > 4     = Just $ 2 * square m * (m + n - 2) / (n * square (m - 2) * (m - 4))+    | otherwise = Nothing++instance D.Entropy FDistribution where+  entropy (F n m _) =+    let nHalf = 0.5 * n+        mHalf = 0.5 * m in+    log (n/m)+    + logBeta nHalf mHalf+    + (1 - nHalf) * digamma nHalf+    - (1 + mHalf) * digamma mHalf+    + (nHalf + mHalf) * digamma (nHalf + mHalf)++instance D.MaybeEntropy FDistribution where+  maybeEntropy = Just . D.entropy++instance D.ContGen FDistribution where+  genContVar = D.genContinuous
Statistics/Distribution/Gamma.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} -- | -- Module    : Statistics.Distribution.Gamma--- Copyright : (c) 2009 Bryan O'Sullivan+-- Copyright : (c) 2009, 2011 Bryan O'Sullivan -- License   : BSD3 -- -- Maintainer  : bos@serpentine.com@@ -18,49 +19,166 @@     (       GammaDistribution     -- * Constructors-    --, fromParams-    --, fromSample-    --, standard+    , gammaDistr+    , gammaDistrE+    , improperGammaDistr+    , improperGammaDistrE     -- * Accessors     , gdShape     , gdScale     ) where -import Data.Typeable (Typeable)-import Statistics.Constants (m_huge)-import Statistics.Math (incompleteGamma, logGamma)+import Control.Applicative+import Data.Aeson           (FromJSON(..), ToJSON, Value(..), (.:))+import Data.Binary          (Binary(..))+import Data.Data            (Data, Typeable)+import GHC.Generics         (Generic)+import Numeric.MathFunctions.Constants (m_pos_inf, m_NaN, m_neg_inf)+import Numeric.SpecFunctions (incompleteGamma, invIncompleteGamma, logGamma, digamma)+import qualified System.Random.MWC.Distributions as MWC+import qualified Numeric.Sum as Sum++import Statistics.Distribution.Poisson.Internal as Poisson import qualified Statistics.Distribution as D+import Statistics.Internal + -- | The gamma distribution. data GammaDistribution = GD {       gdShape :: {-# UNPACK #-} !Double -- ^ Shape parameter, /k/.     , gdScale :: {-# UNPACK #-} !Double -- ^ Scale parameter, &#977;.-    } deriving (Eq, Read, Show, Typeable)+    } deriving (Eq, Typeable, Data, Generic) +instance Show GammaDistribution where+  showsPrec i (GD k theta) = defaultShow2 "improperGammaDistr" k theta i+instance Read GammaDistribution where+  readPrec = defaultReadPrecM2 "improperGammaDistr" improperGammaDistrE+++instance ToJSON GammaDistribution+instance FromJSON GammaDistribution where+  parseJSON (Object v) = do+    k     <- v .: "gdShape"+    theta <- v .: "gdScale"+    maybe (fail $ errMsgI k theta) return $ improperGammaDistrE k theta+  parseJSON _ = empty++instance Binary GammaDistribution where+  put (GD x y) = put x >> put y+  get = do+    k     <- get+    theta <- get+    maybe (fail $ errMsgI k theta) return $ improperGammaDistrE k theta+++-- | Create gamma distribution. Both shape and scale parameters must+-- be positive.+gammaDistr :: Double            -- ^ Shape parameter. /k/+           -> Double            -- ^ Scale parameter, &#977;.+           -> GammaDistribution+gammaDistr k theta+  = maybe (error $ errMsg k theta) id $ gammaDistrE k theta++errMsg :: Double -> Double -> String+errMsg k theta+  =  "Statistics.Distribution.Gamma.gammaDistr: "+  ++ "k=" ++ show k+  ++ "theta=" ++ show theta+  ++ " but must be positive"++-- | Create gamma distribution. Both shape and scale parameters must+-- be positive.+gammaDistrE :: Double            -- ^ Shape parameter. /k/+            -> Double            -- ^ Scale parameter, &#977;.+            -> Maybe GammaDistribution+gammaDistrE k theta+  | k > 0 && theta > 0 = Just (GD k theta)+  | otherwise          = Nothing+++-- | Create gamma distribution. Both shape and scale parameters must+-- be non-negative.+improperGammaDistr :: Double            -- ^ Shape parameter. /k/+                   -> Double            -- ^ Scale parameter, &#977;.+                   -> GammaDistribution+improperGammaDistr k theta+  = maybe (error $ errMsgI k theta) id $ improperGammaDistrE k theta++errMsgI :: Double -> Double -> String+errMsgI k theta+  =  "Statistics.Distribution.Gamma.gammaDistr: "+  ++ "k=" ++ show k+  ++ "theta=" ++ show theta+  ++ " but must be non-negative"++-- | Create gamma distribution. Both shape and scale parameters must+-- be non-negative.+improperGammaDistrE :: Double            -- ^ Shape parameter. /k/+                    -> Double            -- ^ Scale parameter, &#977;.+                    -> Maybe GammaDistribution+improperGammaDistrE k theta+  | k >= 0 && theta >= 0 = Just (GD k theta)+  | otherwise            = Nothing+ instance D.Distribution GammaDistribution where-    density    = density     cumulative = cumulative++instance D.ContDistr GammaDistribution where+    density    = density+    logDensity (GD k theta) x+      | x <= 0    = m_neg_inf+      | otherwise = Sum.sum Sum.kbn [ log x * (k - 1)+                                    , - (x / theta)+                                    , - logGamma k+                                    , - log theta * k+                                    ]     quantile   = quantile  instance D.Variance GammaDistribution where-    variance (GD a l) = a / (l * l)-    {-# INLINE variance #-}+    variance (GD a l) = a * l * l  instance D.Mean GammaDistribution where-    mean (GD a l) = a / l-    {-# INLINE mean #-}+    mean (GD a l) = a * l +instance D.MaybeMean GammaDistribution where+    maybeMean = Just . D.mean++instance D.MaybeVariance GammaDistribution where+    maybeStdDev   = Just . D.stdDev+    maybeVariance = Just . D.variance++instance D.MaybeEntropy GammaDistribution where+  maybeEntropy (GD a l)+    | a > 0 && l > 0 =+      Just $+      a+      + log l+      + logGamma a+      + (1-a) * digamma a+    | otherwise = Nothing++instance D.ContGen GammaDistribution where+    genContVar (GD a l) = MWC.gamma a l++ density :: GammaDistribution -> Double -> Double-density (GD a l) x = x ** (a-1) * exp (-x/l) / (exp (logGamma a) * l ** a)-{-# INLINE density #-}+density (GD a l) x+  | a < 0 || l <= 0   = m_NaN+  | x <= 0            = 0+  | a == 0            = if x == 0 then m_pos_inf else 0+  | x == 0            = if a < 1 then m_pos_inf else if a > 1 then 0 else 1/l+  | a < 1             = Poisson.probability (x/l) a * a / x+  | otherwise         = Poisson.probability (x/l) (a-1) / l  cumulative :: GammaDistribution -> Double -> Double-cumulative (GD a l) x = incompleteGamma a (x/l) / exp (logGamma a)-{-# INLINE cumulative #-}+cumulative (GD k l) x+  | x <= 0    = 0+  | otherwise = incompleteGamma k (x/l)  quantile :: GammaDistribution -> Double -> Double-quantile d p-  | p == 0    = -1/0-  | p == 1    = 1/0-  | otherwise = D.findRoot d p (gdShape d) 0 m_huge-{-# INLINE quantile #-}+quantile (GD k l) p+  | p == 0         = 0+  | p == 1         = 1/0+  | p > 0 && p < 1 = l * invIncompleteGamma k p+  | otherwise      =+    error $ "Statistics.Distribution.Gamma.quantile: p must be in [0,1] range. Got: "++show p
Statistics/Distribution/Geometric.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} -- | -- Module    : Statistics.Distribution.Geometric -- Copyright : (c) 2009 Bryan O'Sullivan@@ -8,58 +9,218 @@ -- Stability   : experimental -- Portability : portable ----- The Geometric distribution. This is the probability distribution of--- the number of Bernoulli trials needed to get one success, supported--- on the set [1,2..].+-- The Geometric distribution. There are two variants of+-- distribution. First is the probability distribution of the number+-- of Bernoulli trials needed to get one success, supported on the set+-- [1,2..] ('GeometricDistribution'). Sometimes it's referred to as+-- the /shifted/ geometric distribution to distinguish from another+-- one. ----- This distribution is sometimes referred to as the /shifted/--- geometric distribution, to distinguish it from a variant measuring--- the number of failures before the first success, defined over the--- set [0,1..].-+-- Second variant is probability distribution of the number of+-- failures before first success, defined over the set [0,1..]+-- ('GeometricDistribution0'). module Statistics.Distribution.Geometric     (       GeometricDistribution+    , GeometricDistribution0     -- * Constructors-    , fromSuccess+    , geometric+    , geometricE+    , geometric0+    , geometric0E     -- ** Accessors-    , pdSuccess+    , gdSuccess+    , gdSuccess0     ) where -import Control.Exception (assert)-import Data.Typeable (Typeable)+import Control.Applicative+import Control.Monad       (liftM)+import Data.Aeson          (FromJSON(..), ToJSON, Value(..), (.:))+import Data.Binary         (Binary(..))+import Data.Data           (Data, Typeable)+import GHC.Generics        (Generic)+import Numeric.MathFunctions.Constants (m_neg_inf)+import Numeric.SpecFunctions           (log1p,expm1)+import qualified System.Random.MWC.Distributions as MWC+ import qualified Statistics.Distribution as D+import Statistics.Internal +++----------------------------------------------------------------++-- | Distribution over [1..] newtype GeometricDistribution = GD {-      pdSuccess :: Double-    } deriving (Eq, Read, Show, Typeable)+      gdSuccess :: Double+    } deriving (Eq, Typeable, Data, Generic) +instance Show GeometricDistribution where+  showsPrec i (GD x) = defaultShow1 "geometric" x i+instance Read GeometricDistribution where+  readPrec = defaultReadPrecM1 "geometric" geometricE++instance ToJSON GeometricDistribution+instance FromJSON GeometricDistribution where+  parseJSON (Object v) = do+    x <- v .: "gdSuccess"+    maybe (fail $ errMsg x) return  $ geometricE x+  parseJSON _ = empty++instance Binary GeometricDistribution where+  put (GD x) = put x+  get = do+    x <- get+    maybe (fail $ errMsg x) return  $ geometricE x++ instance D.Distribution GeometricDistribution where-    density    = density-    cumulative = cumulative-    quantile   = quantile+    cumulative      = cumulative+    complCumulative = complCumulative -instance D.Variance GeometricDistribution where-    variance (GD s) = (1 - s) / (s * s)-    {-# INLINE variance #-}+instance D.DiscreteDistr GeometricDistribution where+    probability (GD s) n+      | n < 1     = 0+      | s >= 0.5  = s * (1 - s)^(n - 1)+      | otherwise = s * (exp $ log1p (-s) * (fromIntegral n - 1))+    logProbability (GD s) n+       | n < 1     = m_neg_inf+       | otherwise = log s + log1p (-s) * (fromIntegral n - 1) + instance D.Mean GeometricDistribution where     mean (GD s) = 1 / s-    {-# INLINE mean #-} -fromSuccess :: Double -> GeometricDistribution-fromSuccess x = assert (x >= 0 && x <= 1)-                GD x-{-# INLINE fromSuccess #-}+instance D.Variance GeometricDistribution where+    variance (GD s) = (1 - s) / (s * s) -density :: GeometricDistribution -> Double -> Double-density (GD s) x = s * (1-s) ** (x-1)-{-# INLINE density #-}+instance D.MaybeMean GeometricDistribution where+    maybeMean = Just . D.mean +instance D.MaybeVariance GeometricDistribution where+    maybeStdDev   = Just . D.stdDev+    maybeVariance = Just . D.variance++instance D.Entropy GeometricDistribution where+  entropy (GD s)+    | s == 1 = 0+    | otherwise = -(s * log s + (1-s) * log1p (-s)) / s++instance D.MaybeEntropy GeometricDistribution where+  maybeEntropy = Just . D.entropy++instance D.DiscreteGen GeometricDistribution where+  genDiscreteVar (GD s) g = MWC.geometric1 s g++instance D.ContGen GeometricDistribution where+  genContVar d g = fromIntegral `liftM` D.genDiscreteVar d g+ cumulative :: GeometricDistribution -> Double -> Double-cumulative (GD s) x = 1 - (1-s) ** x-{-# INLINE cumulative #-}+cumulative (GD s) x+  | x < 1        = 0+  | isInfinite x = 1+  | isNaN      x = error "Statistics.Distribution.Geometric.cumulative: NaN input"+  | s >= 0.5     = 1 - (1 - s)^k+  | otherwise    = negate $ expm1 $ fromIntegral k * log1p (-s)+    where k = floor x :: Int -quantile :: GeometricDistribution -> Double -> Double-quantile (GD s) p = log (1 - p) / log (1 - s)-{-# INLINE quantile #-}+complCumulative :: GeometricDistribution -> Double -> Double+complCumulative (GD s) x+  | x < 1        = 1+  | isInfinite x = 0+  | isNaN      x = error "Statistics.Distribution.Geometric.complCumulative: NaN input"+  | s >= 0.5     = (1 - s)^k+  | otherwise    = exp $ fromIntegral k * log1p (-s)+    where k = floor x :: Int+++-- | Create geometric distribution.+geometric :: Double                -- ^ Success rate+          -> GeometricDistribution+geometric x = maybe (error $ errMsg x) id $ geometricE x++-- | Create geometric distribution.+geometricE :: Double                -- ^ Success rate+           -> Maybe GeometricDistribution+geometricE x+  | x > 0 && x <= 1  = Just (GD x)+  | otherwise        = Nothing++errMsg :: Double -> String+errMsg x = "Statistics.Distribution.Geometric.geometric: probability must be in (0,1] range. Got " ++ show x+++----------------------------------------------------------------++-- | Distribution over [0..]+newtype GeometricDistribution0 = GD0 {+      gdSuccess0 :: Double+    } deriving (Eq, Typeable, Data, Generic)++instance Show GeometricDistribution0 where+  showsPrec i (GD0 x) = defaultShow1 "geometric0" x i+instance Read GeometricDistribution0 where+  readPrec = defaultReadPrecM1 "geometric0" geometric0E++instance ToJSON GeometricDistribution0+instance FromJSON GeometricDistribution0 where+  parseJSON (Object v) = do+    x <- v .: "gdSuccess0"+    maybe (fail $ errMsg x) return  $ geometric0E x+  parseJSON _ = empty++instance Binary GeometricDistribution0 where+  put (GD0 x) = put x+  get = do+    x <- get+    maybe (fail $ errMsg x) return  $ geometric0E x+++instance D.Distribution GeometricDistribution0 where+    cumulative      (GD0 s) x = cumulative      (GD s) (x + 1)+    complCumulative (GD0 s) x = complCumulative (GD s) (x + 1)++instance D.DiscreteDistr GeometricDistribution0 where+    probability    (GD0 s) n = D.probability    (GD s) (n + 1)+    logProbability (GD0 s) n = D.logProbability (GD s) (n + 1)++instance D.Mean GeometricDistribution0 where+    mean (GD0 s) = 1 / s - 1++instance D.Variance GeometricDistribution0 where+    variance (GD0 s) = D.variance (GD s)++instance D.MaybeMean GeometricDistribution0 where+    maybeMean = Just . D.mean++instance D.MaybeVariance GeometricDistribution0 where+    maybeStdDev   = Just . D.stdDev+    maybeVariance = Just . D.variance++instance D.Entropy GeometricDistribution0 where+  entropy (GD0 s) = D.entropy (GD s)++instance D.MaybeEntropy GeometricDistribution0 where+  maybeEntropy = Just . D.entropy++instance D.DiscreteGen GeometricDistribution0 where+  genDiscreteVar (GD0 s) g = MWC.geometric0 s g++instance D.ContGen GeometricDistribution0 where+  genContVar d g = fromIntegral `liftM` D.genDiscreteVar d g+++-- | Create geometric distribution.+geometric0 :: Double                -- ^ Success rate+           -> GeometricDistribution0+geometric0 x = maybe (error $ errMsg0 x) id $ geometric0E x++-- | Create geometric distribution.+geometric0E :: Double                -- ^ Success rate+            -> Maybe GeometricDistribution0+geometric0E x+  | x > 0 && x <= 1  = Just (GD0 x)+  | otherwise        = Nothing++errMsg0 :: Double -> String+errMsg0 x = "Statistics.Distribution.Geometric.geometric0: probability must be in (0,1] range. Got " ++ show x
Statistics/Distribution/Hypergeometric.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} -- | -- Module    : Statistics.Distribution.Hypergeometric -- Copyright : (c) 2009 Bryan O'Sullivan@@ -20,88 +21,163 @@     (       HypergeometricDistribution     -- * Constructors-    , fromParams+    , hypergeometric+    , hypergeometricE     -- ** Accessors     , hdM     , hdL     , hdK     ) where -import Control.Exception (assert)-import Data.Array.Vector-import Data.Typeable (Typeable)-import Statistics.Math (choose, logFactorial)-import Statistics.Constants (m_max_exp)+import Control.Applicative+import Data.Aeson           (FromJSON(..), ToJSON, Value(..), (.:))+import Data.Binary          (Binary(..))+import Data.Data            (Data, Typeable)+import GHC.Generics         (Generic)+import Numeric.MathFunctions.Constants (m_epsilon,m_neg_inf)+import Numeric.SpecFunctions (choose,logChoose)+ import qualified Statistics.Distribution as D+import Statistics.Internal + data HypergeometricDistribution = HD {       hdM :: {-# UNPACK #-} !Int     , hdL :: {-# UNPACK #-} !Int     , hdK :: {-# UNPACK #-} !Int-    } deriving (Eq, Read, Show, Typeable)+    } deriving (Eq, Typeable, Data, Generic) +instance Show HypergeometricDistribution where+  showsPrec i (HD m l k) = defaultShow3 "hypergeometric" m l k i+instance Read HypergeometricDistribution where+  readPrec = defaultReadPrecM3 "hypergeometric" hypergeometricE++instance ToJSON HypergeometricDistribution+instance FromJSON HypergeometricDistribution where+  parseJSON (Object v) = do+    m <- v .: "hdM"+    l <- v .: "hdL"+    k <- v .: "hdK"+    maybe (fail $ errMsg m l k) return $ hypergeometricE m l k+  parseJSON _ = empty++instance Binary HypergeometricDistribution where+  put (HD m l k) = put m >> put l >> put k+  get = do+    m <- get+    l <- get+    k <- get+    maybe (fail $ errMsg m l k) return $ hypergeometricE m l k+ instance D.Distribution HypergeometricDistribution where-    density    = density     cumulative = cumulative-    quantile   = quantile+    complCumulative = complCumulative -instance D.Variance HypergeometricDistribution where-    variance = variance+instance D.DiscreteDistr HypergeometricDistribution where+    probability    = probability+    logProbability = logProbability  instance D.Mean HypergeometricDistribution where     mean = mean +instance D.Variance HypergeometricDistribution where+    variance = variance++instance D.MaybeMean HypergeometricDistribution where+    maybeMean = Just . D.mean++instance D.MaybeVariance HypergeometricDistribution where+    maybeStdDev   = Just . D.stdDev+    maybeVariance = Just . D.variance++instance D.Entropy HypergeometricDistribution where+  entropy = directEntropy++instance D.MaybeEntropy HypergeometricDistribution where+  maybeEntropy = Just . D.entropy+ variance :: HypergeometricDistribution -> Double variance (HD m l k) = (k' * ml) * (1 - ml) * (l' - k') / (l' - 1)   where m' = fromIntegral m         l' = fromIntegral l         k' = fromIntegral k         ml = m' / l'-{-# INLINE variance #-}  mean :: HypergeometricDistribution -> Double mean (HD m l k) = fromIntegral k * fromIntegral m / fromIntegral l-{-# INLINE mean #-} -fromParams :: Int               -- ^ /m/-           -> Int               -- ^ /l/-           -> Int               -- ^ /k/-           -> HypergeometricDistribution-fromParams m l k =-    assert (m > 0 && m <= l) .-    assert (l > 0) .-    assert (k > 0 && k <= l) $-    HD m l k-{-# INLINE fromParams #-}+directEntropy :: HypergeometricDistribution -> Double+directEntropy d@(HD m _ _)+  = negate . sum+  $ takeWhile (< negate m_epsilon)+  $ dropWhile (not . (< negate m_epsilon))+    [ let x = probability d n in x * log x | n <- [0..m]] -density :: HypergeometricDistribution -> Double -> Double-density (HD mi li ki) x-    | l <= 70    = (mi <> xi) * ((li - mi) <> (ki - xi)) / (li <> ki)-    | r > maxVal = 1/0-    | otherwise  = exp r-  where-    a <> b = a `choose` b-    r = f m + f (l-m) - f l - f xi - f (k-xi) + f k --        f (m-xi) - f (l-m-k+xi) + f (l-k)-    f = logFactorial-    maxVal = fromIntegral (m_max_exp - 1) * log 2-    xi = floor x-    m = fromIntegral mi-    l = fromIntegral li-    k = fromIntegral ki-{-# INLINE density #-} +hypergeometric :: Int               -- ^ /m/+               -> Int               -- ^ /l/+               -> Int               -- ^ /k/+               -> HypergeometricDistribution+hypergeometric m l k+  = maybe (error $ errMsg m l k) id $ hypergeometricE m l k++hypergeometricE :: Int               -- ^ /m/+                -> Int               -- ^ /l/+                -> Int               -- ^ /k/+                -> Maybe HypergeometricDistribution+hypergeometricE m l k+  | not (l > 0)            = Nothing+  | not (m >= 0 && m <= l) = Nothing+  | not (k > 0  && k <= l) = Nothing+  | otherwise              = Just (HD m l k)+++errMsg :: Int -> Int -> Int -> String+errMsg m l k+  =  "Statistics.Distribution.Hypergeometric.hypergeometric:"+  ++ " m=" ++ show m+  ++ " l=" ++ show l+  ++ " k=" ++ show k+  ++ " should hold: l>0 & m in [0,l] & k in (0,l]"++-- Naive implementation+probability :: HypergeometricDistribution -> Int -> Double+probability (HD mi li ki) n+  | n < max 0 (mi+ki-li) || n > min mi ki = 0+    -- No overflow+  | li < 1000 = choose mi n * choose (li - mi) (ki - n)+              / choose li ki+  | otherwise = exp $ logChoose mi n+                    + logChoose (li - mi) (ki - n)+                    - logChoose li ki++logProbability :: HypergeometricDistribution -> Int -> Double+logProbability (HD mi li ki) n+  | n < max 0 (mi+ki-li) || n > min mi ki = m_neg_inf+  | otherwise = logChoose mi n+              + logChoose (li - mi) (ki - n)+              - logChoose li ki+ cumulative :: HypergeometricDistribution -> Double -> Double-cumulative d@(HD m l k) x-    | x < fromIntegral imin  = 0-    | x >= fromIntegral imax = 1-    | otherwise = min r 1+cumulative d@(HD mi li ki) x+  | isNaN x      = error "Statistics.Distribution.Hypergeometric.cumulative: NaN argument"+  | isInfinite x = if x > 0 then 1 else 0+  | n <  minN    = 0+  | n >= maxN    = 1+  | otherwise    = D.sumProbabilities d minN n   where-    imin = max 0 (k - l + m)-    imax = min k m-    r = sumU . mapU (density d . fromIntegral) . enumFromToU imin . floor $ x-{-# INLINE cumulative #-}+    n    = floor x+    minN = max 0 (mi+ki-li)+    maxN = min mi ki -quantile :: HypergeometricDistribution -> Double -> Double-quantile = error "Statistics.Distribution.Hypergeometric.quantile: not yet implemented"-{-# INLINE quantile #-}+complCumulative :: HypergeometricDistribution -> Double -> Double+complCumulative d@(HD mi li ki) x+  | isNaN x      = error "Statistics.Distribution.Hypergeometric.complCumulative: NaN argument"+  | isInfinite x = if x > 0 then 0 else 1+  | n <  minN    = 1+  | n >= maxN    = 0+  | otherwise    = D.sumProbabilities d (n + 1) maxN+  where+    n    = floor x+    minN = max 0 (mi+ki-li)+    maxN = min mi ki
+ Statistics/Distribution/Laplace.hs view
@@ -0,0 +1,163 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}+-- |+-- Module    : Statistics.Distribution.Laplace+-- Copyright : (c) 2015 Mihai Maruseac+-- License   : BSD3+--+-- Maintainer  : mihai.maruseac@maruseac.com+-- Stability   : experimental+-- Portability : portable+--+-- The Laplace distribution.  This is the continuous probability+-- defined as the difference of two iid exponential random variables+-- or a Brownian motion evaluated as exponentially distributed times.+-- It is used in differential privacy (Laplace Method), speech+-- recognition and least absolute deviations method (Laplace's first+-- law of errors, giving a robust regression method)+--+module Statistics.Distribution.Laplace+    (+      LaplaceDistribution+    -- * Constructors+    , laplace+    , laplaceE+    -- * Accessors+    , ldLocation+    , ldScale+    ) where++import Control.Applicative+import Data.Aeson           (FromJSON(..), ToJSON, Value(..), (.:))+import Data.Binary          (Binary(..))+import Data.Data            (Data, Typeable)+import GHC.Generics         (Generic)+import qualified Data.Vector.Generic             as G+import qualified Statistics.Distribution         as D+import qualified Statistics.Quantile             as Q+import qualified Statistics.Sample               as S+import Statistics.Internal+++data LaplaceDistribution = LD {+      ldLocation :: {-# UNPACK #-} !Double+    -- ^ Location.+    , ldScale    :: {-# UNPACK #-} !Double+    -- ^ Scale.+    } deriving (Eq, Typeable, Data, Generic)++instance Show LaplaceDistribution where+  showsPrec i (LD l s) = defaultShow2 "laplace" l s i+instance Read LaplaceDistribution where+  readPrec = defaultReadPrecM2 "laplace" laplaceE++instance ToJSON LaplaceDistribution+instance FromJSON LaplaceDistribution where+  parseJSON (Object v) = do+    l <- v .: "ldLocation"+    s <- v .: "ldScale"+    maybe (fail $ errMsg l s) return $ laplaceE l s+  parseJSON _ = empty++instance Binary LaplaceDistribution where+  put (LD l s) = put l >> put s+  get = do+    l <- get+    s <- get+    maybe (fail $ errMsg l s) return $ laplaceE l s++instance D.Distribution LaplaceDistribution where+    cumulative      = cumulative+    complCumulative = complCumulative++instance D.ContDistr LaplaceDistribution where+    density    (LD l s) x = exp (- abs (x - l) / s) / (2 * s)+    logDensity (LD l s) x = - abs (x - l) / s - log 2 - log s+    quantile      = quantile+    complQuantile = complQuantile++instance D.Mean LaplaceDistribution where+    mean (LD l _) = l++instance D.Variance LaplaceDistribution where+    variance (LD _ s) = 2 * s * s++instance D.MaybeMean LaplaceDistribution where+    maybeMean = Just . D.mean++instance D.MaybeVariance LaplaceDistribution where+    maybeStdDev   = Just . D.stdDev+    maybeVariance = Just . D.variance++instance D.Entropy LaplaceDistribution where+  entropy (LD _ s) = 1 + log (2 * s)++instance D.MaybeEntropy LaplaceDistribution where+  maybeEntropy = Just . D.entropy++instance D.ContGen LaplaceDistribution where+  genContVar = D.genContinuous++cumulative :: LaplaceDistribution -> Double -> Double+cumulative (LD l s) x+  | x <= l    = 0.5 * exp ( (x - l) / s)+  | otherwise = 1 - 0.5 * exp ( - (x - l) / s )++complCumulative :: LaplaceDistribution -> Double -> Double+complCumulative (LD l s) x+  | x <= l    = 1 - 0.5 * exp ( (x - l) / s)+  | otherwise = 0.5 * exp ( - (x - l) / s )++quantile :: LaplaceDistribution -> Double -> Double+quantile (LD l s) p+  | p == 0             = -inf+  | p == 1             = inf+  | p == 0.5           = l+  | p > 0   && p < 0.5 = l + s * log (2 * p)+  | p > 0.5 && p < 1   = l - s * log (2 - 2 * p)+  | otherwise          =+    error $ "Statistics.Distribution.Laplace.quantile: p must be in [0,1] range. Got: "++show p+  where+    inf = 1 / 0++complQuantile :: LaplaceDistribution -> Double -> Double+complQuantile (LD l s) p+  | p == 0             = inf+  | p == 1             = -inf+  | p == 0.5           = l+  | p > 0   && p < 0.5 = l - s * log (2 * p)+  | p > 0.5 && p < 1   = l + s * log (2 - 2 * p)+  | otherwise          =+    error $ "Statistics.Distribution.Laplace.quantile: p must be in [0,1] range. Got: "++show p+  where+    inf = 1 / 0++-- | Create an Laplace distribution.+laplace :: Double         -- ^ Location+        -> Double        -- ^ Scale+        -> LaplaceDistribution+laplace l s = maybe (error $ errMsg l s) id $ laplaceE l s++-- | Create an Laplace distribution.+laplaceE :: Double         -- ^ Location+         -> Double        -- ^ Scale+         -> Maybe LaplaceDistribution+laplaceE l s+  | s >= 0    = Just (LD l s)+  | otherwise = Nothing++errMsg :: Double -> Double -> String+errMsg _ s = "Statistics.Distribution.Laplace.laplace: scale parameter must be positive. Got " ++ show s+++-- | Create Laplace distribution from sample.  The location is estimated+--   as the median of the sample, and the scale as the mean absolute+--   deviation of the median.+instance D.FromSample LaplaceDistribution Double where+  fromSample xs+    | G.null xs = Nothing+    | otherwise = Just $! LD s l+    where+      s = Q.median Q.medianUnbiased xs+      l = S.mean $ G.map (\x -> abs $ x - s) xs
+ Statistics/Distribution/Lognormal.hs view
@@ -0,0 +1,172 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}+-- |+-- Module    : Statistics.Distribution.Lognormal+-- Copyright : (c) 2020 Ximin Luo+-- License   : BSD3+--+-- Maintainer  : infinity0@pwned.gg+-- Stability   : experimental+-- Portability : portable+--+-- The log normal distribution.  This is a continuous probability+-- distribution that describes data whose log is clustered around a+-- mean. For example, the multiplicative product of many independent+-- positive random variables.++module Statistics.Distribution.Lognormal+    (+      LognormalDistribution+      -- * Constructors+    , lognormalDistr+    , lognormalDistrErr+    , lognormalDistrMeanStddevErr+    , lognormalStandard+    ) where++import Data.Aeson            (FromJSON, ToJSON)+import Data.Binary           (Binary (..))+import Data.Data             (Data, Typeable)+import GHC.Generics          (Generic)+import Numeric.MathFunctions.Constants (m_huge, m_sqrt_2_pi)+import Numeric.SpecFunctions (expm1, log1p)+import qualified Data.Vector.Generic as G++import qualified Statistics.Distribution as D+import qualified Statistics.Distribution.Normal as N+import Statistics.Internal+++-- | The lognormal distribution.+newtype LognormalDistribution = LND N.NormalDistribution+    deriving (Eq, Typeable, Data, Generic)++instance Show LognormalDistribution where+  showsPrec i (LND d) = defaultShow2 "lognormalDistr" m s i+   where+    m = D.mean d+    s = D.stdDev d+instance Read LognormalDistribution where+  readPrec = defaultReadPrecM2 "lognormalDistr" $+    (either (const Nothing) Just .) . lognormalDistrErr++instance ToJSON LognormalDistribution+instance FromJSON LognormalDistribution++instance Binary LognormalDistribution where+  put (LND d) = put m >> put s+   where+    m = D.mean d+    s = D.stdDev d+  get = do+    m  <- get+    sd <- get+    either fail return $ lognormalDistrErr m sd++instance D.Distribution LognormalDistribution where+  cumulative      = cumulative+  complCumulative = complCumulative++instance D.ContDistr LognormalDistribution where+  logDensity    = logDensity+  quantile      = quantile+  complQuantile = complQuantile++instance D.MaybeMean LognormalDistribution where+  maybeMean = Just . D.mean++instance D.Mean LognormalDistribution where+  mean (LND d) = exp (m + v / 2)+   where+    m = D.mean d+    v = D.variance d++instance D.MaybeVariance LognormalDistribution where+  maybeStdDev   = Just . D.stdDev+  maybeVariance = Just . D.variance++instance D.Variance LognormalDistribution where+  variance (LND d) = expm1 v * exp (2 * m + v)+   where+    m = D.mean d+    v = D.variance d++instance D.Entropy LognormalDistribution where+  entropy (LND d) = logBase 2 (s * exp (m + 0.5) * m_sqrt_2_pi)+   where+    m = D.mean d+    s = D.stdDev d++instance D.MaybeEntropy LognormalDistribution where+  maybeEntropy = Just . D.entropy++instance D.ContGen LognormalDistribution where+  genContVar d = D.genContinuous d++-- | Standard log normal distribution with mu 0 and sigma 1.+--+-- Mean is @sqrt e@ and variance is @(e - 1) * e@.+lognormalStandard :: LognormalDistribution+lognormalStandard = LND N.standard++-- | Create log normal distribution from parameters.+lognormalDistr+  :: Double            -- ^ Mu+  -> Double            -- ^ Sigma+  -> LognormalDistribution+lognormalDistr mu sig = either error id $ lognormalDistrErr mu sig++-- | Create log normal distribution from parameters.+lognormalDistrErr+  :: Double            -- ^ Mu+  -> Double            -- ^ Sigma+  -> Either String LognormalDistribution+lognormalDistrErr mu sig+  | sig >= sqrt (log m_huge - 2 * mu) = Left $ errMsg mu sig+  | otherwise = LND <$> N.normalDistrErr mu sig++errMsg :: Double -> Double -> String+errMsg mu sig =+  "Statistics.Distribution.Lognormal.lognormalDistr: sigma must be > 0 && < "+    ++ show lim ++ ". Got " ++ show sig+  where lim = sqrt (log m_huge - 2 * mu)++-- | Create log normal distribution from mean and standard deviation.+lognormalDistrMeanStddevErr+  :: Double            -- ^ Mu+  -> Double            -- ^ Sigma+  -> Either String LognormalDistribution+lognormalDistrMeanStddevErr m sd = LND <$> N.normalDistrErr mu sig+  where r = sd / m+        sig2 = log1p (r * r)+        sig = sqrt sig2+        mu = log m - sig2 / 2++-- | Variance is estimated using maximum likelihood method+--   (biased estimation) over the log of the data.+--+--   Returns @Nothing@ if sample contains less than one element or+--   variance is zero (all elements are equal)+instance D.FromSample LognormalDistribution Double where+  fromSample = fmap LND . D.fromSample . G.map log++logDensity :: LognormalDistribution -> Double -> Double+logDensity (LND d) x+  | x > 0 = let lx = log x in D.logDensity d lx - lx+  | otherwise = 0++cumulative :: LognormalDistribution -> Double -> Double+cumulative (LND d) x+  | x > 0 = D.cumulative d $ log x+  | otherwise = 0++complCumulative :: LognormalDistribution -> Double -> Double+complCumulative (LND d) x+  | x > 0 = D.complCumulative d $ log x+  | otherwise = 1++quantile :: LognormalDistribution -> Double -> Double+quantile (LND d) = exp . D.quantile d++complQuantile :: LognormalDistribution -> Double -> Double+complQuantile (LND d) = exp . D.complQuantile d
+ Statistics/Distribution/NegativeBinomial.hs view
@@ -0,0 +1,188 @@+{-# LANGUAGE OverloadedStrings, PatternGuards,+             DeriveDataTypeable, DeriveGeneric #-}+-- |+-- Module    : Statistics.Distribution.NegativeBinomial+-- Copyright : (c) 2022 Lorenz Minder+-- License   : BSD3+--+-- Maintainer  : lminder@gmx.net+-- Stability   : experimental+-- Portability : portable+--+-- The negative binomial distribution.  This is the discrete probability+-- distribution of the number of failures in a sequence of independent+-- yes\/no experiments before a specified number of successes /r/.  Each+-- Bernoulli trial has success probability /p/ in the range (0, 1].  The+-- parameter /r/ must be positive, but does not have to be integer.++module Statistics.Distribution.NegativeBinomial (+      NegativeBinomialDistribution+    -- * Constructors+    , negativeBinomial+    , negativeBinomialE+    -- * Accessors+    , nbdSuccesses+    , nbdProbability+) where++import Control.Applicative+import Data.Aeson                       (FromJSON(..), ToJSON, Value(..), (.:))+import Data.Binary                      (Binary(..))+import Data.Data                        (Data, Typeable)+import Data.Foldable                    (foldl')+import GHC.Generics                     (Generic)+import Numeric.SpecFunctions            (incompleteBeta, log1p)+import Numeric.SpecFunctions.Extra      (logChooseFast)+import Numeric.MathFunctions.Constants  (m_epsilon, m_tiny)++import qualified Statistics.Distribution as D+import Statistics.Internal++-- Math helper functions++-- | Generalized binomial coefficients.+--+--   These computes binomial coefficients with the small generalization+--   that the /n/ need not be integer, but can be real.+gChoose :: Double -> Int -> Double+gChoose n k+    | k < 0             = 0+    | k' >= 50          = exp $ logChooseFast n k'+    | otherwise         = foldl' (*) 1 factors+    where   factors = [ (n - k' + j) / j | j <- [1..k'] ]+            k' = fromIntegral k+++-- Implementation of Negative Binomial++-- | The negative binomial distribution.+data NegativeBinomialDistribution = NBD {+      nbdSuccesses   :: {-# UNPACK #-} !Double+    -- ^ Number of successes until stop+    , nbdProbability :: {-# UNPACK #-} !Double+    -- ^ Success probability.+    } deriving (Eq, Typeable, Data, Generic)++instance Show NegativeBinomialDistribution where+  showsPrec i (NBD r p) = defaultShow2 "negativeBinomial" r p i+instance Read NegativeBinomialDistribution where+  readPrec = defaultReadPrecM2 "negativeBinomial" negativeBinomialE++instance ToJSON NegativeBinomialDistribution+instance FromJSON NegativeBinomialDistribution where+  parseJSON (Object v) = do+    r <- v .: "nbdSuccesses"+    p <- v .: "nbdProbability"+    maybe (fail $ errMsg r p) return $ negativeBinomialE r p+  parseJSON _ = empty++instance Binary NegativeBinomialDistribution where+  put (NBD r p) = put r >> put p+  get = do+    r <- get+    p <- get+    maybe (fail $ errMsg r p) return $ negativeBinomialE r p++instance D.Distribution NegativeBinomialDistribution where+    cumulative = cumulative+    complCumulative = complCumulative++instance D.DiscreteDistr NegativeBinomialDistribution where+    probability    = probability+    logProbability = logProbability++instance D.Mean NegativeBinomialDistribution where+    mean = mean++instance D.Variance NegativeBinomialDistribution where+    variance = variance++instance D.MaybeMean NegativeBinomialDistribution where+    maybeMean = Just . D.mean++instance D.MaybeVariance NegativeBinomialDistribution where+    maybeStdDev   = Just . D.stdDev+    maybeVariance = Just . D.variance++instance D.Entropy NegativeBinomialDistribution where+   entropy = directEntropy++instance D.MaybeEntropy NegativeBinomialDistribution where+   maybeEntropy = Just . D.entropy++-- This could be slow for big n+probability :: NegativeBinomialDistribution -> Int -> Double+probability d@(NBD r p) k+  | k < 0          = 0+    -- Switch to log domain for large k + r to avoid overflows.+    --+    -- We also want to avoid underflow when computing (1-p)^k &+    -- p^r.+  | k' + r < 1000+  , pK >= m_tiny+  , pR >= m_tiny  = gChoose (k' + r - 1) k * pK * pR+  | otherwise     = exp $ logProbability d k+  where+    pK  = exp $ log1p (-p) * k'+    pR  = p**r+    k'  = fromIntegral k++logProbability :: NegativeBinomialDistribution -> Int -> Double+logProbability (NBD r p) k+  | k < 0                   = (-1)/0+  | otherwise               = logChooseFast (k' + r - 1) k'+                              + log1p (-p) * k'+                              + log p * r+  where k' = fromIntegral k++cumulative :: NegativeBinomialDistribution -> Double -> Double+cumulative (NBD r p) x+  | isNaN x      = error "Statistics.Distribution.NegativeBinomial.cumulative: NaN input"+  | isInfinite x = if x > 0 then 1 else 0+  | k < 0        = 0+  | otherwise    = incompleteBeta r (fromIntegral (k+1)) p+  where+    k = floor x :: Integer++complCumulative :: NegativeBinomialDistribution -> Double -> Double+complCumulative (NBD r p) x+  | isNaN x      = error "Statistics.Distribution.NegativeBinomial.complCumulative: NaN input"+  | isInfinite x = if x > 0 then 0 else 1+  | k < 0        = 1+  | otherwise    = incompleteBeta (fromIntegral (k+1)) r (1 - p)+  where+    k = floor x :: Integer++mean :: NegativeBinomialDistribution -> Double+mean (NBD r p) = r * (1 - p)/p++variance :: NegativeBinomialDistribution -> Double+variance (NBD r p) = r * (1 - p)/(p * p)++directEntropy :: NegativeBinomialDistribution -> Double+directEntropy d =+  negate . sum $+  takeWhile (< -m_epsilon) $+  dropWhile (>= -m_epsilon) $+  [ let x = probability d k in x * log x | k <- [0..]]++-- | Construct negative binomial distribution. Number of successes /r/+--   must be positive and probability must be in (0,1] range+negativeBinomial :: Double              -- ^ Number of successes.+                 -> Double              -- ^ Success probability.+                 -> NegativeBinomialDistribution+negativeBinomial r p = maybe (error $ errMsg r p) id $ negativeBinomialE r p++-- | Construct negative binomial distribution. Number of successes /r/+--   must be positive and probability must be in (0,1] range+negativeBinomialE :: Double              -- ^ Number of successes.+                  -> Double              -- ^ Success probability.+                  -> Maybe NegativeBinomialDistribution+negativeBinomialE r p+  | r > 0 && 0 < p && p <= 1            = Just (NBD r p)+  | otherwise                           = Nothing++errMsg :: Double -> Double -> String+errMsg r p+  = "Statistics.Distribution.NegativeBinomial.negativeBinomial: r=" ++ show r+  ++ " p=" ++ show p ++ ", but need r>0 and p in (0,1]"
Statistics/Distribution/Normal.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} -- | -- Module    : Statistics.Distribution.Normal -- Copyright : (c) 2009 Bryan O'Sullivan@@ -15,71 +17,170 @@     (       NormalDistribution     -- * Constructors-    , fromParams-    , fromSample+    , normalDistr+    , normalDistrE+    , normalDistrErr     , standard     ) where -import Control.Exception (assert)-import Data.Number.Erf (erfc)-import Data.Typeable (Typeable)-import Statistics.Constants (m_sqrt_2, m_sqrt_2_pi)+import Control.Applicative+import Data.Aeson            (FromJSON(..), ToJSON, Value(..), (.:))+import Data.Binary           (Binary(..))+import Data.Data             (Data, Typeable)+import GHC.Generics          (Generic)+import Numeric.MathFunctions.Constants (m_sqrt_2, m_sqrt_2_pi)+import Numeric.SpecFunctions (erfc, invErfc)+import qualified System.Random.MWC.Distributions as MWC+import qualified Data.Vector.Generic as G+ import qualified Statistics.Distribution as D import qualified Statistics.Sample as S+import Statistics.Internal + -- | The normal distribution. data NormalDistribution = ND {-      mean     :: {-# UNPACK #-} !Double-    , variance :: {-# UNPACK #-} !Double+      mean       :: {-# UNPACK #-} !Double+    , stdDev     :: {-# UNPACK #-} !Double     , ndPdfDenom :: {-# UNPACK #-} !Double     , ndCdfDenom :: {-# UNPACK #-} !Double-    } deriving (Eq, Read, Show, Typeable)+    } deriving (Eq, Typeable, Data, Generic) +instance Show NormalDistribution where+  showsPrec i (ND m s _ _) = defaultShow2 "normalDistr" m s i+instance Read NormalDistribution where+  readPrec = defaultReadPrecM2 "normalDistr" normalDistrE++instance ToJSON NormalDistribution+instance FromJSON NormalDistribution where+  parseJSON (Object v) = do+    m  <- v .: "mean"+    sd <- v .: "stdDev"+    either fail return $ normalDistrErr m sd+  parseJSON _ = empty++instance Binary NormalDistribution where+    put (ND m sd _ _) = put m >> put sd+    get = do+      m  <- get+      sd <- get+      either fail return $ normalDistrErr m sd+ instance D.Distribution NormalDistribution where-    density    = density-    cumulative = cumulative-    quantile   = quantile+    cumulative      = cumulative+    complCumulative = complCumulative -instance D.Variance NormalDistribution where-    variance = variance+instance D.ContDistr NormalDistribution where+    logDensity    = logDensity+    quantile      = quantile+    complQuantile = complQuantile +instance D.MaybeMean NormalDistribution where+    maybeMean = Just . D.mean+ instance D.Mean NormalDistribution where     mean = mean +instance D.MaybeVariance NormalDistribution where+    maybeStdDev   = Just . D.stdDev+    maybeVariance = Just . D.variance++instance D.Variance NormalDistribution where+    stdDev = stdDev++instance D.Entropy NormalDistribution where+  entropy d = 0.5 * log (2 * pi * exp 1 * D.variance d)++instance D.MaybeEntropy NormalDistribution where+  maybeEntropy = Just . D.entropy++instance D.ContGen NormalDistribution where+    genContVar d = MWC.normal (mean d) (stdDev d)++-- | Standard normal distribution with mean equal to 0 and variance equal to 1 standard :: NormalDistribution-standard = ND {-             mean = 0.0-           , variance = 1.0-           , ndPdfDenom = m_sqrt_2_pi-           , ndCdfDenom = m_sqrt_2-           }+standard = ND { mean       = 0.0+              , stdDev     = 1.0+              , ndPdfDenom = log m_sqrt_2_pi+              , ndCdfDenom = m_sqrt_2+              } -fromParams :: Double -> Double -> NormalDistribution-fromParams m v = assert (v > 0)-                 ND {-                   mean = m-                 , variance = v-                 , ndPdfDenom = m_sqrt_2_pi * sv-                 , ndCdfDenom = m_sqrt_2 * sv-                 }-    where sv = sqrt v+-- | Create normal distribution from parameters.+--+-- IMPORTANT: prior to 0.10 release second parameter was variance not+-- standard deviation.+normalDistr :: Double            -- ^ Mean of distribution+            -> Double            -- ^ Standard deviation of distribution+            -> NormalDistribution+normalDistr m sd = either error id $ normalDistrErr m sd -fromSample :: S.Sample -> NormalDistribution-fromSample a = fromParams (S.mean a) (S.variance a)+-- | Create normal distribution from parameters.+--+-- IMPORTANT: prior to 0.10 release second parameter was variance not+-- standard deviation.+normalDistrE :: Double            -- ^ Mean of distribution+             -> Double            -- ^ Standard deviation of distribution+             -> Maybe NormalDistribution+normalDistrE m sd = either (const Nothing) Just $ normalDistrErr m sd -density :: NormalDistribution -> Double -> Double-density d x = exp (-xm * xm / (2 * variance d)) / ndPdfDenom d+-- | Create normal distribution from parameters.+--+normalDistrErr :: Double            -- ^ Mean of distribution+               -> Double            -- ^ Standard deviation of distribution+               -> Either String NormalDistribution+normalDistrErr m sd+  | sd > 0    = Right $ ND { mean       = m+                           , stdDev     = sd+                           , ndPdfDenom = log $ m_sqrt_2_pi * sd+                           , ndCdfDenom = m_sqrt_2 * sd+                           }+  | otherwise = Left $ errMsg m sd++errMsg :: Double -> Double -> String+errMsg _ sd = "Statistics.Distribution.Normal.normalDistr: standard deviation must be positive. Got " ++ show sd++-- | Variance is estimated using maximum likelihood method+--   (biased estimation).+--+--   Returns @Nothing@ if sample contains less than one element or+--   variance is zero (all elements are equal)+instance D.FromSample NormalDistribution Double where+  fromSample xs+    | G.length xs <= 1 = Nothing+    | v == 0           = Nothing+    | otherwise        = Just $! normalDistr m (sqrt v)+    where+      (m,v) = S.meanVariance xs++logDensity :: NormalDistribution -> Double -> Double+logDensity d x = (-xm * xm / (2 * sd * sd)) - ndPdfDenom d     where xm = x - mean d+          sd = stdDev d  cumulative :: NormalDistribution -> Double -> Double-cumulative d x = erfc (-(x-mean d) / ndCdfDenom d) / 2+cumulative d x = erfc ((mean d - x) / ndCdfDenom d) / 2 +complCumulative :: NormalDistribution -> Double -> Double+complCumulative d x = erfc ((x - mean d) / ndCdfDenom d) / 2+ quantile :: NormalDistribution -> Double -> Double quantile d p-  | p < 0 || p > 1 = inf/inf   | p == 0         = -inf   | p == 1         = inf   | p == 0.5       = mean d-  | otherwise      = x * sqrt (variance d) + mean d-  where x          = D.findRoot standard p 0 (-100) 100+  | p > 0 && p < 1 = x * ndCdfDenom d + mean d+  | otherwise      =+    error $ "Statistics.Distribution.Normal.quantile: p must be in [0,1] range. Got: "++show p+  where x          = - invErfc (2 * p)+        inf        = 1/0++complQuantile :: NormalDistribution -> Double -> Double+complQuantile d p+  | p == 0         = inf+  | p == 1         = -inf+  | p == 0.5       = mean d+  | p > 0 && p < 1 = x * ndCdfDenom d + mean d+  | otherwise      =+    error $ "Statistics.Distribution.Normal.complQuantile: p must be in [0,1] range. Got: "++show p+  where x          = invErfc (2 * p)         inf        = 1/0
Statistics/Distribution/Poisson.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} -- | -- Module    : Statistics.Distribution.Poisson--- Copyright : (c) 2009 Bryan O'Sullivan+-- Copyright : (c) 2009, 2011 Bryan O'Sullivan -- License   : BSD3 -- -- Maintainer  : bos@serpentine.com@@ -17,47 +18,111 @@     (       PoissonDistribution     -- * Constructors-    , fromLambda-    -- , fromSample+    , poisson+    , poissonE+    -- * Accessors+    , poissonLambda+    -- * References+    -- $references     ) where -import Data.Array.Vector-import Data.Typeable (Typeable)+import Control.Applicative+import Data.Aeson           (FromJSON(..), ToJSON, Value(..), (.:))+import Data.Binary          (Binary(..))+import Data.Data            (Data, Typeable)+import GHC.Generics         (Generic)++import qualified System.Random.MWC.Distributions as MWC++import Numeric.SpecFunctions (incompleteGamma,logFactorial)+import Numeric.MathFunctions.Constants (m_neg_inf)++ import qualified Statistics.Distribution as D-import Statistics.Constants (m_huge)-import Statistics.Math (logGamma)+import qualified Statistics.Distribution.Poisson.Internal as I+import Statistics.Internal + newtype PoissonDistribution = PD {-      pdLambda :: Double-    } deriving (Eq, Read, Show, Typeable)+      poissonLambda :: Double+    } deriving (Eq, Typeable, Data, Generic) +instance Show PoissonDistribution where+  showsPrec i (PD l) = defaultShow1 "poisson" l i+instance Read PoissonDistribution where+  readPrec = defaultReadPrecM1 "poisson" poissonE++instance ToJSON PoissonDistribution+instance FromJSON PoissonDistribution where+  parseJSON (Object v) = do+    l <- v .: "poissonLambda"+    maybe (fail $ errMsg l) return $ poissonE l+  parseJSON _ = empty++instance Binary PoissonDistribution where+  put = put . poissonLambda+  get = do+    l <- get+    maybe (fail $ errMsg l) return $ poissonE l+ instance D.Distribution PoissonDistribution where-    density    = density-    cumulative = cumulative-    quantile   = quantile+    cumulative (PD lambda) x+      | x < 0        = 0+      | isInfinite x = 1+      | isNaN      x = error "Statistics.Distribution.Poisson.cumulative: NaN input"+      | otherwise    = 1 - incompleteGamma (fromIntegral (floor x + 1 :: Int)) lambda +instance D.DiscreteDistr PoissonDistribution where+    probability (PD lambda) x = I.probability lambda (fromIntegral x)+    logProbability (PD lambda) i+      | i < 0     = m_neg_inf+      | otherwise = log lambda * fromIntegral i - logFactorial i - lambda+ instance D.Variance PoissonDistribution where-    variance = pdLambda-    {-# INLINE variance #-}+    variance = poissonLambda  instance D.Mean PoissonDistribution where-    mean = pdLambda-    {-# INLINE mean #-}+    mean = poissonLambda -fromLambda :: Double -> PoissonDistribution-fromLambda = PD-{-# INLINE fromLambda #-}+instance D.MaybeMean PoissonDistribution where+    maybeMean = Just . D.mean -density :: PoissonDistribution -> Double -> Double-density (PD l) x = exp (x * log l - l - logGamma x)-{-# INLINE density #-}+instance D.MaybeVariance PoissonDistribution where+    maybeStdDev   = Just . D.stdDev -cumulative :: PoissonDistribution -> Double -> Double-cumulative d = sumU . mapU (density d . fromIntegral) .-               enumFromToU (0::Int) . floor-{-# INLINE cumulative #-}+instance D.Entropy PoissonDistribution where+  entropy (PD lambda) = I.poissonEntropy lambda -quantile :: PoissonDistribution -> Double -> Double-quantile d p = fromIntegral . r $ D.findRoot d p (pdLambda d) 0 m_huge-    where r = round :: Double -> Int-{-# INLINE quantile #-}+instance D.MaybeEntropy PoissonDistribution where+  maybeEntropy = Just . D.entropy++-- | @since 0.16.5.0+instance D.DiscreteGen PoissonDistribution where+  genDiscreteVar (PD lambda) = MWC.poisson lambda++-- | @since 0.16.5.0+instance D.ContGen PoissonDistribution where+  genContVar (PD lambda) gen = fromIntegral <$> MWC.poisson lambda gen++-- | Create Poisson distribution.+poisson :: Double -> PoissonDistribution+poisson l = maybe (error $ errMsg l) id $ poissonE l++-- | Create Poisson distribution.+poissonE :: Double -> Maybe PoissonDistribution+poissonE l+  | l >=  0   = Just (PD l)+  | otherwise = Nothing++errMsg :: Double -> String+errMsg l = "Statistics.Distribution.Poisson.poisson: lambda must be non-negative. Got "+        ++ show l+++-- $references+--+-- * Loader, C. (2000) Fast and Accurate Computation of Binomial+--   Probabilities. <http://projects.scipy.org/scipy/raw-attachment/ticket/620/loader2000Fast.pdf>+-- * Adell, J., Lekuona, A., and Yu, Y. (2010) Sharp Bounds on the+--   Entropy of the Poisson Law and Related Quantities+--   <http://arxiv.org/pdf/1001.2897.pdf>
+ Statistics/Distribution/Poisson/Internal.hs view
@@ -0,0 +1,177 @@+-- |+-- Module    : Statistics.Distribution.Poisson.Internal+-- Copyright : (c) 2011 Bryan O'Sullivan+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Internal code for the Poisson distribution.++module Statistics.Distribution.Poisson.Internal+    (+      probability, poissonEntropy+    ) where++import Data.List (unfoldr)+import Numeric.MathFunctions.Constants (m_sqrt_2_pi, m_tiny, m_epsilon)+import Numeric.SpecFunctions (logGamma, stirlingError {-, choose, logFactorial -})+import Numeric.SpecFunctions.Extra (bd0)++-- | An unchecked, non-integer-valued version of Loader's saddle point+-- algorithm.+probability :: Double -> Double -> Double+probability 0      0     = 1+probability 0      1     = 0+probability lambda x+  | isInfinite lambda    = 0+  | x < 0                = 0+  | x <= lambda * m_tiny = exp (-lambda)+  | lambda < x * m_tiny  = exp (-lambda + x * log lambda - logGamma (x+1))+  | otherwise            = exp (-(stirlingError x) - bd0 x lambda) /+                           (m_sqrt_2_pi * sqrt x)++-- -- | Compute entropy using Theorem 1 from "Sharp Bounds on the Entropy+-- -- of the Poisson Law".  This function is unused because 'directEntropy'+-- -- is just as accurate and is faster by about a factor of 4.+-- alyThm1 :: Double -> Double+-- alyThm1 lambda =+--   sum (takeWhile (\x -> abs x >= m_epsilon * lll) alySeries) + lll+--   where lll = lambda * (1 - log lambda)+--         alySeries =+--           [ alyc k * exp (fromIntegral k * log lambda - logFactorial k)+--           | k <- [2..] ]++-- alyc :: Int -> Double+-- alyc k =+--   sum [ parity j * choose (k-1) j * log (fromIntegral j+1) | j <- [0..k-1] ]+--   where parity j+--           | even (k-j) = -1+--           | otherwise  = 1++-- | Returns [x, x^2, x^3, x^4, ...]+powers :: Double -> [Double]+powers x = unfoldr (\y -> Just (y*x,y*x)) 1++-- | Returns an upper bound according to theorem 2 of "Sharp Bounds on+-- the Entropy of the Poisson Law"+alyThm2Upper :: Double -> [Double] -> Double+alyThm2Upper lambda coefficients =+  1.4189385332046727 + 0.5 * log lambda ++  zipCoefficients lambda coefficients++-- | Returns the average of the upper and lower bounds according to+-- theorem 2.+alyThm2 :: Double -> [Double] -> [Double] -> Double+alyThm2 lambda upper lower =+  alyThm2Upper lambda upper + 0.5 * (zipCoefficients lambda lower)++zipCoefficients :: Double -> [Double] -> Double+zipCoefficients lambda coefficients =+  (sum $ map (uncurry (*)) (zip (powers $ recip lambda) coefficients))++-- Mathematica code deriving the coefficients below:+--+-- poissonMoment[0, s_] := 1+-- poissonMoment[1, s_] := 0+-- poissonMoment[k_, s_] :=+--   Sum[s * Binomial[k - 1, j] * poissonMoment[j, s], {j, 0, k - 2}]+--+-- upperSeries[m_]  :=+--  Distribute[Integrate[+--    Sum[(-1)^(j - 1) *+--      poissonMoment[j, \[Lambda]] / (j * (j - 1)* \[Lambda]^j),+--     {j, 3, 2 m - 1}],+--    \[Lambda]]]+--+-- lowerSeries[m_] :=+--  Distribute[Integrate[+--    poissonMoment[+--      2 m + 2, \[Lambda]] / ((2 m ++--         1)*\[Lambda]^(2 m + 2)), \[Lambda]]]+--+-- upperBound[m_] := upperSeries[m] + (Log[2*Pi*\[Lambda]] + 1)/2+--+-- lowerBound[m_] := upperBound[m] + lowerSeries[m]++upperCoefficients4 :: [Double]+upperCoefficients4 = [1/12, 1/24, -103/180, -13/40, -1/210]++lowerCoefficients4 :: [Double]+lowerCoefficients4 = [0,0,0, -105/4, -210, -2275/18, -167/21, -1/72]++upperCoefficients6 :: [Double]+upperCoefficients6 = [1/12, 1/24, 19/360, 9/80, -38827/2520,+                      -74855/1008, -73061/2520, -827/720, -1/990]++lowerCoefficients6 :: [Double]+lowerCoefficients6 = [0,0,0,0,0, -3465/2, -45045, -466235/4, -531916/9,+                      -56287/10, -629/11, -1/156]++upperCoefficients8 :: [Double]+upperCoefficients8 = [1/12, 1/24, 19/360, 9/80, 863/2520, 1375/1008,+                      -3023561/2520, -15174047/720, -231835511/5940,+                      -18927611/1320, -58315591/60060, -23641/3640,+                      -1/2730]++lowerCoefficients8 :: [Double]+lowerCoefficients8 = [0,0,0,0,0,0,0, -2027025/8, -15315300, -105252147,+                      -178127950, -343908565/4, -10929270, -3721149/14,+                      -7709/15, -1/272]++upperCoefficients10 :: [Double]+upperCoefficients10 = [1/12, 1/24, 19/360, 9,80, 863/2520, 1375/1008,+                       33953/5040, 57281/1440, -2271071617/11880,+                       -1483674219/176, -31714406276557/720720,+                       -7531072742237/131040, -1405507544003/65520,+                       -21001919627/10080, -1365808297/36720,+                       -26059/544, -1/5814]++lowerCoefficients10 :: [Double]+lowerCoefficients10 = [0,0,0,0,0,0,0,0,0,-130945815/2, -7638505875,+                       -438256243425/4, -435477637540, -3552526473925/6,+                       -857611717105/3, -545654955967/12, -5794690528/3,+                       -578334559/42, -699043/133, -1/420]++upperCoefficients12 :: [Double]+upperCoefficients12 = [1/12, 1/24, 19/360, 863/2520, 1375/1008,+                       33953/5040, 57281/1440, 3250433/11880,+                       378351/176, -37521922090657/720720,+                       -612415657466657/131040, -3476857538815223/65520,+                       -243882174660761/1440, -34160796727900637/183600,+                       -39453820646687/544, -750984629069237/81396,+                       -2934056300989/9576, -20394527513/12540,+                       -3829559/9240, -1/10626]++lowerCoefficients12 :: [Double]+lowerCoefficients12 = [0,0,0,0,0,0,0,0,0,0,0,+                       -105411381075/4, -5270569053750, -272908057767345/2,+                       -1051953238104769, -24557168490009155/8,+                       -3683261873403112, -5461918738302026/3,+                       -347362037754732, -2205885452434521/100,+                       -12237195698286/35, -16926981721/22,+                       -6710881/155, -1/600]++-- | Compute entropy directly from its definition. This is just as accurate+-- as 'alyThm1' for lambda <= 1 and is faster, but is slow for large lambda,+-- and produces some underestimation due to accumulation of floating point+-- error.+directEntropy :: Double -> Double+directEntropy lambda =+  negate . sum $+  takeWhile (< negate m_epsilon * lambda) $+  dropWhile (not . (< negate m_epsilon * lambda)) $+  [ let x = probability lambda k in x * log x | k <- [0..]]++-- | Compute the entropy of a Poisson distribution using the best available+-- method.+poissonEntropy :: Double -> Double+poissonEntropy lambda+  | lambda == 0 = 0+  | lambda <= 10 = directEntropy lambda+  | lambda <= 12 = alyThm2 lambda upperCoefficients4 lowerCoefficients4+  | lambda <= 18 = alyThm2 lambda upperCoefficients6 lowerCoefficients6+  | lambda <= 24 = alyThm2 lambda upperCoefficients8 lowerCoefficients8+  | lambda <= 30 = alyThm2 lambda upperCoefficients10 lowerCoefficients10+  | otherwise = alyThm2 lambda upperCoefficients12 lowerCoefficients12
+ Statistics/Distribution/StudentT.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}+-- |+-- Module    : Statistics.Distribution.StudentT+-- Copyright : (c) 2011 Aleksey Khudyakov+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Student-T distribution+module Statistics.Distribution.StudentT (+    StudentT+    -- * Constructors+  , studentT+  , studentTE+  , studentTUnstandardized+    -- * Accessors+  , studentTndf+  ) where++import Control.Applicative+import Data.Aeson          (FromJSON(..), ToJSON, Value(..), (.:))+import Data.Binary         (Binary(..))+import Data.Data           (Data, Typeable)+import GHC.Generics        (Generic)+import Numeric.SpecFunctions (+  logBeta, incompleteBeta, invIncompleteBeta, digamma, log1p)++import qualified Statistics.Distribution as D+import Statistics.Distribution.Transform (LinearTransform (..))+import Statistics.Internal+++-- | Student-T distribution+newtype StudentT = StudentT { studentTndf :: Double }+                   deriving (Eq, Typeable, Data, Generic)++instance Show StudentT where+  showsPrec i (StudentT ndf) = defaultShow1 "studentT" ndf i+instance Read StudentT where+  readPrec = defaultReadPrecM1 "studentT" studentTE++instance ToJSON StudentT+instance FromJSON StudentT where+  parseJSON (Object v) = do+    ndf <- v .: "studentTndf"+    maybe (fail $ errMsg ndf) return $ studentTE ndf+  parseJSON _ = empty++instance Binary StudentT where+  put = put . studentTndf+  get = do+    ndf <- get+    maybe (fail $ errMsg ndf) return $ studentTE ndf++-- | Create Student-T distribution. Number of parameters must be positive.+studentT :: Double -> StudentT+studentT ndf = maybe (error $ errMsg ndf) id $ studentTE ndf++-- | Create Student-T distribution. Number of parameters must be positive.+studentTE :: Double -> Maybe StudentT+studentTE ndf+  | ndf > 0   = Just (StudentT ndf)+  | otherwise = Nothing++errMsg :: Double -> String+errMsg _ = modErr "studentT" "non-positive number of degrees of freedom"+++instance D.Distribution StudentT where+  cumulative      = cumulative+  complCumulative = complCumulative++instance D.ContDistr StudentT where+  density    d@(StudentT ndf) x = exp (logDensityUnscaled d x) / sqrt ndf+  logDensity d@(StudentT ndf) x = logDensityUnscaled d x - log (sqrt ndf)+  quantile = quantile++cumulative :: StudentT -> Double -> Double+cumulative (StudentT ndf) x+  | x > 0     = 1 - 0.5 * ibeta+  | otherwise = 0.5 * ibeta+  where+    ibeta = incompleteBeta (0.5 * ndf) 0.5 (ndf / (ndf + x*x))++complCumulative :: StudentT -> Double -> Double+complCumulative (StudentT ndf) x+  | x > 0     = 0.5 * ibeta+  | otherwise = 1 - 0.5 * ibeta+  where+    ibeta = incompleteBeta (0.5 * ndf) 0.5 (ndf / (ndf + x*x))+++logDensityUnscaled :: StudentT -> Double -> Double+logDensityUnscaled (StudentT ndf) x+  = log1p (x*x/ndf) * (-(0.5 * (1 + ndf)))+  - logBeta 0.5 (0.5 * ndf)++quantile :: StudentT -> Double -> Double+quantile (StudentT ndf) p+  | p >= 0 && p <= 1 =+    let x = invIncompleteBeta (0.5 * ndf) 0.5 (2 * min p (1 - p))+    in case sqrt $ ndf * (1 - x) / x of+         r | p < 0.5   -> -r+           | otherwise -> r+  | otherwise = modErr "quantile" $ "p must be in [0,1] range. Got: "++show p+++instance D.MaybeMean StudentT where+  maybeMean (StudentT ndf) | ndf > 1   = Just 0+                           | otherwise = Nothing++instance D.MaybeVariance StudentT where+  maybeVariance (StudentT ndf) | ndf > 2   = Just $! ndf / (ndf - 2)+                               | otherwise = Nothing++instance D.Entropy StudentT where+  entropy (StudentT ndf) =+    0.5 * (ndf+1) * (digamma ((1+ndf)/2) - digamma(ndf/2))+    + log (sqrt ndf)+    + logBeta (ndf/2) 0.5++instance D.MaybeEntropy StudentT where+  maybeEntropy = Just . D.entropy++instance D.ContGen StudentT where+  genContVar = D.genContinuous++-- | Create an unstandardized Student-t distribution.+studentTUnstandardized :: Double -- ^ Number of degrees of freedom+                       -> Double -- ^ Central value (0 for standard Student T distribution)+                       -> Double -- ^ Scale parameter+                       -> LinearTransform StudentT+studentTUnstandardized ndf mu sigma+  | sigma > 0 = LinearTransform mu sigma $ studentT ndf+  | otherwise = modErr "studentTUnstandardized" $ "sigma must be > 0. Got: " ++ show sigma++modErr :: String -> String -> a+modErr fun msg = error $ "Statistics.Distribution.StudentT." ++ fun ++ ": " ++ msg
+ Statistics/Distribution/Transform.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, FlexibleContexts,+    FlexibleInstances, UndecidableInstances #-}+-- |+-- Module    : Statistics.Distribution.Transform+-- Copyright : (c) 2013 John McDonnell;+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Transformations over distributions+module Statistics.Distribution.Transform+    (+      LinearTransform (..)+    , linTransFixedPoint+    , scaleAround+    ) where++import Data.Aeson (FromJSON, ToJSON)+import Data.Binary (Binary)+import Data.Binary (put, get)+import Data.Data (Data, Typeable)+import GHC.Generics (Generic)+import qualified Statistics.Distribution as D++-- | Linear transformation applied to distribution.+--+-- > LinearTransform μ σ _+-- > x' = μ + σ·x+data LinearTransform d = LinearTransform+  { linTransLocation :: {-# UNPACK #-} !Double+    -- ^ Location parameter.+  , linTransScale    :: {-# UNPACK #-} !Double+    -- ^ Scale parameter.+  , linTransDistr    :: d+    -- ^ Distribution being transformed.+  } deriving (Eq, Show, Read, Typeable, Data, Generic)++instance (FromJSON d) => FromJSON (LinearTransform d)+instance (ToJSON d) => ToJSON (LinearTransform d)++instance (Binary d) => Binary (LinearTransform d) where+    get = LinearTransform <$> get <*> get <*> get+    put (LinearTransform x y z) = put x >> put y >> put z++-- | Apply linear transformation to distribution.+scaleAround :: Double           -- ^ Fixed point+            -> Double           -- ^ Scale parameter+            -> d                -- ^ Distribution+            -> LinearTransform d+scaleAround x0 sc = LinearTransform (x0 * (1 - sc)) sc++-- | Get fixed point of linear transformation+linTransFixedPoint :: LinearTransform d -> Double+linTransFixedPoint (LinearTransform loc sc _) = loc / (1 - sc)++instance Functor LinearTransform where+  fmap f (LinearTransform loc sc dist) = LinearTransform loc sc (f dist)++instance D.Distribution d => D.Distribution (LinearTransform d) where+  cumulative (LinearTransform loc sc dist) x = D.cumulative dist $ (x-loc) / sc++instance D.ContDistr d => D.ContDistr (LinearTransform d) where+  density    (LinearTransform loc sc dist) x = D.density    dist ((x-loc) / sc) / sc+  logDensity (LinearTransform loc sc dist) x = D.logDensity dist ((x-loc) / sc) - log sc+  quantile      (LinearTransform loc sc dist) p = loc + sc * D.quantile      dist p+  complQuantile (LinearTransform loc sc dist) p = loc + sc * D.complQuantile dist p++instance D.MaybeMean d => D.MaybeMean (LinearTransform d) where+  maybeMean (LinearTransform loc _ dist) = (+loc) <$> D.maybeMean dist++instance (D.Mean d) => D.Mean (LinearTransform d) where+  mean (LinearTransform loc _ dist) = loc + D.mean dist++instance D.MaybeVariance  d => D.MaybeVariance (LinearTransform d) where+  maybeVariance (LinearTransform _ sc dist) = (*(sc*sc)) <$> D.maybeVariance dist+  maybeStdDev   (LinearTransform _ sc dist) = (*sc)      <$> D.maybeStdDev dist++instance (D.Variance d) => D.Variance (LinearTransform d) where+  variance (LinearTransform _ sc dist) = sc * sc * D.variance dist+  stdDev   (LinearTransform _ sc dist) = sc * D.stdDev dist++instance (D.MaybeEntropy d) => D.MaybeEntropy (LinearTransform d) where+  maybeEntropy (LinearTransform _ _ dist) = D.maybeEntropy dist++instance (D.Entropy d) => D.Entropy (LinearTransform d) where+  entropy (LinearTransform _ _ dist) = D.entropy dist++instance D.ContGen d => D.ContGen (LinearTransform d) where+  genContVar (LinearTransform loc sc d) g = do+    x <- D.genContVar d g+    return $! loc + sc * x
+ Statistics/Distribution/Uniform.hs view
@@ -0,0 +1,120 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}+-- |+-- Module    : Statistics.Distribution.Uniform+-- Copyright : (c) 2011 Aleksey Khudyakov+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Variate distributed uniformly in the interval.+module Statistics.Distribution.Uniform+    (+      UniformDistribution+    -- * Constructors+    , uniformDistr+    , uniformDistrE+    -- ** Accessors+    , uniformA+    , uniformB+    ) where++import Control.Applicative+import Data.Aeson             (FromJSON(..), ToJSON, Value(..), (.:))+import Data.Binary            (Binary(..))+import Data.Data              (Data, Typeable)+import System.Random.Stateful (uniformRM)+import GHC.Generics           (Generic)++import qualified Statistics.Distribution as D+import Statistics.Internal++++-- | Uniform distribution from A to B+data UniformDistribution = UniformDistribution {+      uniformA :: {-# UNPACK #-} !Double -- ^ Low boundary of distribution+    , uniformB :: {-# UNPACK #-} !Double -- ^ Upper boundary of distribution+    } deriving (Eq, Typeable, Data, Generic)++instance Show UniformDistribution where+  showsPrec i (UniformDistribution a b) = defaultShow2 "uniformDistr" a b i+instance Read UniformDistribution where+  readPrec = defaultReadPrecM2 "uniformDistr" uniformDistrE++instance ToJSON UniformDistribution+instance FromJSON UniformDistribution where+  parseJSON (Object v) = do+    a <- v .: "uniformA"+    b <- v .: "uniformB"+    maybe (fail errMsg) return $ uniformDistrE a b+  parseJSON _ = empty++instance Binary UniformDistribution where+  put (UniformDistribution x y) = put x >> put y+  get = do+    a <- get+    b <- get+    maybe (fail errMsg) return $ uniformDistrE a b++-- | Create uniform distribution.+uniformDistr :: Double -> Double -> UniformDistribution+uniformDistr a b = maybe (error errMsg) id $ uniformDistrE a b++-- | Create uniform distribution.+uniformDistrE :: Double -> Double -> Maybe UniformDistribution+uniformDistrE a b+  | b < a     = Just $ UniformDistribution b a+  | a < b     = Just $ UniformDistribution a b+  | otherwise = Nothing+-- NOTE: failure is in default branch to guard against NaNs.++errMsg :: String+errMsg = "Statistics.Distribution.Uniform.uniform: wrong parameters"+++instance D.Distribution UniformDistribution where+  cumulative (UniformDistribution a b) x+    | x < a     = 0+    | x > b     = 1+    | otherwise = (x - a) / (b - a)++instance D.ContDistr UniformDistribution where+  density (UniformDistribution a b) x+    | x < a     = 0+    | x > b     = 0+    | otherwise = 1 / (b - a)+  quantile (UniformDistribution a b) p+    | p >= 0 && p <= 1 = a + (b - a) * p+    | otherwise        =+      error $ "Statistics.Distribution.Uniform.quantile: p must be in [0,1] range. Got: "++show p+  complQuantile (UniformDistribution a b) p+    | p >= 0 && p <= 1 = b + (a - b) * p+    | otherwise        =+      error $ "Statistics.Distribution.Uniform.complQuantile: p must be in [0,1] range. Got: "++show p++instance D.Mean UniformDistribution where+  mean (UniformDistribution a b) = 0.5 * (a + b)++instance D.Variance UniformDistribution where+  -- NOTE: 1/sqrt 12 is not constant folded (#4101) so it's written as+  --       numerical constant. (Also FIXME!)+  stdDev   (UniformDistribution a b) = 0.2886751345948129 * (b - a)+  variance (UniformDistribution a b) = d * d / 12 where d = b - a++instance D.MaybeMean UniformDistribution where+    maybeMean = Just . D.mean++instance D.MaybeVariance UniformDistribution where+    maybeStdDev   = Just . D.stdDev++instance D.Entropy UniformDistribution where+  entropy (UniformDistribution a b) = log (b - a)++instance D.MaybeEntropy UniformDistribution where+  maybeEntropy = Just . D.entropy++instance D.ContGen UniformDistribution where+    genContVar (UniformDistribution a b) = uniformRM (a,b)
+ Statistics/Distribution/Weibull.hs view
@@ -0,0 +1,224 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}+-- |+-- Module    : Statistics.Distribution.Lognormal+-- Copyright : (c) 2020 Ximin Luo+-- License   : BSD3+--+-- Maintainer  : infinity0@pwned.gg+-- Stability   : experimental+-- Portability : portable+--+-- The Weibull distribution.  This is a continuous probability+-- distribution that describes the occurrence of a single event whose+-- probability changes over time, controlled by the shape parameter.++module Statistics.Distribution.Weibull+    (+      WeibullDistribution+      -- * Constructors+    , weibullDistr+    , weibullDistrErr+    , weibullStandard+    , weibullDistrApproxMeanStddevErr+    ) where++import Control.Applicative+import Data.Aeson            (FromJSON(..), ToJSON, Value(..), (.:))+import Data.Binary           (Binary(..))+import Data.Data             (Data, Typeable)+import GHC.Generics          (Generic)+import Numeric.MathFunctions.Constants (m_eulerMascheroni)+import Numeric.SpecFunctions (expm1, log1p, logGamma)+import qualified Data.Vector.Generic as G++import qualified Statistics.Distribution as D+import qualified Statistics.Sample as S+import Statistics.Internal+++-- | The Weibull distribution.+data WeibullDistribution = WD {+      wdShape  :: {-# UNPACK #-} !Double+    , wdLambda :: {-# UNPACK #-} !Double+    } deriving (Eq, Typeable, Data, Generic)++instance Show WeibullDistribution where+  showsPrec i (WD k l) = defaultShow2 "weibullDistr" k l i+instance Read WeibullDistribution where+  readPrec = defaultReadPrecM2 "weibullDistr" $+    (either (const Nothing) Just .) . weibullDistrErr++instance ToJSON WeibullDistribution+instance FromJSON WeibullDistribution where+  parseJSON (Object v) = do+    k <- v .: "wdShape"+    l <- v .: "wdLambda"+    either fail return $ weibullDistrErr k l+  parseJSON _ = empty++instance Binary WeibullDistribution where+  put (WD k l) = put k >> put l+  get = do+    k <- get+    l <- get+    either fail return $ weibullDistrErr k l++instance D.Distribution WeibullDistribution where+  cumulative      = cumulative+  complCumulative = complCumulative++instance D.ContDistr WeibullDistribution where+  logDensity    = logDensity+  quantile      = quantile+  complQuantile = complQuantile++instance D.MaybeMean WeibullDistribution where+  maybeMean = Just . D.mean++instance D.Mean WeibullDistribution where+  mean (WD k l) = l * exp (logGamma (1 + 1 / k))++instance D.MaybeVariance WeibullDistribution where+  maybeStdDev   = Just . D.stdDev+  maybeVariance = Just . D.variance++instance D.Variance WeibullDistribution where+  variance (WD k l) = l * l * (exp (logGamma (1 + 2 * invk)) - q * q)+   where+    invk = 1 / k+    q    = exp (logGamma (1 + invk))++instance D.Entropy WeibullDistribution where+  entropy (WD k l) = m_eulerMascheroni * (1 - 1 / k) + log (l / k) + 1++instance D.MaybeEntropy WeibullDistribution where+  maybeEntropy = Just . D.entropy++instance D.ContGen WeibullDistribution where+  genContVar d = D.genContinuous d++-- | Standard Weibull distribution with scale factor (lambda) 1.+weibullStandard :: Double -> WeibullDistribution+weibullStandard k = weibullDistr k 1.0++-- | Create Weibull distribution from parameters.+--+-- If the shape (first) parameter is @1.0@, the distribution is equivalent to a+-- 'Statistics.Distribution.Exponential.ExponentialDistribution' with parameter+-- @1 / lambda@ the scale (second) parameter.+weibullDistr+  :: Double            -- ^ Shape+  -> Double            -- ^ Lambda (scale)+  -> WeibullDistribution+weibullDistr k l = either error id $ weibullDistrErr k l++-- | Create Weibull distribution from parameters.+--+-- If the shape (first) parameter is @1.0@, the distribution is equivalent to a+-- 'Statistics.Distribution.Exponential.ExponentialDistribution' with parameter+-- @1 / lambda@ the scale (second) parameter.+weibullDistrErr+  :: Double            -- ^ Shape+  -> Double            -- ^ Lambda (scale)+  -> Either String WeibullDistribution+weibullDistrErr k l | k <= 0     = Left $ errMsg k l+                    | l <= 0     = Left $ errMsg k l+                    | otherwise = Right $ WD k l++errMsg :: Double -> Double -> String+errMsg k l =+  "Statistics.Distribution.Weibull.weibullDistr: both shape and lambda must be positive. Got shape "+    ++ show k+    ++ " and lambda "+    ++ show l++-- | Create Weibull distribution from mean and standard deviation.+--+-- The algorithm is from "Methods for Estimating Wind Speed Frequency+-- Distributions", C. G. Justus, W. R. Hargreaves, A. Mikhail, D. Graber, 1977.+-- Given the identity:+--+-- \[+-- (\frac{\sigma}{\mu})^2 = \frac{\Gamma(1+2/k)}{\Gamma(1+1/k)^2} - 1+-- \]+--+-- \(k\) can be approximated by+--+-- \[+-- k \approx (\frac{\sigma}{\mu})^{-1.086}+-- \]+--+-- \(\lambda\) is then calculated straightforwardly via the identity+--+-- \[+-- \lambda = \frac{\mu}{\Gamma(1+1/k)}+-- \]+--+-- Numerically speaking, the approximation for \(k\) is accurate only within a+-- certain range. We arbitrarily pick the range \(0.033 \le \frac{\sigma}{\mu} \le 1.45\)+-- where it is good to ~6%, and will refuse to create a distribution outside of+-- this range. The paper does not cover these details but it is straightforward+-- to check them numerically.+weibullDistrApproxMeanStddevErr+  :: Double            -- ^ Mean+  -> Double            -- ^ Stddev+  -> Either String WeibullDistribution+weibullDistrApproxMeanStddevErr m s = if r > 1.45 || r < 0.033+    then Left msg+    else weibullDistrErr k l+  where r = s / m+        k = (s / m) ** (-1.086)+        l = m / exp (logGamma (1 + 1/k))+        msg = "Statistics.Distribution.Weibull.weibullDistr: stddev-mean ratio "+          ++ "outside approximation accuracy range [0.033, 1.45]. Got "+          ++ "stddev " ++ show s ++ " and mean " ++ show m++-- | Uses an approximation based on the mean and standard deviation in+--   'weibullDistrEstMeanStddevErr', with standard deviation estimated+--   using maximum likelihood method (unbiased estimation).+--+--   Returns @Nothing@ if sample contains less than one element or+--   variance is zero (all elements are equal), or if the estimated mean+--   and standard-deviation lies outside the range for which the+--   approximation is accurate.+instance D.FromSample WeibullDistribution Double where+  fromSample xs+    | G.length xs <= 1 = Nothing+    | v == 0           = Nothing+    | otherwise        = either (const Nothing) Just $+      weibullDistrApproxMeanStddevErr m (sqrt v)+    where+      (m,v) = S.meanVarianceUnb xs++logDensity :: WeibullDistribution -> Double -> Double+logDensity (WD k l) x+  | x < 0     = 0+  | otherwise = log k + (k - 1) * log x - k * log l - (x / l) ** k++cumulative :: WeibullDistribution -> Double -> Double+cumulative (WD k l) x | x < 0     = 0+                      | otherwise = -expm1 (-(x / l) ** k)++complCumulative :: WeibullDistribution -> Double -> Double+complCumulative (WD k l) x | x < 0     = 1+                           | otherwise = exp (-(x / l) ** k)++quantile :: WeibullDistribution -> Double -> Double+quantile (WD k l) p+  | p == 0         = 0+  | p == 1         = inf+  | p > 0 && p < 1 = l * (-log1p (-p)) ** (1 / k)+  | otherwise      =+    error $ "Statistics.Distribution.Weibull.quantile: p must be in [0,1] range. Got: " ++ show p+  where inf = 1 / 0++complQuantile :: WeibullDistribution -> Double -> Double+complQuantile (WD k l) q+  | q == 0         = inf+  | q == 1         = 0+  | q > 0 && q < 1 = l * (-log q) ** (1 / k)+  | otherwise      =+    error $ "Statistics.Distribution.Weibull.complQuantile: q must be in [0,1] range. Got: " ++ show q+  where inf = 1 / 0
Statistics/Function.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE Rank2Types, TypeOperators #-}+{-# LANGUAGE BangPatterns, CPP, FlexibleContexts, Rank2Types #-}+{-# OPTIONS_GHC -fsimpl-tick-factor=200 #-} -- | -- Module    : Statistics.Function--- Copyright : (c) 2009 Bryan O'Sullivan+-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan -- License   : BSD3 -- -- Maintainer  : bos@serpentine.com@@ -12,66 +13,133 @@  module Statistics.Function     (+    -- * Scanning       minMax+    -- * Sorting     , sort+    , gsort+    , sortBy     , partialSort+    -- * Indexing+    , indexed     , indices-    -- * Array setup-    , createU-    , createIO+    -- * Bit twiddling+    , nextHighestPowerOfTwo+    -- * Comparison+    , within+    -- * Arithmetic+    , square+    -- * Vectors+    , unsafeModify+    -- * Combinators+    , for+    , rfor     ) where -import Control.Exception (assert)-import Control.Monad.ST (ST, unsafeIOToST, unsafeSTToIO)-import Data.Array.Vector.Algorithms.Combinators (apply)-import Data.Array.Vector-import qualified Data.Array.Vector.Algorithms.Intro as I+#include "MachDeps.h" --- | Sort an array.-sort :: (UA e, Ord e) => UArr e -> UArr e-sort = apply I.sort-{-# INLINE sort #-}+import Control.Monad.ST (ST)+import Data.Bits ((.|.), shiftR)+import qualified Data.Vector.Algorithms.Intro as I+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Unboxed.Mutable as M+import Numeric.MathFunctions.Comparison (within) --- | Partially sort an array, such that the least /k/ elements will be+-- | Sort a vector.+sort :: U.Vector Double -> U.Vector Double+sort = G.modify I.sort+{-# NOINLINE sort #-}++-- | Sort a vector.+gsort :: (Ord e, G.Vector v e) => v e -> v e+gsort = G.modify I.sort+{-# INLINE gsort #-}++-- | Sort a vector using a custom ordering.+sortBy :: (G.Vector v e) => I.Comparison e -> v e -> v e+sortBy f = G.modify $ I.sortBy f+{-# INLINE sortBy #-}++-- | Partially sort a vector, such that the least /k/ elements will be -- at the front.-partialSort :: (UA e, Ord e) =>-               Int              -- ^ The number /k/ of least elements.-            -> UArr e-            -> UArr e-partialSort k = apply (\a -> I.partialSort a k)-{-# INLINE partialSort #-}+partialSort :: (G.Vector v e, Ord e) =>+               Int -- ^ The number /k/ of least elements.+            -> v e+            -> v e+partialSort k = G.modify (`I.partialSort` k)+{-# SPECIALIZE partialSort :: Int -> U.Vector Double -> U.Vector Double #-} --- | Return the indices of an array.-indices :: (UA a) => UArr a -> UArr Int-indices a = enumFromToU 0 (lengthU a - 1)+-- | Return the indices of a vector.+indices :: (G.Vector v a, G.Vector v Int) => v a -> v Int+indices a = G.enumFromTo 0 (G.length a - 1) {-# INLINE indices #-} +-- | Zip a vector with its indices.+indexed :: (G.Vector v e, G.Vector v (Int,e)) => v e -> v (Int,e)+indexed xs = G.imap (,) xs+{-# INLINE indexed #-}+ data MM = MM {-# UNPACK #-} !Double {-# UNPACK #-} !Double --- | Compute the minimum and maximum of an array in one pass.-minMax :: UArr Double -> Double :*: Double-minMax = fini . foldlU go (MM (1/0) (-1/0))+-- | Compute the minimum and maximum of a vector in one pass.+minMax :: (G.Vector v Double) => v Double -> (Double, Double)+minMax = fini . G.foldl' go (MM (1/0) (-1/0))   where     go (MM lo hi) k = MM (min lo k) (max hi k)-    fini (MM lo hi) = lo :*: hi+    fini (MM lo hi) = (lo, hi) {-# INLINE minMax #-} --- | Create an array, using the given 'ST' action to populate each--- element.-createU :: (UA e) => forall s. Int -> (Int -> ST s e) -> ST s (UArr e)-createU size itemAt = assert (size >= 0) $-    newMU size >>= loop 0+-- | Efficiently compute the next highest power of two for a+-- non-negative integer.  If the given value is already a power of+-- two, it is returned unchanged.  If negative, zero is returned.+nextHighestPowerOfTwo :: Int -> Int+nextHighestPowerOfTwo n+#if WORD_SIZE_IN_BITS == 64+  = 1 + _i32+#else+  = 1 + i16+#endif   where-    loop k arr | k >= size = unsafeFreezeAllMU arr-               | otherwise = do-      r <- itemAt k-      writeMU arr k r-      loop (k+1) arr-{-# INLINE createU #-}+    i0   = n - 1+    i1   = i0  .|. i0  `shiftR` 1+    i2   = i1  .|. i1  `shiftR` 2+    i4   = i2  .|. i2  `shiftR` 4+    i8   = i4  .|. i4  `shiftR` 8+    i16  = i8  .|. i8  `shiftR` 16+    _i32 = i16 .|. i16 `shiftR` 32+-- It could be implemented as+--+-- > nextHighestPowerOfTwo n = 1 + foldl' go (n-1) [1, 2, 4, 8, 16, 32]+--     where go m i = m .|. m `shiftR` i+--+-- But GHC do not inline foldl (probably because it's recursive) and+-- as result function walks list of boxed ints. Hand rolled version+-- uses unboxed arithmetic. --- | Create an array, using the given 'IO' action to populate each--- element.-createIO :: (UA e) => Int -> (Int -> IO e) -> IO (UArr e)-createIO size itemAt =-    unsafeSTToIO $ createU size (unsafeIOToST . itemAt)-{-# INLINE createIO #-}+-- | Multiply a number by itself.+square :: Double -> Double+square x = x * x++-- | Simple for loop.  Counts from /start/ to /end/-1.+for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()+for n0 !n f = loop n0+  where+    loop i | i == n    = return ()+           | otherwise = f i >> loop (i+1)+{-# INLINE for #-}++-- | Simple reverse-for loop.  Counts from /start/-1 to /end/ (which+-- must be less than /start/).+rfor :: Monad m => Int -> Int -> (Int -> m ()) -> m ()+rfor n0 !n f = loop n0+  where+    loop i | i == n    = return ()+           | otherwise = let i' = i-1 in f i' >> loop i'+{-# INLINE rfor #-}++unsafeModify :: M.MVector s Double -> Int -> (Double -> Double) -> ST s ()+unsafeModify v i f = do+  k <- M.unsafeRead v i+  M.unsafeWrite v i (f k)+{-# INLINE unsafeModify #-}
Statistics/Internal.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-} -- | -- Module    : Statistics.Internal -- Copyright : (c) 2009 Bryan O'Sullivan@@ -8,34 +7,88 @@ -- Stability   : experimental -- Portability : portable ----- Scary internal functions.+-- +module Statistics.Internal (+    -- * Default definitions for Show+    defaultShow1+  , defaultShow2+  , defaultShow3+    -- * Default definitions for Read+  , defaultReadPrecM1+  , defaultReadPrecM2+  , defaultReadPrecM3+    -- * Reexports+  , Show(..)+  , Read(..)+  ) where -module Statistics.Internal-    (-      inlinePerformIO-    ) where+import Control.Applicative+import Control.Monad+import Text.Read -#if __GLASGOW_HASKELL__ >= 611-import GHC.IO (IO(IO))-#else-import GHC.IOBase (IO(IO))-#endif-import GHC.Base (realWorld#)-#if !defined(__GLASGOW_HASKELL__)-import System.IO.Unsafe (unsafePerformIO)-#endif --- Lifted from Data.ByteString.Internal so we don't introduce an--- otherwise unnecessary dependency on the bytestring package.+----------------------------------------------------------------+-- Default show implementations+---------------------------------------------------------------- --- | Just like unsafePerformIO, but we inline it. Big performance--- gains as it exposes lots of things to further inlining. /Very--- unsafe/. In particular, you should do no memory allocation inside--- an 'inlinePerformIO' block. On Hugs this is just @unsafePerformIO@.-{-# INLINE inlinePerformIO #-}-inlinePerformIO :: IO a -> a-#if defined(__GLASGOW_HASKELL__)-inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r-#else-inlinePerformIO = unsafePerformIO-#endif+defaultShow1 :: (Show a) => String -> a -> Int -> ShowS+defaultShow1 con a n+  = showParen (n >= 11)+  ( showString con+  . showChar ' '+  . showsPrec 11 a+  )++defaultShow2 :: (Show a, Show b) => String -> a -> b -> Int -> ShowS+defaultShow2 con a b n+  = showParen (n >= 11)+  ( showString con+  . showChar ' '+  . showsPrec 11 a+  . showChar ' '+  . showsPrec 11 b+  )++defaultShow3 :: (Show a, Show b, Show c)+             => String -> a -> b -> c -> Int -> ShowS+defaultShow3 con a b c n+  = showParen (n >= 11)+  ( showString con+  . showChar ' '+  . showsPrec 11 a+  . showChar ' '+  . showsPrec 11 b+  . showChar ' '+  . showsPrec 11 c+  )++----------------------------------------------------------------+-- Default read implementations+----------------------------------------------------------------++defaultReadPrecM1 :: (Read a) => String -> (a -> Maybe r) -> ReadPrec r+defaultReadPrecM1 con f = parens $ prec 10 $ do+  expect con+  a <- readPrec+  maybe empty return $ f a++defaultReadPrecM2 :: (Read a, Read b) => String -> (a -> b -> Maybe r) -> ReadPrec r+defaultReadPrecM2 con f = parens $ prec 10 $ do+  expect con+  a <- readPrec+  b <- readPrec+  maybe empty return $ f a b++defaultReadPrecM3 :: (Read a, Read b, Read c)+                 => String -> (a -> b -> c -> Maybe r) -> ReadPrec r+defaultReadPrecM3 con f = parens $ prec 10 $ do+  expect con+  a <- readPrec+  b <- readPrec+  c <- readPrec+  maybe empty return $ f a b c++expect :: String -> ReadPrec ()+expect str = do+  Ident s <- lexP+  guard (s == str)
− Statistics/KernelDensity.hs 
@@ -1,165 +0,0 @@--- |--- Module    : Statistics.KernelDensity--- Copyright : (c) 2009 Bryan O'Sullivan--- License   : BSD3------ Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : portable------ Kernel density estimation code, providing non-parametric ways to--- estimate the probability density function of a sample.--module Statistics.KernelDensity-    (-    -- * Simple entry points-      epanechnikovPDF-    , gaussianPDF-    -- * Building blocks-    -- These functions may be useful if you need to construct a kernel-    -- density function estimator other than the ones provided in this-    -- module.--    -- ** Choosing points from a sample-    , Points(..)-    , choosePoints-    -- ** Bandwidth estimation-    , Bandwidth-    , bandwidth-    , epanechnikovBW-    , gaussianBW-    -- ** Kernels-    , Kernel-    , epanechnikovKernel-    , gaussianKernel-    -- ** Low-level estimation-    , estimatePDF-    , simplePDF-    ) where--import Data.Array.Vector ((:*:)(..), UArr, enumFromToU, lengthU, mapU, sumU)-import Statistics.Function (minMax)-import Statistics.Sample (stdDev)-import Statistics.Constants (m_1_sqrt_2, m_2_sqrt_pi)-import Statistics.Types (Sample)---- | Points from the range of a 'Sample'.-newtype Points = Points {-      fromPoints :: UArr Double-    } deriving (Eq, Show)---- | Bandwidth estimator for an Epanechnikov kernel.-epanechnikovBW :: Double -> Bandwidth-epanechnikovBW n = (80 / (n * m_2_sqrt_pi)) ** 0.2---- | Bandwidth estimator for a Gaussian kernel.-gaussianBW :: Double -> Bandwidth-gaussianBW n = (4 / (n * 3)) ** 0.2---- | The width of the convolution kernel used.-type Bandwidth = Double---- | Compute the optimal bandwidth from the observed data for the given--- kernel.-bandwidth :: (Double -> Bandwidth)-          -> Sample-          -> Bandwidth-bandwidth kern values = stdDev values * kern (fromIntegral $ lengthU values)---- | Choose a uniform range of points at which to estimate a sample's--- probability density function.------ If you are using a Gaussian kernel, multiply the sample's bandwidth--- by 3 before passing it to this function.------ If this function is passed an empty vector, it returns values of--- positive and negative infinity.-choosePoints :: Int             -- ^ Number of points to select, /n/-             -> Double          -- ^ Sample bandwidth, /h/-             -> Sample          -- ^ Input data-             -> Points-choosePoints n h sample = Points . mapU f $ enumFromToU 0 n'-  where lo      = a - h-        hi      = z + h-        a :*: z = minMax sample-        d       = (hi - lo) / fromIntegral n'-        f i     = lo + fromIntegral i * d-        n'      = n - 1---- | The convolution kernel.  Its parameters are as follows:------ * Scaling factor, 1\//nh/------ * Bandwidth, /h/------ * A point at which to sample the input, /p/------ * One sample value, /v/-type Kernel =  Double-            -> Double-            -> Double-            -> Double-            -> Double---- | Epanechnikov kernel for probability density function estimation.-epanechnikovKernel :: Kernel-epanechnikovKernel f h p v-    | abs u <= 1 = f * (1 - u * u)-    | otherwise  = 0-    where u = (v - p) / (h * 0.75)---- | Gaussian kernel for probability density function estimation.-gaussianKernel :: Kernel-gaussianKernel f h p v = exp (-0.5 * u * u) * g-    where u = (v - p) / h-          g = f * m_2_sqrt_pi * m_1_sqrt_2---- | Kernel density estimator, providing a non-parametric way of--- estimating the PDF of a random variable.-estimatePDF :: Kernel           -- ^ Kernel function-            -> Bandwidth        -- ^ Bandwidth, /h/-            -> Sample           -- ^ Sample data-            -> Points           -- ^ Points at which to estimate-            -> UArr Double-estimatePDF kernel h sample-    | n < 2     = errorShort "estimatePDF"-    | otherwise = mapU k . fromPoints-  where-    k p = sumU . mapU (kernel f h p) $ sample-    f   = 1 / (h * fromIntegral n)-    n   = lengthU sample-{-# INLINE estimatePDF #-}---- | A helper for creating a simple kernel density estimation function--- with automatically chosen bandwidth and estimation points.-simplePDF :: (Double -> Double) -- ^ Bandwidth function-          -> Kernel             -- ^ Kernel function-          -> Double             -- ^ Bandwidth scaling factor (3 for a Gaussian kernel, 1 for all others)-          -> Int                -- ^ Number of points at which to estimate-          -> Sample             -- ^ Sample data-          -> (Points, UArr Double)-simplePDF fbw fpdf k numPoints sample =-    (points, estimatePDF fpdf bw sample points)-  where points = choosePoints numPoints (bw*k) sample-        bw     = bandwidth fbw sample-{-# INLINE simplePDF #-}---- | Simple Epanechnikov kernel density estimator.  Returns the--- uniformly spaced points from the sample range at which the density--- function was estimated, and the estimates at those points.-epanechnikovPDF :: Int          -- ^ Number of points at which to estimate-                -> Sample-                -> (Points, UArr Double)-epanechnikovPDF = simplePDF epanechnikovBW epanechnikovKernel 1---- | Simple Gaussian kernel density estimator.  Returns the uniformly--- spaced points from the sample range at which the density function--- was estimated, and the estimates at those points.-gaussianPDF :: Int              -- ^ Number of points at which to estimate-            -> Sample-            -> (Points, UArr Double)-gaussianPDF = simplePDF gaussianBW gaussianKernel 3--errorShort :: String -> a-errorShort func = error ("Statistics.KernelDensity." ++ func ++-                        ": at least two points required")
− Statistics/Math.hs 
@@ -1,239 +0,0 @@-{-# LANGUAGE BangPatterns #-}--- |--- Module    : Statistics.Math--- Copyright : (c) 2009 Bryan O'Sullivan--- License   : BSD3------ Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : portable------ Mathematical functions for statistics.--module Statistics.Math-    (-    -- * Functions-      chebyshev-    , choose-    -- ** Factorial functions-    , factorial-    , logFactorial-    -- ** Gamma functions-    , incompleteGamma-    , logGamma-    , logGammaL-    -- * References-    -- $references-    ) where--import Data.Array.Vector-import Data.Word (Word64)-import Statistics.Constants (m_sqrt_2_pi)-import Statistics.Distribution (cumulative)-import Statistics.Distribution.Normal (standard)--data C = C {-# UNPACK #-} !Double {-# UNPACK #-} !Double {-# UNPACK #-} !Double---- | Evaluate a series of Chebyshev polynomials. Uses Clenshaw's--- algorithm.-chebyshev :: Double             -- ^ Parameter of each function.-          -> UArr Double        -- ^ Coefficients of each polynomial-          -- term, in increasing order.-          -> Double-chebyshev x a = fini . foldlU step (C 0 0 0) .-                enumFromThenToU (lengthU a - 1) (-1) $ 0-    where step (C u v w) k = C (x2 * v - w + indexU a k) u v-          fini (C u _ w)   = (u - w) / 2-          x2               = x * 2---- | The binomial coefficient.------ > 7 `choose` 3 == 35-choose :: Int -> Int -> Double-n `choose` k-    | k > n     = 0-    | k < 30    = foldlU go 1 . enumFromToU 1 $ k'-    | otherwise = exp $ lg (n+1) - lg (k+1) - lg (n-k+1)-    where go a i = a * (nk + j) / j-              where j = fromIntegral i :: Double-          k' | k > n `div` 2 = n - k-             | otherwise     = k-          nk = fromIntegral (n - k')-          lg = logGamma . fromIntegral-{-# INLINE choose #-}--data F = F {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64---- | Compute the factorial function /n/!.  Returns &#8734; if the--- input is above 170 (above which the result cannot be represented by--- a 64-bit 'Double').-factorial :: Int -> Double-factorial n-    | n < 0     = error "Statistics.Math.factorial: negative input"-    | n <= 1    = 0-    | n <= 14   = fini . foldlU goLong (F 1 1) $ ns-    | otherwise = foldlU goDouble 1 $ ns-    where goDouble t k = t * fromIntegral k-          goLong (F z x) _ = F (z * x') x'-              where x' = x + 1-          fini (F z _) = fromIntegral z-          ns = enumFromToU 2 n-{-# INLINE factorial #-}---- | Compute the natural logarithm of the factorial function.  Gives--- 16 decimal digits of precision.-logFactorial :: Int -> Double-logFactorial n-    | n <= 14   = log (factorial n)-    | otherwise = (x - 0.5) * log x - x + 9.1893853320467e-1 + z / x-    where x = fromIntegral (n + 1)-          y = 1 / (x * x)-          z = ((-(5.95238095238e-4 * y) + 7.936500793651e-4) * y --               2.7777777777778e-3) * y + 8.3333333333333e-2-{-# INLINE logFactorial #-}---- | Compute the incomplete gamma integral function &#947;(/s/,/x/).--- Uses Algorithm AS 239 by Shea.-incompleteGamma :: Double       -- ^ /s/-                -> Double       -- ^ /x/-                -> Double-incompleteGamma x p-    | x < 0 || p <= 0 = 1/0-    | x == 0          = 0-    | p >= 1000       = norm (3 * sqrt p * ((x/p) ** (1/3) + 1/(9*p) - 1))-    | x >= 1e8        = 0-    | x <= 1 || x < p = let a = p * log x - x - logGamma (p + 1)-                            g = a + log (pearson p 1 1)-                        in if g > limit then exp g else 0-    | otherwise       = let g = p * log x - x - logGamma p + log cf-                        in if g > limit then 1 - exp g else 1-  where-    norm = cumulative standard-    pearson !a !c !g-        | c' <= tolerance = g'-        | otherwise       = pearson a' c' g'-        where a' = a + 1-              c' = c * x / a'-              g' = g + c'-    cf = let a = 1 - p-             b = a + x + 1-             p3 = x + 1-             p4 = x * b-         in contFrac a b 0 1 x p3 p4 (p3/p4)-    contFrac !a !b !c !p1 !p2 !p3 !p4 !g-        | abs (g - rn) <= min tolerance (tolerance * rn) = g-        | otherwise = contFrac a' b' c' (f p3) (f p4) (f p5) (f p6) rn-        where a' = a + 1-              b' = b + 2-              c' = c + 1-              an = a' * c'-              p5 = b' * p3 - an * p1-              p6 = b' * p4 - an * p2-              rn = p5 / p6-              f n | abs p5 > overflow = n / overflow-                  | otherwise         = n-    limit     = -88-    tolerance = 1e-14-    overflow  = 1e37---- Adapted from http://people.sc.fsu.edu/~burkardt/f_src/asa245/asa245.html---- | Compute the logarithm of the gamma function &#915;(/x/).  Uses--- Algorithm AS 245 by Macleod.------ Gives an accuracy of 10&#8211;12 significant decimal digits, except--- for small regions around /x/ = 1 and /x/ = 2, where the function--- goes to zero.  For greater accuracy, use 'logGammaL'.------ Returns &#8734; if the input is outside of the range (0 < /x/--- &#8804; 1e305).-logGamma :: Double -> Double-logGamma x-    | x <= 0    = 1/0-    | x < 1.5   = a + c *-                  ((((r1_4 * b + r1_3) * b + r1_2) * b + r1_1) * b + r1_0) /-                  ((((b + r1_8) * b + r1_7) * b + r1_6) * b + r1_5)-    | x < 4     = (x - 2) *-                  ((((r2_4 * x + r2_3) * x + r2_2) * x + r2_1) * x + r2_0) /-                  ((((x + r2_8) * x + r2_7) * x + r2_6) * x + r2_5)-    | x < 12    = ((((r3_4 * x + r3_3) * x + r3_2) * x + r3_1) * x + r3_0) /-                  ((((x + r3_8) * x + r3_7) * x + r3_6) * x + r3_5)-    | x > 5.1e5 = k-    | otherwise = k + x1 *-                  ((r4_2 * x2 + r4_1) * x2 + r4_0) /-                  ((x2 + r4_4) * x2 + r4_3)-  where-    a :*: b :*: c-        | x < 0.5   = -y :*: x + 1 :*: x-        | otherwise = 0  :*: x     :*: x - 1--    y      = log x-    k      = x * (y-1) - 0.5 * y + alr2pi-    alr2pi = 0.918938533204673--    x1 = 1 / x-    x2 = x1 * x1--    r1_0 = -2.66685511495; r1_1 = -24.4387534237; r1_2 = -21.9698958928-    r1_3 = 11.1667541262; r1_4 = 3.13060547623; r1_5 = 0.607771387771-    r1_6 = 11.9400905721; r1_7 = 31.4690115749; r1_8 = 15.2346874070--    r2_0 = -78.3359299449; r2_1 = -142.046296688; r2_2 = 137.519416416-    r2_3 = 78.6994924154; r2_4 = 4.16438922228; r2_5 = 47.0668766060-    r2_6 = 313.399215894; r2_7 = 263.505074721; r2_8 = 43.3400022514--    r3_0 = -2.12159572323; r3_1 = 2.30661510616; r3_2 = 2.74647644705-    r3_3 = -4.02621119975; r3_4 = -2.29660729780; r3_5 = -1.16328495004-    r3_6 = -1.46025937511; r3_7 = -2.42357409629; r3_8 = -5.70691009324--    r4_0 = 0.279195317918525; r4_1 = 0.4917317610505968;-    r4_2 = 0.0692910599291889; r4_3 = 3.350343815022304-    r4_4 = 6.012459259764103--data L = L {-# UNPACK #-} !Double {-# UNPACK #-} !Double---- | Compute the logarithm of the gamma function, &#915;(/x/).  Uses a--- Lanczos approximation.------ This function is slower than 'logGamma', but gives 14 or more--- significant decimal digits of accuracy, except around /x/ = 1 and--- /x/ = 2, where the function goes to zero.------ Returns &#8734; if the input is outside of the range (0 < /x/--- &#8804; 1e305).-logGammaL :: Double -> Double-logGammaL x-    | x <= 0    = 1/0-    | otherwise = fini . foldlU go (L 0 (x+7)) $ a-    where fini (L l _) = log (l+a0) + log m_sqrt_2_pi - x65 + (x-0.5) * log x65-          go (L l t) k = L (l + k / t) (t-1)-          x65 = x + 6.5-          a0  = 0.9999999999995183-          a   = toU [ 0.1659470187408462e-06-                    , 0.9934937113930748e-05-                    , -0.1385710331296526-                    , 12.50734324009056-                    , -176.6150291498386-                    , 771.3234287757674-                    , -1259.139216722289-                    , 676.5203681218835-                    ]---- $references------ * Clenshaw, C.W. (1962) Chebyshev series for mathematical---   functions. /National Physical Laboratory Mathematical Tables 5/,---   Her Majesty's Stationery Office, London.------ * Lanczos, C. (1964) A precision approximation of the gamma---   function.  /SIAM Journal on Numerical Analysis B/---   1:86&#8211;96. <http://www.jstor.org/stable/2949767>------ * Macleod, A.J. (1989) Algorithm AS 245: A robust and reliable---   algorithm for the logarithm of the gamma function.---   /Journal of the Royal Statistical Society, Series C (Applied Statistics)/---   38(2):397&#8211;402. <http://www.jstor.org/stable/2348078>------ * Shea, B. (1988) Algorithm AS 239: Chi-squared and incomplete---   gamma integral. /Applied Statistics/---   37(3):466&#8211;473. <http://www.jstor.org/stable/2347328>
Statistics/Quantile.hs view
@@ -1,4 +1,9 @@-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFoldable     #-}+{-# LANGUAGE DeriveFunctor      #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE FlexibleContexts   #-}+{-# LANGUAGE ViewPatterns       #-} -- | -- Module    : Statistics.Quantile -- Copyright : (c) 2009 Bryan O'Sullivan@@ -15,170 +20,381 @@ -- The number of quantiles is described below by the variable /q/, so -- with /q/=4, a 4-quantile (also known as a /quartile/) has 4 -- intervals, and contains 5 points.  The parameter /k/ describes the--- desired point, where 0 &#8804; /k/ &#8804; /q/.+-- desired point, where 0 ≤ /k/ ≤ /q/.  module Statistics.Quantile     (     -- * Quantile estimation functions-      weightedAvg-    , ContParam(..)-    , continuousBy-    , midspread--    -- * Parameters for the continuous sample method+    -- $cont_quantiles+      ContParam(..)+    , Default(..)+    , quantile+    , quantiles+    , quantilesVec+    -- ** Parameters for the continuous sample method     , cadpw     , hazen-    , s     , spss+    , s     , medianUnbiased     , normalUnbiased-+    -- * Other algorithms+    , weightedAvg+    -- * Median & other specializations+    , median+    , mad+    , midspread+    -- * Deprecated+    , continuousBy     -- * References     -- $references     ) where -import Control.Exception (assert)-import Data.Array.Vector (allU, indexU, lengthU)-import Statistics.Constants (m_epsilon)+import           Data.Binary            (Binary)+import           Data.Aeson             (ToJSON,FromJSON)+import           Data.Data              (Data,Typeable)+import           Data.Default.Class+import qualified Data.Foldable        as F+import           Data.Vector.Generic ((!))+import qualified Data.Vector          as V+import qualified Data.Vector.Generic  as G+import qualified Data.Vector.Unboxed  as U+import qualified Data.Vector.Storable as S+import GHC.Generics (Generic)+ import Statistics.Function (partialSort)-import Statistics.Types (Sample) --- | O(/n/ log /n/). Estimate the /k/th /q/-quantile of a sample,--- using the weighted average method.-weightedAvg :: Int              -- ^ /k/, the desired quantile.-            -> Int              -- ^ /q/, the number of quantiles.-            -> Sample           -- ^ /x/, the sample data.++----------------------------------------------------------------+-- Quantile estimation+----------------------------------------------------------------++-- | O(/n/·log /n/). Estimate the /k/th /q/-quantile of a sample,+-- using the weighted average method. Up to rounding errors it's same+-- as @quantile s@.+--+-- The following properties should hold otherwise an error will be thrown.+--+--   * the length of the input is greater than @0@+--+--   * the input does not contain @NaN@+--+--   * k ≥ 0 and k ≤ q+weightedAvg :: G.Vector v Double =>+               Int        -- ^ /k/, the desired quantile.+            -> Int        -- ^ /q/, the number of quantiles.+            -> v Double   -- ^ /x/, the sample data.             -> Double-weightedAvg k q x =-    assert (q >= 2) .-    assert (k >= 0) .-    assert (k < q) .-    assert (allU (not . isNaN) x) $-    xj + g * (xj1 - xj)+weightedAvg k q x+  | G.any isNaN x   = modErr "weightedAvg" "Sample contains NaNs"+  | n == 0          = modErr "weightedAvg" "Sample is empty"+  | n == 1          = G.head x+  | q < 2           = modErr "weightedAvg" "At least 2 quantiles is needed"+  | k == q          = G.maximum x+  | k >= 0 || k < q = xj + g * (xj1 - xj)+  | otherwise       = modErr "weightedAvg" "Wrong quantile number"   where     j   = floor idx-    idx = fromIntegral (lengthU x - 1) * fromIntegral k / fromIntegral q+    idx = fromIntegral (n - 1) * fromIntegral k / fromIntegral q     g   = idx - fromIntegral j-    xj  = indexU sx j-    xj1 = indexU sx (j+1)+    xj  = sx ! j+    xj1 = sx ! (j+1)     sx  = partialSort (j+2) x-{-# INLINE weightedAvg #-}+    n   = G.length x+{-# SPECIALIZE weightedAvg :: Int -> Int -> U.Vector Double -> Double #-}+{-# SPECIALIZE weightedAvg :: Int -> Int -> V.Vector Double -> Double #-}+{-# SPECIALIZE weightedAvg :: Int -> Int -> S.Vector Double -> Double #-} --- | Parameters /a/ and /b/ to the 'continuousBy' function.-data ContParam = ContParam {-# UNPACK #-} !Double {-# UNPACK #-} !Double --- | O(/n/ log /n/). Estimate the /k/th /q/-quantile of a sample /x/,--- using the continuous sample method with the given parameters.  This--- is the method used by most statistical software, such as R,+----------------------------------------------------------------+-- Quantiles continuous algorithm+----------------------------------------------------------------++-- $cont_quantiles+--+-- Below is family of functions which use same algorithm for estimation+-- of sample quantiles. It approximates empirical CDF as continuous+-- piecewise function which interpolates linearly between points+-- \((X_k,p_k)\) where \(X_k\) is k-th order statistics (k-th smallest+-- element) and \(p_k\) is probability corresponding to+-- it. 'ContParam' determines how \(p_k\) is chosen. For more detailed+-- explanation see [Hyndman1996].+--+-- This is the method used by most statistical software, such as R, -- Mathematica, SPSS, and S.-continuousBy :: ContParam       -- ^ Parameters /a/ and /b/.-             -> Int             -- ^ /k/, the desired quantile.-             -> Int             -- ^ /q/, the number of quantiles.-             -> Sample          -- ^ /x/, the sample data.-             -> Double-continuousBy (ContParam a b) k q x =-    assert (q >= 2) .-    assert (k >= 0) .-    assert (k <= q) .-    assert (allU (not . isNaN) x) $-    (1-h) * item (j-1) + h * item j+++-- | Parameters /α/ and /β/ to the 'continuousBy' function. Exact+--   meaning of parameters is described in [Hyndman1996] in section+--   \"Piecewise linear functions\"+data ContParam = ContParam {-# UNPACK #-} !Double {-# UNPACK #-} !Double+  deriving (Show,Eq,Ord,Data,Typeable,Generic)++-- | We use 's' as default value which is same as R's default.+instance Default ContParam where+  def = s++instance Binary   ContParam+instance ToJSON   ContParam+instance FromJSON ContParam++-- | O(/n/·log /n/). Estimate the /k/th /q/-quantile of a sample /x/,+--   using the continuous sample method with the given parameters.+--+--   The following properties should hold, otherwise an error will be thrown.+--+--     * input sample must be nonempty+--+--     * the input does not contain @NaN@+--+--     * 0 ≤ k ≤ q+quantile :: G.Vector v Double+         => ContParam  -- ^ Parameters /α/ and /β/.+         -> Int        -- ^ /k/, the desired quantile.+         -> Int        -- ^ /q/, the number of quantiles.+         -> v Double   -- ^ /x/, the sample data.+         -> Double+quantile param q nQ xs+  | nQ < 2         = modErr "continuousBy" "At least 2 quantiles is needed"+  | badQ nQ q      = modErr "continuousBy" "Wrong quantile number"+  | G.any isNaN xs = modErr "continuousBy" "Sample contains NaNs"+  | otherwise      = estimateQuantile sortedXs pk   where-    j               = floor (t + eps)-    t               = a + p * (fromIntegral n + 1 - a - b)-    p               = fromIntegral k / fromIntegral q-    h | abs r < eps = 0-      | otherwise   = r-      where r       = t - fromIntegral j-    eps             = m_epsilon * 4-    n               = lengthU x-    item            = indexU sx . bracket-    sx              = partialSort (bracket j + 1) x-    bracket m       = min (max m 0) (n - 1)-{-# INLINE continuousBy #-}+    pk       = toPk param n q nQ+    sortedXs = psort xs $ floor pk + 1+    n        = G.length xs+{-# INLINABLE quantile #-}+{-# SPECIALIZE+    quantile :: ContParam -> Int -> Int -> U.Vector Double -> Double #-}+{-# SPECIALIZE+    quantile :: ContParam -> Int -> Int -> V.Vector Double -> Double #-}+{-# SPECIALIZE+    quantile :: ContParam -> Int -> Int -> S.Vector Double -> Double #-} --- | O(/n/ log /n/). Estimate the range between /q/-quantiles 1 and--- /q/-1 of a sample /x/, using the continuous sample method with the--- given parameters.+-- | O(/k·n/·log /n/). Estimate set of the /k/th /q/-quantile of a+--   sample /x/, using the continuous sample method with the given+--   parameters. This is faster than calling quantile repeatedly since+--   sample should be sorted only once ----- For instance, the interquartile range (IQR) can be estimated as--- follows:+--   The following properties should hold, otherwise an error will be thrown. ----- > midspread medianUnbiased 4 (toU [1,1,2,2,3])--- > ==> 1.333333-midspread :: ContParam       -- ^ Parameters /a/ and /b/.-          -> Int             -- ^ /q/, the number of quantiles.-          -> Sample          -- ^ /x/, the sample data.-          -> Double-midspread (ContParam a b) k x =-    assert (allU (not . isNaN) x) .-    assert (k > 0) $-    quantile (1-frac) - quantile frac+--     * input sample must be nonempty+--+--     * the input does not contain @NaN@+--+--     * for every k in set of quantiles 0 ≤ k ≤ q+quantiles :: (G.Vector v Double, F.Foldable f, Functor f)+  => ContParam+  -> f Int+  -> Int+  -> v Double+  -> f Double+quantiles param qs nQ xs+  | nQ < 2             = modErr "quantiles" "At least 2 quantiles is needed"+  | F.any (badQ nQ) qs = modErr "quantiles" "Wrong quantile number"+  | G.any isNaN xs     = modErr "quantiles" "Sample contains NaNs"+  -- Doesn't matter what we put into empty container+  | null qs            = 0 <$ qs+  | otherwise          = fmap (estimateQuantile sortedXs) ks'   where-    quantile i        = (1-h i) * item (j i-1) + h i * item (j i)-    j i               = floor (t i + eps) :: Int-    t i               = a + i * (fromIntegral n + 1 - a - b)-    h i | abs r < eps = 0-        | otherwise   = r-        where r       = t i - fromIntegral (j i)-    eps               = m_epsilon * 4-    n                 = lengthU x-    item              = indexU sx . bracket-    sx                = partialSort (bracket (j (1-frac)) + 1) x-    bracket m         = min (max m 0) (n - 1)-    frac              = 1 / fromIntegral k-{-# INLINE midspread #-}+    ks'      = fmap (\q -> toPk param n q nQ) qs+    sortedXs = psort xs $ floor (F.maximum ks') + 1+    n        = G.length xs+{-# INLINABLE quantiles #-}+{-# SPECIALIZE quantiles+      :: (Functor f, F.Foldable f) => ContParam -> f Int -> Int -> V.Vector Double -> f Double #-}+{-# SPECIALIZE quantiles+      :: (Functor f, F.Foldable f) => ContParam -> f Int -> Int -> U.Vector Double -> f Double #-}+{-# SPECIALIZE quantiles+      :: (Functor f, F.Foldable f) => ContParam -> f Int -> Int -> S.Vector Double -> f Double #-} --- | California Department of Public Works definition, /a/=0, /b/=1.+-- | O(/k·n/·log /n/). Same as quantiles but uses 'G.Vector' container+--   instead of 'Foldable' one.+quantilesVec :: (G.Vector v Double, G.Vector v Int)+  => ContParam+  -> v Int+  -> Int+  -> v Double+  -> v Double+quantilesVec param qs nQ xs+  | nQ < 2             = modErr "quantilesVec" "At least 2 quantiles is needed"+  | G.any (badQ nQ) qs = modErr "quantilesVec" "Wrong quantile number"+  | G.any isNaN xs     = modErr "quantilesVec" "Sample contains NaNs"+  | G.null qs          = G.empty+  | otherwise          = G.map (estimateQuantile sortedXs) ks'+  where+    ks'      = G.map (\q -> toPk param n q nQ) qs+    sortedXs = psort xs $ floor (G.maximum ks') + 1+    n        = G.length xs+{-# INLINABLE quantilesVec #-}+{-# SPECIALIZE quantilesVec+      :: ContParam -> V.Vector Int -> Int -> V.Vector Double -> V.Vector Double #-}+{-# SPECIALIZE quantilesVec+      :: ContParam -> U.Vector Int -> Int -> U.Vector Double -> U.Vector Double #-}+{-# SPECIALIZE quantilesVec+      :: ContParam -> S.Vector Int -> Int -> S.Vector Double -> S.Vector Double #-}+++-- Returns True if quantile number is out of range+badQ :: Int -> Int -> Bool+badQ nQ q = q < 0 || q > nQ++-- Obtain k from equation for p_k [Hyndman1996] p.363.  Note that+-- equation defines p_k for integer k but we calculate it as real+-- value and will use fractional part for linear interpolation. This+-- is correct since equation is linear.+toPk+  :: ContParam+  -> Int        -- ^ /n/ number of elements+  -> Int        -- ^ /k/, the desired quantile.+  -> Int        -- ^ /q/, the number of quantiles.+  -> Double+toPk (ContParam a b) (fromIntegral -> n) q nQ+  = a + p * (n + 1 - a - b)+  where+    p = fromIntegral q / fromIntegral nQ++-- Estimate quantile for given k (including fractional part)+estimateQuantile :: G.Vector v Double => v Double -> Double -> Double+{-# INLINE estimateQuantile #-}+estimateQuantile sortedXs k'+  = (1-g) * item (k-1) + g * item k+  where+    (k,g) = properFraction k'+    item  = (sortedXs !) . clamp+    --+    clamp = max 0 . min (n - 1)+    n     = G.length sortedXs++psort :: G.Vector v Double => v Double -> Int -> v Double+psort xs k = partialSort (max 0 $ min (G.length xs - 1) k) xs+{-# INLINE psort #-}+++-- | California Department of Public Works definition, /α/=0, /β/=1. -- Gives a linear interpolation of the empirical CDF.  This -- corresponds to method 4 in R and Mathematica. cadpw :: ContParam cadpw = ContParam 0 1-{-# INLINE cadpw #-} --- | Hazen's definition, /a/=0.5, /b/=0.5.  This is claimed to be+-- | Hazen's definition, /α/=0.5, /β/=0.5.  This is claimed to be -- popular among hydrologists.  This corresponds to method 5 in R and -- Mathematica. hazen :: ContParam hazen = ContParam 0.5 0.5-{-# INLINE hazen #-} --- | Definition used by the SPSS statistics application, with /a/=0,--- /b/=0 (also known as Weibull's definition).  This corresponds to+-- | Definition used by the SPSS statistics application, with /α/=0,+-- /β/=0 (also known as Weibull's definition).  This corresponds to -- method 6 in R and Mathematica. spss :: ContParam spss = ContParam 0 0-{-# INLINE spss #-} --- | Definition used by the S statistics application, with /a/=1,--- /b/=1.  The interpolation points divide the sample range into @n-1@--- intervals.  This corresponds to method 7 in R and Mathematica.+-- | Definition used by the S statistics application, with /α/=1,+-- /β/=1.  The interpolation points divide the sample range into @n-1@+-- intervals.  This corresponds to method 7 in R and Mathematica and+-- is default in R. s :: ContParam s = ContParam 1 1-{-# INLINE s #-} --- | Median unbiased definition, /a/=1\/3, /b/=1\/3. The resulting+-- | Median unbiased definition, /α/=1\/3, /β/=1\/3. The resulting -- quantile estimates are approximately median unbiased regardless of -- the distribution of /x/.  This corresponds to method 8 in R and -- Mathematica. medianUnbiased :: ContParam medianUnbiased = ContParam third third     where third = 1/3-{-# INLINE medianUnbiased #-} --- | Normal unbiased definition, /a/=3\/8, /b/=3\/8.  An approximately+-- | Normal unbiased definition, /α/=3\/8, /β/=3\/8.  An approximately -- unbiased estimate if the empirical distribution approximates the -- normal distribution.  This corresponds to method 9 in R and -- Mathematica. normalUnbiased :: ContParam normalUnbiased = ContParam ta ta     where ta = 3/8-{-# INLINE normalUnbiased #-} +modErr :: String -> String -> a+modErr f err = error $ "Statistics.Quantile." ++ f ++ ": " ++ err+++----------------------------------------------------------------+-- Specializations+----------------------------------------------------------------++-- | O(/n/·log /n/) Estimate median of sample+median :: G.Vector v Double+       => ContParam  -- ^ Parameters /α/ and /β/.+       -> v Double   -- ^ /x/, the sample data.+       -> Double+{-# INLINE median #-}+median p = quantile p 1 2++-- | O(/n/·log /n/). Estimate the range between /q/-quantiles 1 and+-- /q/-1 of a sample /x/, using the continuous sample method with the+-- given parameters.+--+-- For instance, the interquartile range (IQR) can be estimated as+-- follows:+--+-- > midspread medianUnbiased 4 (U.fromList [1,1,2,2,3])+-- > ==> 1.333333+midspread :: G.Vector v Double =>+             ContParam  -- ^ Parameters /α/ and /β/.+          -> Int        -- ^ /q/, the number of quantiles.+          -> v Double   -- ^ /x/, the sample data.+          -> Double+midspread param k x+  | G.any isNaN x = modErr "midspread" "Sample contains NaNs"+  | k <= 0        = modErr "midspread" "Nonpositive number of quantiles"+  | otherwise     = let Pair x1 x2 = quantiles param (Pair 1 (k-1)) k x+                    in  x2 - x1+{-# INLINABLE  midspread #-}+{-# SPECIALIZE midspread :: ContParam -> Int -> U.Vector Double -> Double #-}+{-# SPECIALIZE midspread :: ContParam -> Int -> V.Vector Double -> Double #-}+{-# SPECIALIZE midspread :: ContParam -> Int -> S.Vector Double -> Double #-}++data Pair a = Pair !a !a+  deriving (Functor, F.Foldable)+++-- | O(/n/·log /n/). Estimate the median absolute deviation (MAD) of a+--   sample /x/ using 'continuousBy'. It's robust estimate of+--   variability in sample and defined as:+--+--   \[+--   MAD = \operatorname{median}(| X_i - \operatorname{median}(X) |)+--   \]+mad :: G.Vector v Double+    => ContParam  -- ^ Parameters /α/ and /β/.+    -> v Double   -- ^ /x/, the sample data.+    -> Double+mad p xs+  = median p $ G.map (abs . subtract med) xs+  where+    med = median p xs+{-# INLINABLE  mad #-}+{-# SPECIALIZE mad :: ContParam -> U.Vector Double -> Double #-}+{-# SPECIALIZE mad :: ContParam -> V.Vector Double -> Double #-}+{-# SPECIALIZE mad :: ContParam -> S.Vector Double -> Double #-}+++----------------------------------------------------------------+-- Deprecated+----------------------------------------------------------------++continuousBy :: G.Vector v Double =>+                ContParam  -- ^ Parameters /α/ and /β/.+             -> Int        -- ^ /k/, the desired quantile.+             -> Int        -- ^ /q/, the number of quantiles.+             -> v Double   -- ^ /x/, the sample data.+             -> Double+continuousBy = quantile+{-# DEPRECATED continuousBy "Use quantile instead" #-}+ -- $references -- -- * Weisstein, E.W. Quantile. /MathWorld/. --   <http://mathworld.wolfram.com/Quantile.html> ----- * Hyndman, R.J.; Fan, Y. (1996) Sample quantiles in statistical+-- * [Hyndman1996] Hyndman, R.J.; Fan, Y. (1996) Sample quantiles in statistical --   packages. /American Statistician/ --   50(4):361&#8211;365. <http://www.jstor.org/stable/2684934>
− Statistics/RandomVariate.hs 
@@ -1,6 +0,0 @@-module Statistics.RandomVariate-    (-      module System.Random.MWC-    ) where--import System.Random.MWC
+ Statistics/Regression.hs view
@@ -0,0 +1,205 @@+-- |+-- Module    : Statistics.Regression+-- Copyright : 2014 Bryan O'Sullivan+-- License   : BSD3+--+-- Functions for regression analysis.++module Statistics.Regression+    (+      olsRegress+    , ols+    , rSquare+    , bootstrapRegress+    ) where++import Control.Concurrent.Async (forConcurrently)+import Control.DeepSeq (rnf)+import Control.Monad (when)+import Data.List (nub)+import GHC.Conc (getNumCapabilities)+import Prelude hiding (pred, sum)+import Statistics.Function as F+import Statistics.Matrix hiding (map)+import Statistics.Matrix.Algorithms (qr)+import Statistics.Resampling (splitGen)+import Statistics.Types      (Estimate(..),ConfInt,CL,estimateFromInterval,significanceLevel)+import Statistics.Sample (mean)+import Statistics.Sample.Internal (sum)+import System.Random.MWC (GenIO, uniformR)+import qualified Data.Vector as V+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Unboxed.Mutable as M++-- | Perform an ordinary least-squares regression on a set of+-- predictors, and calculate the goodness-of-fit of the regression.+--+-- The returned pair consists of:+--+-- * A vector of regression coefficients.  This vector has /one more/+--   element than the list of predictors; the last element is the+--   /y/-intercept value.+--+-- * /R²/, the coefficient of determination (see 'rSquare' for+--   details).+--+-- >>> import qualified Data.Vector.Unboxed as VU+-- >>> :{+--  olsRegress [ VU.fromList [0,1,2,3]+--             ] (VU.fromList [1000, 1001, 1002, 1003])+-- :}+-- ([1.0000000000000218,999.9999999999999],1.0)+olsRegress :: [Vector]+              -- ^ Non-empty list of predictor vectors.  Must all have+              -- the same length.  These will become the columns of+              -- the matrix /A/ solved by 'ols'.+           -> Vector+              -- ^ Responder vector.  Must have the same length as the+              -- predictor vectors.+           -> (Vector, Double)+olsRegress preds@(_:_) resps+  | any (/=n) ls        = error $ "predictor vector length mismatch " +++                                  show lss+  | G.length resps /= n = error $ "responder/predictor length mismatch " +++                                  show (G.length resps, n)+  | otherwise           = (coeffs, rSquare mxpreds resps coeffs)+  where+    coeffs    = ols mxpreds resps+    mxpreds   = transpose .+                fromVector (length lss + 1) n .+                G.concat $ preds ++ [G.replicate n 1]+    lss@(n:ls) = map G.length preds+olsRegress _ _ = error "no predictors given"++-- | Compute the ordinary least-squares solution to overdetermined+--   linear system \(Ax = b\). In other words it finds+--+--   \[ \operatorname{argmin}|Ax-b|^2 \].+--+--   All columns of \(A\) must be linearly independent. It's not+--   checked function will return nonsensical result if resulting+--   linear system is poorly conditioned.+--+-- >>> import qualified Data.Vector.Unboxed as VU+-- >>> :{+--  ols (fromColumns [ VU.fromList [0,1,2,3]+--                   , VU.fromList [1,1,1,1]+--                   ]) (VU.fromList [1000, 1001, 1002, 1003])+-- :}+-- [1.0000000000000218,999.9999999999999]+--+-- >>> :{+--  ols (fromColumns [ VU.fromList [0,1,2,3]+--                   , VU.fromList [4,2,1,1]+--                   , VU.fromList [1,1,1,1]+--                   ]) (VU.fromList [1000, 1001, 1002, 1003])+-- :}+-- [1.0000000000005393,4.2290644612446807e-13,999.9999999999983]+ols :: Matrix     -- ^ /A/ has at least as many rows as columns.+    -> Vector     -- ^ /b/ has the same length as columns in /A/.+    -> Vector+ols a b+  | rs < cs   = error $ "fewer rows than columns " ++ show d+  | otherwise = solve r (transpose q `multiplyV` b)+  where+    d@(rs,cs) = dimension a+    (q,r)     = qr a++-- | Solve the equation /R x = b/.+solve :: Matrix     -- ^ /R/ is an upper-triangular square matrix.+      -> Vector     -- ^ /b/ is of the same length as rows\/columns in /R/.+      -> Vector+solve r b+  | n /= l    = error $ "row/vector mismatch " ++ show (n,l)+  | otherwise = U.create $ do+  s <- U.thaw b+  rfor n 0 $ \i -> do+    si <- (/ unsafeIndex r i i) <$> M.unsafeRead s i+    M.unsafeWrite s i si+    F.for 0 i $ \j -> F.unsafeModify s j $ subtract (unsafeIndex r j i * si)+  return s+  where n = rows r+        l = U.length b++-- | Compute /R²/, the coefficient of determination that+-- indicates goodness-of-fit of a regression.+--+-- This value will be 1 if the predictors fit perfectly, dropping to 0+-- if they have no explanatory power.+rSquare :: Matrix               -- ^ Predictors (regressors).+        -> Vector               -- ^ Responders.+        -> Vector               -- ^ Regression coefficients.+        -> Double+rSquare pred resp coeff+  -- Data has zero variance. If fit is perfect we set R² to 1 else to+  -- 0. This is not perfect heuristic. Fit residuals may be nonzero+  -- due to rounding.+  | t == 0             = if r == 0 then 1 else 0+  -- If fit residuals are worse than average we simply set R² to 0+  | r2 >= 0 && r2 <= 1 = r2+  | otherwise          = 0+  where+    r2  = 1 - r / t+    r   = sum $ flip U.imap resp  $ \i x -> square (x - p i)+    t   = sum $ flip U.map  resp  $ \x   -> square (x - mean resp)+    p i = sum $ flip U.imap coeff $ \j x -> x * unsafeIndex pred i j++-- | Bootstrap a regression function.  Returns both the results of the+-- regression and the requested confidence interval values.+bootstrapRegress+  :: GenIO+  -> Int         -- ^ Number of resamples to compute.+  -> CL Double   -- ^ Confidence level.+  -> ([Vector] -> Vector -> (Vector, Double))+     -- ^ Regression function.+  -> [Vector]    -- ^ Predictor vectors.+  -> Vector      -- ^ Responder vector.+  -> IO (V.Vector (Estimate ConfInt Double), Estimate ConfInt Double)+bootstrapRegress gen0 numResamples cl rgrss preds0 resp0+  | numResamples < 1   = error $ "bootstrapRegress: number of resamples " +++                                 "must be positive"+  | otherwise = do++  -- some error checks so that we do not run into vector index out of bounds.+  case nub (map U.length preds0) of+    [] -> error "bootstrapRegress: predictor vectors must not be empty"+    [plen] -> do+        let rlen = U.length resp0+        when (plen /= rlen) $+            error $ "bootstrapRegress: responder vector length ["+                ++ show rlen+                ++ "] must be the same as predictor vectors' length ["+                ++ show plen ++ "]"+    xs -> error $ "bootstrapRegress: all predictor vectors must be of the same \+        \length, lengths provided are: " ++ show xs++  caps <- getNumCapabilities+  gens <- splitGen caps gen0+  vs <- forConcurrently (zip gens (balance caps numResamples)) $ \(gen,count) -> do+      v <- V.replicateM count $ do+           let n = U.length resp0+           ixs <- U.replicateM n $ uniformR (0,n-1) gen+           let resp  = U.backpermute resp0 ixs+               preds = map (flip U.backpermute ixs) preds0+           return $ rgrss preds resp+      rnf v `seq` return v+  let (coeffsv, r2v) = G.unzip (V.concat vs)+  let coeffs  = flip G.imap (G.convert coeffss) $ \i x ->+                est x . U.generate numResamples $ \k -> (coeffsv G.! k) G.! i+      r2      = est r2s (G.convert r2v)+      (coeffss, r2s) = rgrss preds0 resp0+      est s v = estimateFromInterval s (w G.! lo, w G.! hi) cl+        where w  = F.sort v+              bounded i = min (U.length w - 1) (max 0 i)+              lo = bounded $ round c+              hi = bounded $ truncate (n - c)+              n  = fromIntegral numResamples+              c  = n * (significanceLevel cl / 2)+  return (coeffs, r2)++-- | Balance units of work across workers.+balance :: Int -> Int -> [Int]+balance numSlices numItems = zipWith (+) (replicate numSlices q)+                                         (replicate r 1 ++ repeat 0)+ where (q,r) = numItems `quotRem` numSlices
Statistics/Resampling.hs view
@@ -1,6 +1,15 @@+{-# LANGUAGE BangPatterns       #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFoldable     #-}+{-# LANGUAGE DeriveFunctor      #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE DeriveTraversable  #-}+{-# LANGUAGE FlexibleContexts   #-}+{-# LANGUAGE TypeFamilies       #-}+ -- | -- Module    : Statistics.Resampling--- Copyright : (c) 2009 Bryan O'Sullivan+-- Copyright : (c) 2009, 2010 Bryan O'Sullivan -- License   : BSD3 -- -- Maintainer  : bos@serpentine.com@@ -10,55 +19,258 @@ -- Resampling statistics.  module Statistics.Resampling-    (+    ( -- * Data types       Resample(..)-    , jackknife+    , Bootstrap(..)+    , Estimator(..)+    , estimate+      -- * Resampling+    , resampleST     , resample+    , resampleVector+      -- * Jackknife+    , jackknife+    , jackknifeMean+    , jackknifeVariance+    , jackknifeVarianceUnb+    , jackknifeStdDev+      -- * Helper functions+    , splitGen     ) where -import Control.Monad (forM_)-import Control.Monad.ST (ST)-import Data.Array.Vector-import Data.Array.Vector.Algorithms.Intro (sort)-import Statistics.Function (createU, indices)-import System.Random.MWC (Gen, uniform)-import Statistics.Types (Estimator, Sample)+import Data.Aeson (FromJSON, ToJSON)+import Control.Concurrent.Async (forConcurrently_)+import Control.Monad (forM_, forM, replicateM, liftM2)+import Control.Monad.Primitive (PrimMonad(..))+import Data.Binary (Binary(..))+import Data.Data (Data, Typeable)+import Data.Vector.Algorithms.Intro (sort)+import Data.Vector.Binary ()+import Data.Vector.Generic (unsafeFreeze,unsafeThaw)+import Data.Word (Word32)+import qualified Data.Foldable as T+import qualified Data.Traversable as T+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Unboxed.Mutable as MU +import GHC.Conc (numCapabilities)+import GHC.Generics (Generic)+import Numeric.Sum (Summation(..), kbn)+import Statistics.Function (indices)+import Statistics.Sample (mean, stdDev, variance, varianceUnbiased)+import Statistics.Types (Sample)+import System.Random.MWC (Gen, GenIO, initialize, uniformR, uniformVector)+++----------------------------------------------------------------+-- Data types+----------------------------------------------------------------+ -- | A resample drawn randomly, with replacement, from a set of data -- points.  Distinct from a normal array to make it harder for your -- humble author's brain to go wrong. newtype Resample = Resample {-      fromResample :: UArr Double-    } deriving (Eq, Show)+      fromResample :: U.Vector Double+    } deriving (Eq, Read, Show, Typeable, Data, Generic) --- | Resample a data set repeatedly, with replacement, computing each--- estimate over the resampled data.-resample :: Gen s -> [Estimator] -> Int -> Sample -> ST s [Resample]+instance FromJSON Resample+instance ToJSON Resample++instance Binary Resample where+    put = put . fromResample+    get = fmap Resample get++data Bootstrap v a = Bootstrap+  { fullSample :: !a+  , resamples  :: v a+  }+  deriving (Eq, Read, Show , Generic, Functor, T.Foldable, T.Traversable+           , Typeable, Data+           )++instance (Binary a,   Binary   (v a)) => Binary   (Bootstrap v a) where+  get = liftM2 Bootstrap get get+  put (Bootstrap fs rs) = put fs >> put rs+instance (FromJSON a, FromJSON (v a)) => FromJSON (Bootstrap v a)+instance (ToJSON a,   ToJSON   (v a)) => ToJSON   (Bootstrap v a)++++-- | An estimator of a property of a sample, such as its 'mean'.+--+-- The use of an algebraic data type here allows functions such as+-- 'jackknife' and 'bootstrapBCA' to use more efficient algorithms+-- when possible.+data Estimator = Mean+               | Variance+               | VarianceUnbiased+               | StdDev+               | Function (Sample -> Double)++-- | Run an 'Estimator' over a sample.+estimate :: Estimator -> Sample -> Double+estimate Mean             = mean+estimate Variance         = variance+estimate VarianceUnbiased = varianceUnbiased+estimate StdDev           = stdDev+estimate (Function est) = est+++----------------------------------------------------------------+-- Resampling+----------------------------------------------------------------++-- | Single threaded and deterministic version of resample.+resampleST :: PrimMonad m+           => Gen (PrimState m)+           -> [Estimator]         -- ^ Estimation functions.+           -> Int                 -- ^ Number of resamples to compute.+           -> U.Vector Double     -- ^ Original sample.+           -> m [Bootstrap U.Vector Double]+resampleST gen ests numResamples sample = do+  -- Generate resamples+  res <- forM ests $ \e -> U.replicateM numResamples $ do+    v <- resampleVector gen sample+    return $! estimate e v+  -- Sort resamples+  resM <- mapM unsafeThaw res+  mapM_ sort resM+  resSorted <- mapM unsafeFreeze resM+  return $ zipWith Bootstrap [estimate e sample | e <- ests]+                             resSorted+++-- | /O(e*r*s)/ Resample a data set repeatedly, with replacement,+-- computing each estimate over the resampled data.+--+-- This function is expensive; it has to do work proportional to+-- /e*r*s/, where /e/ is the number of estimation functions, /r/ is+-- the number of resamples to compute, and /s/ is the number of+-- original samples.+--+-- To improve performance, this function will make use of all+-- available CPUs.  At least with GHC 7.0, parallel performance seems+-- best if the parallel garbage collector is disabled (RTS option+-- @-qg@).+resample :: GenIO+         -> [Estimator]         -- ^ Estimation functions.+         -> Int                 -- ^ Number of resamples to compute.+         -> U.Vector Double     -- ^ Original sample.+         -> IO [(Estimator, Bootstrap U.Vector Double)] resample gen ests numResamples samples = do-  results <- mapM (const (newMU numResamples)) $ ests-  loop 0 (zip ests results)+  let ixs = scanl (+) 0 $+            zipWith (+) (replicate numCapabilities q)+                        (replicate r 1 ++ repeat 0)+          where (q,r) = numResamples `quotRem` numCapabilities+  results <- mapM (const (MU.new numResamples)) ests+  gens <- splitGen numCapabilities gen+  forConcurrently_ (zip3 ixs (tail ixs) gens) $ \ (start,!end,gen') -> do+    -- on GHCJS it doesn't make sense to do any forking.+    -- JavaScript runtime has only single capability.+      let loop k ers | k >= end = return ()+                     | otherwise = do+            re <- resampleVector gen' samples+            forM_ ers $ \(est,arr) ->+                MU.write arr k . est $ re+            loop (k+1) ers+      loop start (zip ests' results)   mapM_ sort results-  mapM (fmap Resample . unsafeFreezeAllMU) results+  -- Build resamples+  res <- mapM unsafeFreeze results+  return $ zip ests+         $ zipWith Bootstrap [estimate e samples | e <- ests]+                             res  where-  loop k ers | k >= numResamples = return ()-             | otherwise = do-    re <- createU n $ \_ -> do-            r <- uniform gen-            return (indexU samples (abs r `mod` n))-    forM_ ers $ \(est,arr) ->-        writeMU arr k . est $ re-    loop (k+1) ers-  n = lengthU samples+  ests' = map estimate ests --- | Compute a statistical estimate repeatedly over a sample, each--- time omitting a successive element.-jackknife :: Estimator -> Sample -> UArr Double-jackknife est sample = mapU f . indices $ sample-    where f i = est (dropAt i sample)-{-# INLINE jackknife #-}+-- | Create vector using resamples+resampleVector :: (PrimMonad m, G.Vector v a)+               => Gen (PrimState m) -> v a -> m (v a)+resampleVector gen v+  = G.replicateM n $ do i <- uniformR (0,n-1) gen+                        return $! G.unsafeIndex v i+  where+    n = G.length v ++----------------------------------------------------------------+-- Jackknife+----------------------------------------------------------------++-- | /O(n) or O(n^2)/ Compute a statistical estimate repeatedly over a+-- sample, each time omitting a successive element.+jackknife :: Estimator -> Sample -> U.Vector Double+jackknife Mean sample             = jackknifeMean sample+jackknife Variance sample         = jackknifeVariance sample+jackknife VarianceUnbiased sample = jackknifeVarianceUnb sample+jackknife StdDev sample = jackknifeStdDev sample+jackknife (Function est) sample+  | G.length sample == 1 = singletonErr "jackknife"+  | otherwise            = U.map f . indices $ sample+  where f i = est (dropAt i sample)++-- | /O(n)/ Compute the jackknife mean of a sample.+jackknifeMean :: Sample -> U.Vector Double+jackknifeMean samp+  | len == 1  = singletonErr "jackknifeMean"+  | otherwise = G.map (/l) $ G.zipWith (+) (pfxSumL samp) (pfxSumR samp)+  where+    l   = fromIntegral (len - 1)+    len = G.length samp++-- | /O(n)/ Compute the jackknife variance of a sample with a+-- correction factor @c@, so we can get either the regular or+-- \"unbiased\" variance.+jackknifeVariance_ :: Double -> Sample -> U.Vector Double+jackknifeVariance_ c samp+  | len == 1  = singletonErr "jackknifeVariance"+  | otherwise = G.zipWith4 go als ars bls brs+  where+    als = pfxSumL . G.map goa $ samp+    ars = pfxSumR . G.map goa $ samp+    goa x = v * v where v = x - m+    bls = pfxSumL . G.map (subtract m) $ samp+    brs = pfxSumR . G.map (subtract m) $ samp+    m = mean samp+    n = fromIntegral len+    go al ar bl br = (al + ar - (b * b) / q) / (q - c)+      where b = bl + br+            q = n - 1+    len = G.length samp++-- | /O(n)/ Compute the unbiased jackknife variance of a sample.+jackknifeVarianceUnb :: Sample -> U.Vector Double+jackknifeVarianceUnb samp+  | G.length samp == 2  = singletonErr "jackknifeVariance"+  | otherwise           = jackknifeVariance_ 1 samp++-- | /O(n)/ Compute the jackknife variance of a sample.+jackknifeVariance :: Sample -> U.Vector Double+jackknifeVariance = jackknifeVariance_ 0++-- | /O(n)/ Compute the jackknife standard deviation of a sample.+jackknifeStdDev :: Sample -> U.Vector Double+jackknifeStdDev = G.map sqrt . jackknifeVarianceUnb++pfxSumL :: U.Vector Double -> U.Vector Double+pfxSumL = G.map kbn . G.scanl add zero++pfxSumR :: U.Vector Double -> U.Vector Double+pfxSumR = G.tail . G.map kbn . G.scanr (flip add) zero+ -- | Drop the /k/th element of a vector.-dropAt :: UA e => Int -> UArr e -> UArr e-dropAt n = mapU sndT . filterU notN . indexedU-    where notN (i :*: _) = i /= n-          sndT (_ :*: k) = k+dropAt :: U.Unbox e => Int -> U.Vector e -> U.Vector e+dropAt n v = U.slice 0 n v U.++ U.slice (n+1) (U.length v - n - 1) v++singletonErr :: String -> a+singletonErr func = error $+                    "Statistics.Resampling." ++ func ++ ": not enough elements in sample"++-- | Split a generator into several that can run independently.+splitGen :: Int -> GenIO -> IO [GenIO]+splitGen n gen+  | n <= 0    = return []+  | otherwise =+  fmap (gen:) . replicateM (n-1) $+  initialize =<< (uniformVector gen 256 :: IO (U.Vector Word32))
Statistics/Resampling/Bootstrap.hs view
@@ -1,6 +1,6 @@ -- | -- Module    : Statistics.Resampling.Bootstrap--- Copyright : (c) 2009 Bryan O'Sullivan+-- Copyright : (c) 2009, 2011 Bryan O'Sullivan -- License   : BSD3 -- -- Maintainer  : bos@serpentine.com@@ -10,84 +10,97 @@ -- The bootstrap method for statistical inference.  module Statistics.Resampling.Bootstrap-    (-      Estimate(..)-    , bootstrapBCA+    ( bootstrapBCA+    , basicBootstrap     -- * References     -- $references     ) where -import Control.Exception (assert)-import Data.Array.Vector (foldlU, filterU, indexU, lengthU)-import Statistics.Distribution.Normal+import           Data.Vector.Generic ((!))+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Generic as G+ import Statistics.Distribution (cumulative, quantile)-import Statistics.Resampling (Resample(..), jackknife)+import Statistics.Distribution.Normal+import Statistics.Resampling (Bootstrap(..), jackknife) import Statistics.Sample (mean)-import Statistics.Types (Estimator, Sample)+import Statistics.Types (Sample, CL, Estimate, ConfInt, estimateFromInterval,+                         estimateFromErr, CL, significanceLevel)+import Statistics.Function (gsort) --- | A point and interval estimate computed via an 'Estimator'.-data Estimate = Estimate {-      estPoint           :: {-# UNPACK #-} !Double-    -- ^ Point estimate.-    , estLowerBound      :: {-# UNPACK #-} !Double-    -- ^ Lower bound of the estimate interval (i.e. the lower bound of-    -- the confidence interval).-    , estUpperBound      :: {-# UNPACK #-} !Double-    -- ^ Upper bound of the estimate interval (i.e. the upper bound of-    -- the confidence interval).-    , estConfidenceLevel :: {-# UNPACK #-} !Double-    -- ^ Confidence level of the confidence intervals.-    } deriving (Eq, Show)+import qualified Statistics.Resampling as R -estimate :: Double -> Double -> Double -> Double -> Estimate-estimate pt lb ub cl =-    assert (lb <= ub) .-    assert (cl > 0 && cl < 1) $-    Estimate { estPoint = pt-             , estLowerBound = lb-             , estUpperBound = ub-             , estConfidenceLevel = cl-             }+import Control.Parallel.Strategies (parMap, rdeepseq)  data T = {-# UNPACK #-} !Double :< {-# UNPACK #-} !Double infixl 2 :<  -- | Bias-corrected accelerated (BCA) bootstrap. This adjusts for both--- bias and skewness in the resampled distribution.-bootstrapBCA :: Double          -- ^ Confidence level-             -> Sample          -- ^ Sample data-             -> [Estimator]     -- ^ Estimators-             -> [Resample]      -- ^ Resampled data-             -> [Estimate]-bootstrapBCA confidenceLevel sample =-    assert (confidenceLevel > 0 && confidenceLevel < 1)-    zipWith e+--   bias and skewness in the resampled distribution.+--+--   BCA algorithm is described in ch. 5 of Davison, Hinkley "Confidence+--   intervals" in section 5.3 "Percentile method"+bootstrapBCA+  :: CL Double       -- ^ Confidence level+  -> Sample          -- ^ Full data sample+  -> [(R.Estimator, Bootstrap U.Vector Double)]+  -- ^ Estimates obtained from resampled data and estimator used for+  --   this.+  -> [Estimate ConfInt Double]+bootstrapBCA confidenceLevel sample resampledData+  = parMap rdeepseq e resampledData   where-    e est (Resample resample)-      | lengthU sample == 1 = estimate pt pt pt confidenceLevel-      | otherwise = -          estimate pt (indexU resample lo) (indexU resample hi) confidenceLevel+    e (est, Bootstrap pt resample)+      | U.length sample == 1 || isInfinite bias =+          estimateFromErr      pt (0,0) confidenceLevel+      | otherwise =+          estimateFromInterval pt (resample ! lo, resample ! hi) confidenceLevel       where-        pt    = est sample-        lo    = max (cumn a1) 0+        -- Quantile estimates for given CL+        lo    = min (max (cumn a1) 0) (ni - 1)           where a1 = bias + b1 / (1 - accel * b1)                 b1 = bias + z1-        hi    = min (cumn a2) (ni - 1)+        hi    = max (min (cumn a2) (ni - 1)) 0           where a2 = bias + b2 / (1 - accel * b2)                 b2 = bias - z1-        z1    = quantile standard ((1 - confidenceLevel) / 2)+        -- Number of resamples+        ni    = U.length resample+        n     = fromIntegral ni+        -- Corrections+        z1    = quantile standard (significanceLevel confidenceLevel / 2)         cumn  = round . (*n) . cumulative standard         bias  = quantile standard (probN / n)-          where probN = fromIntegral . lengthU . filterU (<pt) $ resample-        ni    = lengthU resample-        n     = fromIntegral ni+          where probN = fromIntegral . U.length . U.filter (<pt) $ resample         accel = sumCubes / (6 * (sumSquares ** 1.5))-          where (sumSquares :< sumCubes) = foldlU f (0 :< 0) jack+          where (sumSquares :< sumCubes) = U.foldl' f (0 :< 0) jack                 f (s :< c) j = s + d2 :< c + d2 * d                     where d  = jackMean - j                           d2 = d * d                 jackMean     = mean jack         jack  = jackknife est sample+++-- | Basic bootstrap. This method simply uses empirical quantiles for+--   confidence interval.+basicBootstrap+  :: (G.Vector v a, Ord a, Num a)+  => CL Double       -- ^ Confidence vector+  -> Bootstrap v a   -- ^ Estimate from full sample and vector of+                     --   estimates obtained from resamples+  -> Estimate ConfInt a+{-# INLINE basicBootstrap #-}+basicBootstrap cl (Bootstrap e ests)+  = estimateFromInterval e (sorted ! lo, sorted ! hi) cl+  where+    sorted = gsort ests+    n  = fromIntegral $ G.length ests+    c  = n * (significanceLevel cl / 2)+    -- FIXME: can we have better estimates of quantiles in case when p+    --        is not multiple of 1/N+    --+    -- FIXME: we could have undercoverage here+    lo = round c+    hi = truncate (n - c)  -- $references --
Statistics/Sample.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE BangPatterns #-} -- | -- Module    : Statistics.Sample -- Copyright : (c) 2008 Don Stewart, 2009 Bryan O'Sullivan@@ -15,11 +16,15 @@     (     -- * Types       Sample+    , WeightedSample     -- * Descriptive functions     , range      -- * Statistics of location+    , expectation     , mean+    , welfordMean+    , meanWeighted     , harmonicMean     , geometricMean @@ -36,7 +41,11 @@     -- $robust     , variance     , varianceUnbiased+    , meanVariance+    , meanVarianceUnb     , stdDev+    , varianceWeighted+    , stdErrMean      -- ** Single-pass functions (faster, less safe)     -- $cancellation@@ -44,45 +53,89 @@     , fastVarianceUnbiased     , fastStdDev +    -- * Joint distributions+    , covariance+    , correlation+    , covariance2+    , correlation2+    , pair     -- * References     -- $references     ) where -import Data.Array.Vector-import Statistics.Function (minMax)-import Statistics.Types (Sample)+import Statistics.Function (minMax,square)+import Statistics.Sample.Internal (robustSumVar, sum)+import Statistics.Types.Internal  (Sample,WeightedSample)+import qualified Data.Vector as V+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Unboxed as U+import Numeric.Sum (kbn, Summation(zero,add)) -range :: Sample -> Double+-- Operator ^ will be overridden+import Prelude hiding ((^), sum)++-- | /O(n)/ Range. The difference between the largest and smallest+-- elements of a sample.+range :: (G.Vector v Double) => v Double -> Double range s = hi - lo-    where lo :*: hi = minMax s+    where (lo , hi) = minMax s {-# INLINE range #-} --- | Arithmetic mean.  This uses Welford's algorithm to provide+-- | /O(n)/ Compute expectation of function over for sample. This is+--   simply @mean . map f@ but won't create intermediate vector.+expectation :: (G.Vector v a) => (a -> Double) -> v a -> Double+expectation f xs = kbn (G.foldl' (\s -> add s . f) zero xs)+                 / fromIntegral (G.length xs)+{-# INLINE expectation #-}++-- | /O(n)/ Arithmetic mean.  This uses Kahan-Babuška-Neumaier+-- summation, so is more accurate than 'welfordMean' unless the input+-- values are very large. This function is not subject to stream+-- fusion.+mean :: (G.Vector v Double) => v Double -> Double+mean xs = sum xs / fromIntegral (G.length xs)+{-# SPECIALIZE mean :: U.Vector Double -> Double #-}+{-# SPECIALIZE mean :: V.Vector Double -> Double #-}++-- | /O(n)/ Arithmetic mean.  This uses Welford's algorithm to provide -- numerical stability, using a single pass over the sample data.-mean :: Sample -> Double-mean = fini . foldlU go (T 0 0)+--+-- Compared to 'mean', this loses a surprising amount of precision+-- unless the inputs are very large.+welfordMean :: (G.Vector v Double) => v Double -> Double+welfordMean = fini . G.foldl' go (T 0 0)   where     fini (T a _) = a     go (T m n) x = T m' n'         where m' = m + (x - m) / fromIntegral n'               n' = n + 1-{-# INLINE mean #-}+{-# SPECIALIZE welfordMean :: U.Vector Double -> Double #-}+{-# SPECIALIZE welfordMean :: V.Vector Double -> Double #-} --- | Harmonic mean.  This algorithm performs a single pass over the--- sample.-harmonicMean :: Sample -> Double-harmonicMean = fini . foldlU go (T 0 0)+-- | /O(n)/ Arithmetic mean for weighted sample. It uses a single-pass+-- algorithm analogous to the one used by 'welfordMean'.+meanWeighted :: (G.Vector v (Double,Double)) => v (Double,Double) -> Double+meanWeighted = fini . G.foldl' go (V 0 0)+    where+      fini (V a _) = a+      go (V m w) (x,xw) = V m' w'+          where m' | w' == 0   = 0+                   | otherwise = m + xw * (x - m) / w'+                w' = w + xw+{-# INLINE meanWeighted #-}++-- | /O(n)/ Harmonic mean.  This algorithm performs a single pass over+-- the sample.+harmonicMean :: (G.Vector v Double) => v Double -> Double+harmonicMean = fini . G.foldl' go (T 0 0)   where     fini (T b a) = fromIntegral a / b     go (T x y) n = T (x + (1/n)) (y+1) {-# INLINE harmonicMean #-} --- | Geometric mean of a sample containing no negative values.-geometricMean :: Sample -> Double-geometricMean = fini . foldlU go (T 1 0)-  where-    fini (T p n) = p ** (1 / fromIntegral n)-    go (T p n) a = T (p * a) (n + 1)+-- | /O(n)/ Geometric mean of a sample containing no negative values.+geometricMean :: (G.Vector v Double) => v Double -> Double+geometricMean = exp . expectation log {-# INLINE geometricMean #-}  -- | Compute the /k/th central moment of a sample.  The central moment@@ -93,16 +146,17 @@ -- -- For samples containing many values very close to the mean, this -- function is subject to inaccuracy due to catastrophic cancellation.-centralMoment :: Int -> Sample -> Double+centralMoment :: (G.Vector v Double) => Int -> v Double -> Double centralMoment a xs     | a < 0  = error "Statistics.Sample.centralMoment: negative input"     | a == 0 = 1     | a == 1 = 0-    | otherwise = sumU (mapU go xs) / fromIntegral (lengthU xs)+    | otherwise = expectation go xs   where     go x = (x-m) ^ a     m    = mean xs-{-# INLINE centralMoment #-}+{-# SPECIALIZE centralMoment :: Int -> U.Vector Double -> Double #-}+{-# SPECIALIZE centralMoment :: Int -> V.Vector Double -> Double #-}  -- | Compute the /k/th and /j/th central moments of a sample. --@@ -111,16 +165,19 @@ -- -- For samples containing many values very close to the mean, this -- function is subject to inaccuracy due to catastrophic cancellation.-centralMoments :: Int -> Int -> Sample -> Double :*: Double+centralMoments :: (G.Vector v Double) => Int -> Int -> v Double -> (Double, Double) centralMoments a b xs-    | a < 2 || b < 2 = centralMoment a xs :*: centralMoment b xs-    | otherwise      = fini . foldlU go (V 0 0) $ xs+    | a < 2 || b < 2 = (centralMoment a xs , centralMoment b xs)+    | otherwise      = fini . G.foldl' go (V 0 0) $ xs   where go (V i j) x = V (i + d^a) (j + d^b)             where d  = x - m-        fini (V i j) = i / n :*: j / n+        fini (V i j) = (i / n , j / n)         m            = mean xs-        n            = fromIntegral (lengthU xs)-{-# INLINE centralMoments #-}+        n            = fromIntegral (G.length xs)+{-# SPECIALIZE+    centralMoments :: Int -> Int -> U.Vector Double -> (Double, Double) #-}+{-# SPECIALIZE+    centralMoments :: Int -> Int -> V.Vector Double -> (Double, Double) #-}  -- | Compute the skewness of a sample. This is a measure of the -- asymmetry of its distribution.@@ -129,12 +186,12 @@ -- its mass is on the right of the distribution, with the tail on the -- left. ----- > skewness $ toU [1,100,101,102,103]+-- > skewness $ U.to [1,100,101,102,103] -- > ==> -1.497681449918257 -- -- A sample with positive skew is said to be /right-skewed/. ----- > skewness $ toU [1,2,3,4,100]+-- > skewness $ U.to [1,2,3,4,100] -- > ==> 1.4975367033335198 -- -- A sample's skewness is not defined if its 'variance' is zero.@@ -144,10 +201,11 @@ -- -- For samples containing many values very close to the mean, this -- function is subject to inaccuracy due to catastrophic cancellation.-skewness :: Sample -> Double+skewness :: (G.Vector v Double) => v Double -> Double skewness xs = c3 * c2 ** (-1.5)-    where c3 :*: c2 = centralMoments 3 2 xs-{-# INLINE skewness #-}+    where (c3 , c2) = centralMoments 3 2 xs+{-# SPECIALIZE skewness :: U.Vector Double -> Double #-}+{-# SPECIALIZE skewness :: V.Vector Double -> Double #-}  -- | Compute the excess kurtosis of a sample.  This is a measure of -- the \"peakedness\" of its distribution.  A high kurtosis indicates@@ -162,14 +220,15 @@ -- -- For samples containing many values very close to the mean, this -- function is subject to inaccuracy due to catastrophic cancellation.-kurtosis :: Sample -> Double+kurtosis :: (G.Vector v Double) => v Double -> Double kurtosis xs = c4 / (c2 * c2) - 3-    where c4 :*: c2 = centralMoments 4 2 xs-{-# INLINE kurtosis #-}+    where (c4 , c2) = centralMoments 4 2 xs+{-# SPECIALIZE kurtosis :: U.Vector Double -> Double #-}+{-# SPECIALIZE kurtosis :: V.Vector Double -> Double #-}  -- $variance ----- The variance&#8212;and hence the standard deviation&#8212;of a+-- The variance — and hence the standard deviation — of a -- sample of fewer than two elements are both defined to be zero.  -- $robust@@ -183,38 +242,87 @@  data V = V {-# UNPACK #-} !Double {-# UNPACK #-} !Double -robustVar :: Sample -> T-robustVar samp = fini . foldlU go (V 0 0) $ samp-  where-    go (V s c) x = V (s + d * d) (c + d)-        where d  = x - m-    fini (V s c) = T (s - (c * c) / fromIntegral n) n-    n            = lengthU samp-    m            = mean samp- -- | Maximum likelihood estimate of a sample's variance.  Also known -- as the population variance, where the denominator is /n/.-variance :: Sample -> Double-variance = fini . robustVar-  where fini (T v n)-          | n > 1     = v / fromIntegral n-          | otherwise = 0-{-# INLINE variance #-}+variance :: (G.Vector v Double) => v Double -> Double+variance samp+    | n > 1     = robustSumVar (mean samp) samp / fromIntegral n+    | otherwise = 0+    where+      n = G.length samp+{-# SPECIALIZE variance :: U.Vector Double -> Double #-}+{-# SPECIALIZE variance :: V.Vector Double -> Double #-} + -- | Unbiased estimate of a sample's variance.  Also known as the -- sample variance, where the denominator is /n/-1.-varianceUnbiased :: Sample -> Double-varianceUnbiased = fini . robustVar-  where fini (T v n)-          | n > 1     = v / fromIntegral (n-1)-          | otherwise = 0-{-# INLINE varianceUnbiased #-}+varianceUnbiased :: (G.Vector v Double) => v Double -> Double+varianceUnbiased samp+    | n > 1     = robustSumVar (mean samp) samp / fromIntegral (n-1)+    | otherwise = 0+    where+      n = G.length samp+{-# SPECIALIZE varianceUnbiased :: U.Vector Double -> Double #-}+{-# SPECIALIZE varianceUnbiased :: V.Vector Double -> Double #-} +-- | Calculate mean and maximum likelihood estimate of variance. This+-- function should be used if both mean and variance are required+-- since it will calculate mean only once.+meanVariance ::  (G.Vector v Double) => v Double -> (Double,Double)+meanVariance samp+  | n > 1     = (m, robustSumVar m samp / fromIntegral n)+  | otherwise = (m, 0)+    where+      n = G.length samp+      m = mean samp+{-# SPECIALIZE meanVariance :: U.Vector Double -> (Double,Double) #-}+{-# SPECIALIZE meanVariance :: V.Vector Double -> (Double,Double) #-}++-- | Calculate mean and unbiased estimate of variance. This+-- function should be used if both mean and variance are required+-- since it will calculate mean only once.+meanVarianceUnb :: (G.Vector v Double) => v Double -> (Double,Double)+meanVarianceUnb samp+  | n > 1     = (m, robustSumVar m samp / fromIntegral (n-1))+  | otherwise = (m, 0)+    where+      n = G.length samp+      m = mean samp+{-# SPECIALIZE meanVarianceUnb :: U.Vector Double -> (Double,Double) #-}+{-# SPECIALIZE meanVarianceUnb :: V.Vector Double -> (Double,Double) #-}+ -- | Standard deviation.  This is simply the square root of the--- maximum likelihood estimate of the variance.-stdDev :: Sample -> Double+-- unbiased estimate of the variance.+stdDev :: (G.Vector v Double) => v Double -> Double stdDev = sqrt . varianceUnbiased+{-# SPECIALIZE stdDev :: U.Vector Double -> Double #-}+{-# SPECIALIZE stdDev :: V.Vector Double -> Double #-} +-- | Standard error of the mean. This is the standard deviation+-- divided by the square root of the sample size.+stdErrMean :: (G.Vector v Double) => v Double -> Double+stdErrMean samp = stdDev samp / (sqrt . fromIntegral . G.length) samp+{-# SPECIALIZE stdErrMean :: U.Vector Double -> Double #-}+{-# SPECIALIZE stdErrMean :: V.Vector Double -> Double #-}++robustSumVarWeighted :: (G.Vector v (Double,Double)) => v (Double,Double) -> V+robustSumVarWeighted samp = G.foldl' go (V 0 0) samp+    where+      go (V s w) (x,xw) = V (s + xw*d*d) (w + xw)+          where d = x - m+      m = meanWeighted samp+{-# INLINE robustSumVarWeighted #-}++-- | Weighted variance. This is biased estimation.+varianceWeighted :: (G.Vector v (Double,Double)) => v (Double,Double) -> Double+varianceWeighted samp+    | G.length samp > 1 = fini $ robustSumVarWeighted samp+    | otherwise         = 0+    where+      fini (V s w) = s / w+{-# SPECIALIZE varianceWeighted :: U.Vector (Double,Double) -> Double #-}+{-# SPECIALIZE varianceWeighted :: V.Vector (Double,Double) -> Double #-}+ -- $cancellation -- -- The functions prefixed with the name @fast@ below perform a single@@ -226,8 +334,8 @@ -- mean, Knuth's algorithm gives inaccurate results due to -- catastrophic cancellation. -fastVar :: Sample -> T1-fastVar = foldlU go (T1 0 0 0)+fastVar :: (G.Vector v Double) => v Double -> T1+fastVar = G.foldl' go (T1 0 0 0)   where     go (T1 n m s) x = T1 n' m' s'       where n' = n + 1@@ -236,7 +344,7 @@             d  = x - m  -- | Maximum likelihood estimate of a sample's variance.-fastVariance :: Sample -> Double+fastVariance :: (G.Vector v Double) => v Double -> Double fastVariance = fini . fastVar   where fini (T1 n _m s)           | n > 1     = s / fromIntegral n@@ -244,7 +352,7 @@ {-# INLINE fastVariance #-}  -- | Unbiased estimate of a sample's variance.-fastVarianceUnbiased :: Sample -> Double+fastVarianceUnbiased :: (G.Vector v Double) => v Double -> Double fastVarianceUnbiased = fini . fastVar   where fini (T1 n _m s)           | n > 1     = s / fromIntegral (n - 1)@@ -253,12 +361,102 @@  -- | Standard deviation.  This is simply the square root of the -- maximum likelihood estimate of the variance.-fastStdDev :: Sample -> Double+fastStdDev :: (G.Vector v Double) => v Double -> Double fastStdDev = sqrt . fastVariance {-# INLINE fastStdDev #-} +-- | Covariance of sample of pairs. For empty sample it's set to+--   zero+covariance :: (G.Vector v (Double,Double))+           => v (Double,Double)+           -> Double+covariance xy+  | n == 0    = 0+  | otherwise = expectation (\(x,y) -> (x - muX)*(y - muY)) xy+  where+    n   = G.length xy+    muX = expectation fst xy+    muY = expectation snd xy+{-# SPECIALIZE covariance :: U.Vector (Double,Double) -> Double #-}+{-# SPECIALIZE covariance :: V.Vector (Double,Double) -> Double #-}++-- | Correlation coefficient for sample of pairs. Also known as+--   Pearson's correlation. For empty sample it's set to zero.+correlation :: (G.Vector v (Double,Double))+           => v (Double,Double)+           -> Double+correlation xy+  | n == 0    = 0+  | otherwise = cov / sqrt (varX * varY)+  where+    n    = G.length xy+    muX  = expectation (\(x,_) -> x) xy+    muY  = expectation (\(_,y) -> y) xy+    varX = expectation (\(x,_) -> square (x - muX))    xy+    varY = expectation (\(_,y) -> square (y - muY))    xy+    cov  = expectation (\(x,y) -> (x - muX)*(y - muY)) xy+{-# SPECIALIZE correlation :: U.Vector (Double,Double) -> Double #-}+{-# SPECIALIZE correlation :: V.Vector (Double,Double) -> Double #-}+++-- | Covariance of two samples. Both vectors must be of the same+--   length. If both are empty it's set to zero+covariance2 :: (G.Vector v Double)+           => v Double+           -> v Double+           -> Double+covariance2 xs ys+  | nx /= ny  = error $ "Statistics.Sample.covariance2: both samples must have same length"+  | nx == 0   = 0+  | otherwise = sum (G.zipWith (\x y -> (x - muX)*(y - muY)) xs ys)+              / fromIntegral nx+  where+    nx  = G.length xs+    ny  = G.length ys+    muX = mean xs+    muY = mean ys+{-# SPECIALIZE covariance2 :: U.Vector Double -> U.Vector Double -> Double #-}+{-# SPECIALIZE covariance2 :: V.Vector Double -> V.Vector Double -> Double #-}++-- | Correlation coefficient for two samples. Both vector must have+--   same length Also known as Pearson's correlation. For empty sample+--   it's set to zero.+correlation2 :: (G.Vector v Double)+             => v Double+             -> v Double+             -> Double+correlation2 xs ys+  | nx /= ny  = error $ "Statistics.Sample.correlation2: both samples must have same length"+  | nx == 0   = 0+  | otherwise = cov / sqrt (varX * varY)+  where+    nx         = G.length xs+    ny         = G.length ys+    (muX,varX) = meanVariance xs+    (muY,varY) = meanVariance ys+    cov = sum (G.zipWith (\x y -> (x - muX)*(y - muY)) xs ys)+        / fromIntegral nx+{-# SPECIALIZE correlation2 :: U.Vector Double -> U.Vector Double -> Double #-}+{-# SPECIALIZE correlation2 :: V.Vector Double -> V.Vector Double -> Double #-}+++-- | Pair two samples. It's like 'G.zip' but requires that both+--   samples have equal size.+pair :: (G.Vector v a, G.Vector v b, G.Vector v (a,b)) => v a -> v b -> v (a,b)+pair va vb+  | G.length va == G.length vb = G.zip va vb+  | otherwise = error "Statistics.Sample.pair: vector must have same length"+{-# INLINE pair #-}+ ------------------------------------------------------------------------ -- Helper code. Monomorphic unpacked accumulators.++-- (^) operator from Prelude is just slow.+(^) :: Double -> Int -> Double+x0 ^ n0 = go (n0-1) x0 where+    go 0 !acc = acc+    go n  acc = go (n-1) (acc*x0)+{-# INLINE (^) #-}  -- don't support polymorphism, as we can't get unboxed returns if we use it. data T = T {-# UNPACK #-}!Double {-# UNPACK #-}!Int
+ Statistics/Sample/Histogram.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE FlexibleContexts, BangPatterns, ScopedTypeVariables #-}++-- |+-- Module    : Statistics.Sample.Histogram+-- Copyright : (c) 2011 Bryan O'Sullivan+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Functions for computing histograms of sample data.++module Statistics.Sample.Histogram+    (+      histogram+    -- * Building blocks+    , histogram_+    , range+    ) where++import Control.Monad.ST+import Numeric.MathFunctions.Constants (m_epsilon,m_tiny)+import Statistics.Function (minMax)+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Generic.Mutable as GM++-- | /O(n)/ Compute a histogram over a data set.+--+-- The result consists of a pair of vectors:+--+-- * The lower bound of each interval.+--+-- * The number of samples within the interval.+--+-- Interval (bin) sizes are uniform, and the upper and lower bounds+-- are chosen automatically using the 'range' function.  To specify+-- these parameters directly, use the 'histogram_' function.+histogram :: (G.Vector v0 Double, G.Vector v1 Double, Num b, G.Vector v1 b) =>+             Int                -- ^ Number of bins (must be positive).+          -> v0 Double          -- ^ Sample data (cannot be empty).+          -> (v1 Double, v1 b)+histogram numBins xs = (G.generate numBins step, histogram_ numBins lo hi xs)+    where (lo,hi)    = range numBins xs+          step i     = lo + d * fromIntegral i+          d          = (hi - lo) / fromIntegral numBins+{-# INLINE histogram #-}++-- | /O(n)/ Compute a histogram over a data set.+--+-- Interval (bin) sizes are uniform, based on the supplied upper+-- and lower bounds.+histogram_ :: forall b a v0 v1. (Num b, RealFrac a, G.Vector v0 a, G.Vector v1 b) =>+              Int+           -- ^ Number of bins.  This value must be positive.  A zero+           -- or negative value will cause an error.+           -> a+           -- ^ Lower bound on interval range.  Sample data less than+           -- this will cause an error.+           -> a+           -- ^ Upper bound on interval range.  This value must not be+           -- less than the lower bound.  Sample data that falls above+           -- the upper bound will cause an error.+           -> v0 a+           -- ^ Sample data.+           -> v1 b+histogram_ numBins lo hi xs0 = G.create (GM.replicate numBins 0 >>= bin xs0)+  where+    bin :: forall s. v0 a -> G.Mutable v1 s b -> ST s (G.Mutable v1 s b)+    bin xs bins = go 0+     where+       go i | i >= len = return bins+            | otherwise = do+         let x = xs `G.unsafeIndex` i+             b = truncate $ (x - lo) / d+         write' bins b . (+1) =<< GM.read bins b+         go (i+1)+       write' bins' b !e = GM.write bins' b e+       len = G.length xs+       d = ((hi - lo) / fromIntegral numBins) * (1 + realToFrac m_epsilon)+{-# INLINE histogram_ #-}++-- | /O(n)/ Compute decent defaults for the lower and upper bounds of+-- a histogram, based on the desired number of bins and the range of+-- the sample data.+--+-- The upper and lower bounds used are @(lo-d, hi+d)@, where+--+-- @d = (maximum sample - minimum sample) / ((bins - 1) * 2)@+--+-- If all elements in the sample are the same and equal to @x@ range+-- is set to @(x - |x|/10, x + |x|/10)@. And if @x@ is equal to 0 range+-- is set to @(-1,1)@. This is needed to avoid creating histogram with+-- zero bin size.+range :: (G.Vector v Double) =>+         Int                    -- ^ Number of bins (must be positive).+      -> v Double               -- ^ Sample data (cannot be empty).+      -> (Double, Double)+range numBins xs+    | numBins < 1 = error "Statistics.Histogram.range: invalid bin count"+    | G.null xs   = error "Statistics.Histogram.range: empty sample"+    | lo == hi    = case abs lo / 10 of+                      a | a < m_tiny -> (-1,1)+                        | otherwise  -> (lo - a, lo + a)+    | otherwise   = (lo-d, hi+d)+  where+    d | numBins == 1 = 0+      | otherwise    = (hi - lo) / ((fromIntegral numBins - 1) * 2)+    (lo,hi)          = minMax xs+{-# INLINE range #-}
+ Statistics/Sample/Internal.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE FlexibleContexts #-}++-- |+-- Module    : Statistics.Sample.Internal+-- Copyright : (c) 2013 Bryan O'Sullivan+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Internal functions for computing over samples.+module Statistics.Sample.Internal+    (+      robustSumVar+    , sum+    , sumF+    ) where++import qualified Numeric.Sum as Sum+import Prelude hiding (sum)+import Statistics.Function (square)+import qualified Data.Vector.Generic as G++robustSumVar :: (G.Vector v Double) => Double -> v Double -> Double+robustSumVar m = sum . G.map (square . subtract m)+{-# INLINE robustSumVar #-}++sum :: (G.Vector v Double) => v Double -> Double+sum = Sum.sumVector Sum.kbn+{-# INLINE sum #-}++sumF :: Foldable f => f Double -> Double+sumF = Sum.sum Sum.kbn+{-# INLINE sumF #-}
+ Statistics/Sample/KernelDensity.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE BangPatterns, FlexibleContexts, UnboxedTuples #-}+-- |+-- Module    : Statistics.Sample.KernelDensity+-- Copyright : (c) 2011 Bryan O'Sullivan+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Kernel density estimation.  This module provides a fast, robust,+-- non-parametric way to estimate the probability density function of+-- a sample.+--+-- This estimator does not use the commonly employed \"Gaussian rule+-- of thumb\".  As a result, it outperforms many plug-in methods on+-- multimodal samples with widely separated modes.++module Statistics.Sample.KernelDensity+    (+    -- * Estimation functions+      kde+    , kde_+    -- * References+    -- $references+    ) where++import Data.Default.Class+import Numeric.MathFunctions.Constants (m_sqrt_2_pi)+import Numeric.RootFinding             (fromRoot, ridders, RiddersParam(..), Tolerance(..))+import Prelude hiding (const, min, max, sum)+import Statistics.Function (minMax, nextHighestPowerOfTwo)+import Statistics.Sample.Histogram (histogram_)+import Statistics.Sample.Internal (sum)+import Statistics.Transform (CD, dct, idct)+import qualified Data.Vector.Generic  as G+import qualified Data.Vector.Unboxed  as U+import qualified Data.Vector          as V+++-- | Gaussian kernel density estimator for one-dimensional data, using+-- the method of Botev et al.+--+-- The result is a pair of vectors, containing:+--+-- * The coordinates of each mesh point.  The mesh interval is chosen+--   to be 20% larger than the range of the sample.  (To specify the+--   mesh interval, use 'kde_'.)+--+-- * Density estimates at each mesh point.+kde :: (G.Vector v CD, G.Vector v Double, G.Vector v Int)+    => Int+    -- ^ The number of mesh points to use in the uniform discretization+    -- of the interval @(min,max)@.  If this value is not a power of+    -- two, then it is rounded up to the next power of two.+    -> v Double -> (v Double, v Double)+kde n0 xs = kde_ n0 (lo - range / 10) (hi + range / 10) xs+  where+    (lo,hi) = minMax xs+    range   | G.length xs <= 1 = 1       -- Unreasonable guess+            | lo == hi         = 1       -- All elements are equal+            | otherwise        = hi - lo+{-# INLINABLE  kde #-}+{-# SPECIAlIZE kde :: Int -> U.Vector Double -> (U.Vector Double, U.Vector Double) #-}+{-# SPECIAlIZE kde :: Int -> V.Vector Double -> (V.Vector Double, V.Vector Double) #-}+++-- | Gaussian kernel density estimator for one-dimensional data, using+-- the method of Botev et al.+--+-- The result is a pair of vectors, containing:+--+-- * The coordinates of each mesh point.+--+-- * Density estimates at each mesh point.+kde_ :: (G.Vector v CD, G.Vector v Double, G.Vector v Int)+     => Int+     -- ^ The number of mesh points to use in the uniform discretization+     -- of the interval @(min,max)@.  If this value is not a power of+     -- two, then it is rounded up to the next power of two.+     -> Double+     -- ^ Lower bound (@min@) of the mesh range.+     -> Double+     -- ^ Upper bound (@max@) of the mesh range.+     -> v Double+     -> (v Double, v Double)+kde_ n0 min max xs+  | G.null xs = error "Statistics.KernelDensity.kde: empty sample"+  | n0 <= 1   = error "Statistics.KernelDensity.kde: invalid number of points"+  | otherwise = (mesh, density)+  where+    mesh = G.generate ni $ \z -> min + (d * fromIntegral z)+        where d = r / (n-1)+    density = G.map (/(2 * r)) . idct $ G.zipWith f a (G.enumFromTo 0 (n-1))+      where f b z = b * exp (sqr z * sqr pi * t_star * (-0.5))+    !n  = fromIntegral ni+    !ni = nextHighestPowerOfTwo n0+    !r  = max - min+    a   = dct . G.map (/ sum h) $ h+        where h = G.map (/ len) $ histogram_ ni min max xs+    !len    = fromIntegral (G.length xs)+    !t_star = fromRoot (0.28 * len ** (-0.4)) . ridders def{ riddersTol = AbsTol 1e-14 } (0,0.1)+            $ \x -> x - (len * (2 * sqrt pi) * go 6 (f 7 x)) ** (-0.4)+      where+        f q t = 2 * pi ** (q*2) * sum (G.zipWith g iv a2v)+          where g i a2 = i ** q * a2 * exp ((-i) * sqr pi * t)+                a2v = G.map (sqr . (*0.5)) $ G.tail a+                iv = G.map sqr $ G.enumFromTo 1 (n-1)+        go s !h | s == 1    = h+                | otherwise = go (s-1) (f s time)+          where time  = (2 * const * k0 / len / h) ** (2 / (3 + 2 * s))+                const = (1 + 0.5 ** (s+0.5)) / 3+                k0    = U.product (G.enumFromThenTo 1 3 (2*s-1)) / m_sqrt_2_pi+    sqr x = x * x+{-# INLINABLE  kde_ #-}+{-# SPECIAlIZE kde_ :: Int -> Double -> Double -> U.Vector Double -> (U.Vector Double, U.Vector Double) #-}+{-# SPECIAlIZE kde_ :: Int -> Double -> Double -> V.Vector Double -> (V.Vector Double, V.Vector Double) #-}+++-- $references+--+-- Botev. Z.I., Grotowski J.F., Kroese D.P. (2010). Kernel density+-- estimation via diffusion. /Annals of Statistics/+-- 38(5):2916&#8211;2957. <http://arxiv.org/pdf/1011.2602>
+ Statistics/Sample/KernelDensity/Simple.hs view
@@ -0,0 +1,205 @@+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, FlexibleContexts #-}+-- |+-- Module    : Statistics.Sample.KernelDensity.Simple+-- Copyright : (c) 2009 Bryan O'Sullivan+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Kernel density estimation code, providing non-parametric ways to+-- estimate the probability density function of a sample.+--+-- The techniques used by functions in this module are relatively+-- fast, but they generally give inferior results to the KDE function+-- in the main 'Statistics.KernelDensity' module (due to the+-- oversmoothing documented for 'bandwidth' below).++module Statistics.Sample.KernelDensity.Simple+    {-# DEPRECATED "Use Statistics.Sample.KernelDensity instead." #-}+    (+    -- * Simple entry points+      epanechnikovPDF+    , gaussianPDF+    -- * Building blocks+    -- These functions may be useful if you need to construct a kernel+    -- density function estimator other than the ones provided in this+    -- module.++    -- ** Choosing points from a sample+    , Points(..)+    , choosePoints+    -- ** Bandwidth estimation+    , Bandwidth+    , bandwidth+    , epanechnikovBW+    , gaussianBW+    -- ** Kernels+    , Kernel+    , epanechnikovKernel+    , gaussianKernel+    -- ** Low-level estimation+    , estimatePDF+    , simplePDF+    -- * References+    -- $references+    ) where++import Data.Aeson (FromJSON, ToJSON)+import Data.Binary (Binary(..))+import Data.Data (Data, Typeable)+import Data.Vector.Binary ()+import GHC.Generics (Generic)+import Numeric.MathFunctions.Constants (m_1_sqrt_2, m_2_sqrt_pi)+import Prelude hiding (sum)+import Statistics.Function (minMax)+import Statistics.Sample (stdDev)+import Statistics.Sample.Internal (sum)+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Unboxed as U++-- | Points from the range of a 'Sample'.+newtype Points = Points {+      fromPoints :: U.Vector Double+    } deriving (Eq, Read, Show, Typeable, Data, Generic)++instance FromJSON Points+instance ToJSON Points++instance Binary Points where+    get = fmap Points get+    put = put . fromPoints++-- | Bandwidth estimator for an Epanechnikov kernel.+epanechnikovBW :: Double -> Bandwidth+epanechnikovBW n = (80 / (n * m_2_sqrt_pi)) ** 0.2++-- | Bandwidth estimator for a Gaussian kernel.+gaussianBW :: Double -> Bandwidth+gaussianBW n = (4 / (n * 3)) ** 0.2++-- | The width of the convolution kernel used.+type Bandwidth = Double++-- | Compute the optimal bandwidth from the observed data for the+-- given kernel.+--+-- This function uses an estimate based on the standard deviation of a+-- sample (due to Deheuvels), which performs reasonably well for+-- unimodal distributions but leads to oversmoothing for more complex+-- ones.+bandwidth :: G.Vector v Double =>+             (Double -> Bandwidth)+          -> v Double+          -> Bandwidth+bandwidth kern values = stdDev values * kern (fromIntegral $ G.length values)++-- | Choose a uniform range of points at which to estimate a sample's+-- probability density function.+--+-- If you are using a Gaussian kernel, multiply the sample's bandwidth+-- by 3 before passing it to this function.+--+-- If this function is passed an empty vector, it returns values of+-- positive and negative infinity.+choosePoints :: G.Vector v Double =>+                Int             -- ^ Number of points to select, /n/+             -> Double          -- ^ Sample bandwidth, /h/+             -> v Double        -- ^ Input data+             -> Points+choosePoints n h sample = Points . U.map f $ U.enumFromTo 0 n'+  where lo     = a - h+        hi     = z + h+        (a, z) = minMax sample+        d      = (hi - lo) / fromIntegral n'+        f i    = lo + fromIntegral i * d+        n'     = n - 1++-- | The convolution kernel.  Its parameters are as follows:+--+-- * Scaling factor, 1\//nh/+--+-- * Bandwidth, /h/+--+-- * A point at which to sample the input, /p/+--+-- * One sample value, /v/+type Kernel =  Double+            -> Double+            -> Double+            -> Double+            -> Double++-- | Epanechnikov kernel for probability density function estimation.+epanechnikovKernel :: Kernel+epanechnikovKernel f h p v+    | abs u <= 1 = f * (1 - u * u)+    | otherwise  = 0+    where u = (v - p) / (h * 0.75)++-- | Gaussian kernel for probability density function estimation.+gaussianKernel :: Kernel+gaussianKernel f h p v = exp (-0.5 * u * u) * g+    where u = (v - p) / h+          g = f * 0.5 * m_2_sqrt_pi * m_1_sqrt_2++-- | Kernel density estimator, providing a non-parametric way of+-- estimating the PDF of a random variable.+estimatePDF :: G.Vector v Double =>+               Kernel           -- ^ Kernel function+            -> Bandwidth        -- ^ Bandwidth, /h/+            -> v Double         -- ^ Sample data+            -> Points           -- ^ Points at which to estimate+            -> U.Vector Double+estimatePDF kernel h sample+    | n < 2     = errorShort "estimatePDF"+    | otherwise = U.map k . fromPoints+  where+    k p = sum . G.map (kernel f h p) $ sample+    f   = 1 / (h * fromIntegral n)+    n   = G.length sample+{-# INLINE estimatePDF #-}++-- | A helper for creating a simple kernel density estimation function+-- with automatically chosen bandwidth and estimation points.+simplePDF :: G.Vector v Double =>+             (Double -> Double) -- ^ Bandwidth function+          -> Kernel             -- ^ Kernel function+          -> Double             -- ^ Bandwidth scaling factor (3 for a Gaussian kernel, 1 for all others)+          -> Int                -- ^ Number of points at which to estimate+          -> v Double           -- ^ sample data+          -> (Points, U.Vector Double)+simplePDF fbw fpdf k numPoints sample =+    (points, estimatePDF fpdf bw sample points)+  where points = choosePoints numPoints (bw*k) sample+        bw     = bandwidth fbw sample+{-# INLINE simplePDF #-}++-- | Simple Epanechnikov kernel density estimator.  Returns the+-- uniformly spaced points from the sample range at which the density+-- function was estimated, and the estimates at those points.+epanechnikovPDF :: G.Vector v Double =>+                   Int          -- ^ Number of points at which to estimate+                -> v Double     -- ^ Data sample+                -> (Points, U.Vector Double)+epanechnikovPDF = simplePDF epanechnikovBW epanechnikovKernel 1++-- | Simple Gaussian kernel density estimator.  Returns the uniformly+-- spaced points from the sample range at which the density function+-- was estimated, and the estimates at those points.+gaussianPDF :: G.Vector v Double =>+               Int              -- ^ Number of points at which to estimate+            -> v Double         -- ^ Data sample+            -> (Points, U.Vector Double)+gaussianPDF = simplePDF gaussianBW gaussianKernel 3++errorShort :: String -> a+errorShort func = error ("Statistics.KernelDensity." ++ func +++                        ": at least two points required")++-- $references+--+-- * Deheuvels, P. (1977) Estimation non paramétrique de la densité+--   par histogrammes+--   généralisés. Mhttp://archive.numdam.org/article/RSA_1977__25_3_5_0.pdf>
+ Statistics/Sample/Normalize.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE FlexibleContexts #-}++-- |+-- Module    : Statistics.Sample.Normalize+-- Copyright : (c) 2017 Gregory W. Schwartz+-- License   : BSD3+--+-- Maintainer  : gsch@mail.med.upenn.edu+-- Stability   : experimental+-- Portability : portable+--+-- Functions for normalizing samples.++module Statistics.Sample.Normalize+    (+      standardize+    ) where++import Statistics.Sample+import qualified Data.Vector.Generic  as G+import qualified Data.Vector          as V+import qualified Data.Vector.Unboxed  as U+import qualified Data.Vector.Storable as S++-- | /O(n)/ Normalize a sample using standard scores:+--+--   \[ z = \frac{x - \mu}{\sigma} \]+--+--   Where μ is sample mean and σ is standard deviation computed from+--   unbiased variance estimation. If sample to small to compute σ or+--   it's equal to 0 @Nothing@ is returned.+standardize :: (G.Vector v Double) => v Double -> Maybe (v Double)+standardize xs+  | G.length xs < 2 = Nothing+  | sigma == 0      = Nothing+  | otherwise       = Just $ G.map (\x -> (x - mu) / sigma) xs+  where+    mu    = mean   xs+    sigma = stdDev xs+{-# INLINABLE  standardize #-}+{-# SPECIALIZE standardize :: V.Vector Double -> Maybe (V.Vector Double) #-}+{-# SPECIALIZE standardize :: U.Vector Double -> Maybe (U.Vector Double) #-}+{-# SPECIALIZE standardize :: S.Vector Double -> Maybe (S.Vector Double) #-}
Statistics/Sample/Powers.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE BangPatterns, TypeOperators #-}+{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric,+    FlexibleContexts #-} -- | -- Module    : Statistics.Sample.Powers--- Copyright : (c) 2009 Bryan O'Sullivan+-- Copyright : (c) 2009, 2010 Bryan O'Sullivan -- License   : BSD3 -- -- Maintainer  : bos@serpentine.com@@ -19,8 +20,7 @@ module Statistics.Sample.Powers     (     -- * Types-      Sample-    , Powers+      Powers      -- * Constructor     , powers@@ -47,17 +47,33 @@     -- $references     ) where -import Control.Monad.ST (unsafeSTToIO)-import Data.Array.Vector+import Control.Monad.ST+import Data.Aeson            (FromJSON, ToJSON)+import Data.Binary           (Binary(..))+import Data.Data             (Data, Typeable)+import Data.Vector.Binary    ()+import Data.Vector.Unboxed   ((!))+import GHC.Generics          (Generic)+import Numeric.SpecFunctions (choose) import Prelude hiding (sum)-import Statistics.Internal (inlinePerformIO)-import Statistics.Math (choose)-import Statistics.Types (Sample)-import System.IO.Unsafe (unsafePerformIO)+import Statistics.Function   (indexed)+import qualified Data.Vector          as V+import qualified Data.Vector.Generic  as G+import qualified Data.Vector.Storable as SV+import qualified Data.Vector.Unboxed  as U+import qualified Data.Vector.Unboxed.Mutable as MU+import qualified Statistics.Sample.Internal  as S -newtype Powers = Powers (UArr Double)-    deriving (Eq, Read, Show)+newtype Powers = Powers (U.Vector Double)+    deriving (Eq, Read, Show, Typeable, Data, Generic) +instance FromJSON Powers+instance ToJSON Powers++instance Binary Powers where+    put (Powers v) = put v+    get = fmap Powers get+ -- | O(/n/) Collect the /n/ simple powers of a sample. -- -- Functions computed over a sample's simple powers require at least a@@ -73,31 +89,32 @@ -- * For 'kurtosis', at least 4 simple powers are required. -- -- This function is subject to stream fusion.-powers :: Int                   -- ^ /n/, the number of powers, where /n/ >= 2.-       -> Sample+powers :: G.Vector v Double =>+          Int                   -- ^ /n/, the number of powers, where /n/ >= 2.+       -> v Double        -> Powers-powers k-    | k < 2     = error "Statistics.Sample.powers: too few powers"-    | otherwise = fini . foldlU go (unsafePerformIO . unsafeSTToIO $ create)+powers k sample+  | k < 2     = error "Statistics.Sample.powers: too few powers"+  | otherwise = runST $ do+      acc <- MU.replicate l 0+      G.forM_ sample $ \x ->+        let loop !i !xk+              | i == l    = return ()+              | otherwise = do MU.write acc i . (+ xk) =<< MU.read acc i+                               loop (i+1) (xk * x)+        in loop 0 1+      fmap Powers $ U.unsafeFreeze acc   where-    go ms x = inlinePerformIO . unsafeSTToIO $ loop 0 1-        where loop !i !xk | i == l = return ms-                          | otherwise = do-                readMU ms i >>= writeMU ms i . (+ xk)-                loop (i+1) (xk*x)-    fini = Powers . unsafePerformIO . unsafeSTToIO . unsafeFreezeAllMU-    create = newMU l >>= fill 0-        where fill !i ms | i == l    = return ms-                         | otherwise = writeMU ms i 0 >> fill (i+1) ms     l = k + 1-{-# INLINE powers #-}+{-# SPECIALIZE powers :: Int -> U.Vector  Double -> Powers #-}+{-# SPECIALIZE powers :: Int -> V.Vector  Double -> Powers #-}+{-# SPECIALIZE powers :: Int -> SV.Vector Double -> Powers #-} --- | The order (number) of simple powers collected from a 'Sample'.+-- | The order (number) of simple powers collected from a 'sample'. order :: Powers -> Int-order (Powers pa) = lengthU pa - 1-{-# INLINE order #-}+order (Powers pa) = U.length pa - 1 --- | Compute the /k/th central moment of a 'Sample'.  The central+-- | Compute the /k/th central moment of a sample.  The central -- moment is also known as the moment about the mean. centralMoment :: Int -> Powers -> Double centralMoment k p@(Powers pa)@@ -105,12 +122,11 @@                   error ("Statistics.Sample.Powers.centralMoment: "                          ++ "invalid argument")     | k == 0    = 1-    | otherwise = (/n) . sumU . mapU go . indexedU . takeU (k+1) $ pa+    | otherwise = (/n) . S.sum . U.map go . indexed . U.take (k+1) $ pa   where-    go (i :*: e) = (k `choose` i) * ((-m) ^ (k-i)) * e-    n = indexU pa 0+    go (i , e) = (k `choose` i) * ((-m) ^ (k-i)) * e+    n = U.head pa     m = mean p-{-# INLINE centralMoment #-}  -- | Maximum likelihood estimate of a sample's variance.  Also known -- as the population variance, where the denominator is /n/.  This is@@ -123,13 +139,11 @@ -- Requires 'Powers' with 'order' at least 2. variance :: Powers -> Double variance = centralMoment 2-{-# INLINE variance #-}  -- | Standard deviation.  This is simply the square root of the -- maximum likelihood estimate of the variance. stdDev :: Powers -> Double stdDev = sqrt . variance-{-# INLINE stdDev #-}  -- | Unbiased estimate of a sample's variance.  Also known as the -- sample variance, where the denominator is /n/-1.@@ -139,8 +153,7 @@ varianceUnbiased p@(Powers pa)     | n > 1     = variance p * n / (n-1)     | otherwise = 0-  where n = indexU pa 0-{-# INLINE varianceUnbiased #-}+  where n = U.head pa  -- | Compute the skewness of a sample. This is a measure of the -- asymmetry of its distribution.@@ -149,12 +162,12 @@ -- its mass is on the right of the distribution, with the tail on the -- left. ----- > skewness . powers 3 $ toU [1,100,101,102,103]+-- > skewness . powers 3 $ U.to [1,100,101,102,103] -- > ==> -1.497681449918257 -- -- A sample with positive skew is said to be /right-skewed/. ----- > skewness . powers 3 $ toU [1,2,3,4,100]+-- > skewness . powers 3 $ U.to [1,2,3,4,100] -- > ==> 1.4975367033335198 -- -- A sample's skewness is not defined if its 'variance' is zero.@@ -162,7 +175,6 @@ -- Requires 'Powers' with 'order' at least 3. skewness :: Powers -> Double skewness p = centralMoment 3 p * variance p ** (-1.5)-{-# INLINE skewness #-}  -- | Compute the excess kurtosis of a sample.  This is a measure of -- the \"peakedness\" of its distribution.  A high kurtosis indicates@@ -176,19 +188,16 @@ kurtosis :: Powers -> Double kurtosis p = centralMoment 4 p / (v * v) - 3     where v = variance p-{-# INLINE kurtosis #-}  -- | The number of elements in the original 'Sample'.  This is the -- sample's zeroth simple power. count :: Powers -> Int-count (Powers pa) = floor $ indexU pa 0-{-# INLINE count #-}+count (Powers pa) = floor $ U.head pa  -- | The sum of elements in the original 'Sample'.  This is the -- sample's first simple power. sum :: Powers -> Double-sum (Powers pa) = indexU pa 1-{-# INLINE sum #-}+sum (Powers pa) = pa ! 1  -- | The arithmetic mean of elements in the original 'Sample'. --@@ -199,8 +208,7 @@ mean p@(Powers pa)     | n == 0    = 0     | otherwise = sum p / n-    where n     = indexU pa 0-{-# INLINE mean #-}+    where n     = U.head pa  -- $references --
+ Statistics/Test/Bartlett.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE CPP              #-}+{-# LANGUAGE FlexibleContexts #-}+{-|+Module      : Statistics.Test.Bartlett+Description : Bartlett's test for homogeneity of variances.+Copyright   : (c) Praneya Kumar, Alexey Khudyakov, 2025+License     : BSD-3-Clause++Bartlett's test is used to check that multiple groups of observations+come from distributions with equal variances. This test assumes that+samples come from normal distribution. If this is not the case it may+simple test for non-normality and Levene's ("Statistics.Test.Levene")+is preferred++>>> import qualified Data.Vector.Unboxed as VU+>>> import Statistics.Test.Bartlett+>>> :{+let a = VU.fromList [8.88, 9.12, 9.04, 8.98, 9.00, 9.08, 9.01, 8.85, 9.06, 8.99]+    b = VU.fromList [8.88, 8.95, 9.29, 9.44, 9.15, 9.58, 8.36, 9.18, 8.67, 9.05]+    c = VU.fromList [8.95, 9.12, 8.95, 8.85, 9.03, 8.84, 9.07, 8.98, 8.86, 8.98]+in bartlettTest [a,b,c]+:}+Right (Test {testSignificance = mkPValue 1.1254782518843598e-5, testStatistics = 22.789434813726768, testDistribution = chiSquared 2})++-}+module Statistics.Test.Bartlett (+    bartlettTest,+    module Statistics.Distribution.ChiSquared+) where++import qualified Data.Vector           as V+import qualified Data.Vector.Unboxed   as VU+import qualified Data.Vector.Generic   as VG+import qualified Data.Vector.Storable  as VS+import qualified Data.Vector.Primitive as VP+#if MIN_VERSION_vector(0,13,2)+import qualified Data.Vector.Strict    as VV+#endif++import Statistics.Distribution (complCumulative)+import Statistics.Distribution.ChiSquared (chiSquared, ChiSquared(..))+import Statistics.Sample (varianceUnbiased)+import Statistics.Types (mkPValue)+import Statistics.Test.Types (Test(..))++-- | Perform Bartlett's test for equal variances. The input is a list+--   of vectors, where each vector represents a group of observations.+bartlettTest :: VG.Vector v Double => [v Double] -> Either String (Test ChiSquared)+bartlettTest groups+  | length groups < 2                 = Left "At least two groups are required for Bartlett's test."+  | any ((< 2) . VG.length) groups    = Left "Each group must have at least two observations."+  | any ((<= 0) . var) groupVariances = Left "All groups must have positive variance."+  | otherwise = Right Test+      { testSignificance = pValue+      , testStatistics   = tStatistic+      , testDistribution = chiDist+      }+  where+    -- Number of groups+    k = length groups+    -- Sample sizes for each group+    ni  = map (fromIntegral . VG.length) groups+    -- Total number of observations across all groups+    n_tot = sum $ fromIntegral . VG.length <$> groups+    -- Variance estimates+    groupVariances = toVar <$> groups+    sumWeightedVars = sum [ (n - 1) * v | Var{sampleN=n, var=v} <- groupVariances ]+    pooledVariance  = sumWeightedVars / fromIntegral (n_tot - k)+    -- Numerator of Bartlett's statistic+    numerator =+      fromIntegral (n_tot - k) * log pooledVariance -+      sum [ (n - 1) * log v | Var{sampleN=n, var=v} <- groupVariances ]+    -- Denominator correction term+    sumReciprocals = sum [1 / (n - 1) | n <- ni]+    denomCorrection =+      1 + (sumReciprocals - 1 / fromIntegral (n_tot - k)) / (3 * (fromIntegral k - 1))++    -- Test statistic and test distrubution+    tStatistic = max 0 $ numerator / denomCorrection+    chiDist    = chiSquared (k - 1)+    pValue     = mkPValue $ complCumulative chiDist tStatistic+{-# SPECIALIZE bartlettTest :: [V.Vector  Double] -> Either String (Test ChiSquared) #-}+{-# SPECIALIZE bartlettTest :: [VU.Vector Double] -> Either String (Test ChiSquared) #-}+{-# SPECIALIZE bartlettTest :: [VS.Vector Double] -> Either String (Test ChiSquared) #-}+{-# SPECIALIZE bartlettTest :: [VP.Vector Double] -> Either String (Test ChiSquared) #-}+#if MIN_VERSION_vector(0,13,2)+{-# SPECIALIZE bartlettTest :: [VV.Vector Double] -> Either String (Test ChiSquared) #-}+#endif++-- Estimate of variance+data Var = Var+  { sampleN :: !Double -- ^ N of elements+  , var     :: !Double -- ^ Sample variance+  }++toVar :: VG.Vector v Double => v Double -> Var+toVar xs = Var { sampleN = fromIntegral $ VG.length xs+               , var     = varianceUnbiased xs+               }
+ Statistics/Test/ChiSquared.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE FlexibleContexts #-}+-- | Pearson's chi squared test.+module Statistics.Test.ChiSquared (+    chi2test+  , chi2testCont+  , module Statistics.Test.Types+  ) where++import Prelude hiding (sum)++import Statistics.Distribution+import Statistics.Distribution.ChiSquared+import Statistics.Function        (square)+import Statistics.Sample.Internal (sum)+import Statistics.Test.Types+import Statistics.Types+import qualified Data.Vector as V+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Fusion.Bundle as F+import qualified Numeric.Sum as Sum++-- | Generic form of Pearson chi squared tests for binned data. Data+--   sample is supplied in form of tuples (observed quantity,+--   expected number of events). Both must be positive.+--+--   This test should be used only if all bins have expected values of+--   at least 5.+chi2test :: (G.Vector v (Int,Double))+         => Int                 -- ^ Number of additional degrees of+                                --   freedom. One degree of freedom+                                --   is due to the fact that the are+                                --   N observation in total and+                                --   accounted for automatically.+         -> v (Int,Double)      -- ^ Observation and expectation.+         -> Maybe (Test ChiSquared)+chi2test ndf vec+  | ndf <  0  = error $ "Statistics.Test.ChiSquare.chi2test: negative NDF " ++ show ndf+  | n   > 0   = Just Test+              { testSignificance = mkPValue $ complCumulative d chi2+              , testStatistics   = chi2+              , testDistribution = chiSquared n+              }+  | otherwise = Nothing+  where+    n     = G.length vec - ndf - 1+    chi2  = Sum.kbn+          $ F.foldl' Sum.add Sum.zero+          $ F.map (\(o,e) -> square (fromIntegral o - e) / e)+          $ G.stream vec+    d     = chiSquared n+{-# INLINABLE  chi2test #-}+{-# SPECIALIZE+    chi2test :: Int -> U.Vector (Int,Double) -> Maybe (Test ChiSquared) #-}+{-# SPECIALIZE+    chi2test :: Int -> V.Vector (Int,Double) -> Maybe (Test ChiSquared) #-}+++-- | Chi squared test for data with normal errors. Data is supplied in+--   form of pair (observation with error, and expectation).+chi2testCont+  :: (G.Vector v (Estimate NormalErr Double, Double))+  => Int                                   -- ^ Number of additional+                                           --   degrees of freedom.+  -> v (Estimate NormalErr Double, Double) -- ^ Observation and expectation.+  -> Maybe (Test ChiSquared)+chi2testCont ndf vec+  | ndf < 0   = error $ "Statistics.Test.ChiSquare.chi2testCont: negative NDF " ++ show ndf+  | n   > 0   = Just Test+              { testSignificance = mkPValue $ complCumulative d chi2+              , testStatistics   = chi2+              , testDistribution = chiSquared n+              }+  | otherwise = Nothing+  where+    n     = G.length vec - ndf - 1+    chi2  = Sum.kbn+          $ F.foldl' Sum.add Sum.zero+          $ F.map (\(Estimate o (NormalErr s),e) -> square (o - e) / s)+          $ G.stream vec+    d     = chiSquared n
+ Statistics/Test/Internal.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE FlexibleContexts #-}+module Statistics.Test.Internal (+    rank+  , rankUnsorted  +  , splitByTags  +  ) where++import Data.Ord+import           Data.Vector.Generic           ((!))+import qualified Data.Vector.Generic         as G+import qualified Data.Vector.Unboxed         as U+import qualified Data.Vector.Generic.Mutable as M+import Statistics.Function+++-- Private data type for unfolding+data Rank v a = Rank {+      rankCnt :: {-# UNPACK #-} !Int        -- Number of ranks to return+    , rankVal :: {-# UNPACK #-} !Double     -- Rank to return+    , rankNum :: {-# UNPACK #-} !Double     -- Current rank+    , rankVec :: v a                        -- Remaining vector+    }++-- | Calculate rank of every element of sample. In case of ties ranks+--   are averaged. Sample should be already sorted in ascending order.+--+--   Rank is index of element in the sample, numeration starts from 1.+--   In case of ties average of ranks of equal elements is assigned+--   to each+--+-- >>> import qualified Data.Vector.Unboxed as VU+-- >>> rank (==) (VU.fromList [10,20,30::Int])+-- [1.0,2.0,3.0]+--+-- >>> rank (==) (VU.fromList [10,10,10,30::Int])+-- [2.0,2.0,2.0,4.0]+rank :: (G.Vector v a)+     => (a -> a -> Bool)        -- ^ Equivalence relation+     -> v a                     -- ^ Vector to rank+     -> U.Vector Double+rank eq vec = G.unfoldr go (Rank 0 (-1) 1 vec)+  where+    go (Rank 0 _ r v)+      | G.null v  = Nothing+      | otherwise =+          case G.length h of+            1 -> Just (r, Rank 0 0 (r+1) rest)+            n -> go Rank { rankCnt = n+                         , rankVal = 0.5 * (r*2 + fromIntegral (n-1))+                         , rankNum = r + fromIntegral n+                         , rankVec = rest+                         }+          where+            (h,rest) = G.span (eq $ G.head v) v+    go (Rank n val r v) = Just (val, Rank (n-1) val r v)+{-# INLINE rank #-}++-- | Compute rank of every element of vector. Unlike rank it doesn't+--   require sample to be sorted.+rankUnsorted :: ( Ord a+                , G.Vector v a+                , G.Vector v Int+                , G.Vector v (Int, a)+                )+             => v a+             -> U.Vector Double+rankUnsorted xs = G.create $ do+    -- Put ranks into their original positions+    -- NOTE: backpermute will do wrong thing+    vec <- M.new n+    for 0 n $ \i ->+      M.unsafeWrite vec (index ! i) (ranks ! i)+    return vec+  where+    n = G.length xs+    -- Calculate ranks for sorted array+    ranks = rank (==) sorted+    -- Sort vector and retain original indices of elements+    (index, sorted)+      = G.unzip+      $ sortBy (comparing snd)+      $ indexed xs+{-# INLINE rankUnsorted #-}+++-- | Split tagged vector+splitByTags :: (G.Vector v a, G.Vector v (Bool,a)) => v (Bool,a) -> (v a, v a)+splitByTags vs = (G.map snd a, G.map snd b)+  where+    (a,b) = G.unstablePartition fst vs+{-# INLINE splitByTags #-}
+ Statistics/Test/KolmogorovSmirnov.hs view
@@ -0,0 +1,288 @@+{-# LANGUAGE FlexibleContexts #-}+-- |+-- Module    : Statistics.Test.KolmogorovSmirnov+-- Copyright : (c) 2011 Aleksey Khudyakov+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Kolmogov-Smirnov tests are non-parametric tests for assessing+-- whether given sample could be described by distribution or whether+-- two samples have the same distribution. It's only applicable to+-- continuous distributions.+module Statistics.Test.KolmogorovSmirnov (+    -- * Kolmogorov-Smirnov test+    kolmogorovSmirnovTest+  , kolmogorovSmirnovTestCdf+  , kolmogorovSmirnovTest2+    -- * Evaluate statistics+  , kolmogorovSmirnovCdfD+  , kolmogorovSmirnovD+  , kolmogorovSmirnov2D+    -- * Probabilities+  , kolmogorovSmirnovProbability+    -- * References+    -- $references+  , module Statistics.Test.Types+  ) where++import Control.Monad (when)+import Prelude hiding (exponent, sum)+import Statistics.Distribution (Distribution(..))+import Statistics.Function (gsort, unsafeModify)+import Statistics.Matrix (center, for, fromVector)+import qualified Statistics.Matrix as Mat+import Statistics.Test.Types+import Statistics.Types (mkPValue)+import qualified Data.Vector          as V+import qualified Data.Vector.Storable as S+import qualified Data.Vector.Unboxed  as U+import qualified Data.Vector.Generic  as G+import           Data.Vector.Generic    ((!))+import qualified Data.Vector.Unboxed.Mutable as M+++----------------------------------------------------------------+-- Test+----------------------------------------------------------------++-- | Check that sample could be described by distribution. Returns+--   @Nothing@ is sample is empty+--+--   This test uses Marsaglia-Tsang-Wang exact algorithm for+--   calculation of p-value.+kolmogorovSmirnovTest :: (Distribution d, G.Vector v Double)+                      => d        -- ^ Distribution+                      -> v Double -- ^ Data sample+                      -> Maybe (Test ())+{-# INLINE kolmogorovSmirnovTest #-}+kolmogorovSmirnovTest d+  = kolmogorovSmirnovTestCdf (cumulative d)+++-- | Variant of 'kolmogorovSmirnovTest' which uses CDF in form of+--   function.+kolmogorovSmirnovTestCdf :: (G.Vector v Double)+                         => (Double -> Double) -- ^ CDF of distribution+                         -> v Double           -- ^ Data sample+                         -> Maybe (Test ())+{-# INLINE kolmogorovSmirnovTestCdf #-}+kolmogorovSmirnovTestCdf cdf sample+  | G.null sample = Nothing+  | otherwise     = Just Test+      { testSignificance = mkPValue $ 1 - prob+      , testStatistics   = d+      , testDistribution = ()+      }+  where+    d    = kolmogorovSmirnovCdfD cdf sample+    prob = kolmogorovSmirnovProbability (G.length sample) d+++-- | Two sample Kolmogorov-Smirnov test. It tests whether two data+--   samples could be described by the same distribution without+--   making any assumptions about it. If either of samples is empty+--   returns Nothing.+--+--   This test uses approximate formula for computing p-value.+kolmogorovSmirnovTest2 :: (G.Vector v Double)+                       => v Double -- ^ Sample 1+                       -> v Double -- ^ Sample 2+                       -> Maybe (Test ())+kolmogorovSmirnovTest2 xs1 xs2+  | G.null xs1 || G.null xs2 = Nothing+  | otherwise                = Just Test+      { testSignificance = mkPValue $ 1 - prob d+      , testStatistics   = d+      , testDistribution = ()+      }+  where+    d    = kolmogorovSmirnov2D xs1 xs2+         * (en + 0.12 + 0.11/en)+    -- Effective number of data points+    n1   = fromIntegral (G.length xs1)+    n2   = fromIntegral (G.length xs2)+    en   = sqrt $ n1 * n2 / (n1 + n2)+    --+    prob z+      | z <  0    = error "kolmogorovSmirnov2D: internal error"+      | z == 0    = 0+      | z <  1.18 = let y = exp( -1.23370055013616983 / (z*z) )+                    in  2.25675833419102515 * sqrt( -log y ) * (y + y**9 + y**25 + y**49)+      | otherwise = let x = exp(-2 * z * z)+                    in  1 - 2*(x - x**4 + x**9)+{-# INLINABLE  kolmogorovSmirnovTest2 #-}+{-# SPECIALIZE kolmogorovSmirnovTest2 :: U.Vector Double -> U.Vector Double -> Maybe (Test ()) #-}+{-# SPECIALIZE kolmogorovSmirnovTest2 :: V.Vector Double -> V.Vector Double -> Maybe (Test ()) #-}+{-# SPECIALIZE kolmogorovSmirnovTest2 :: S.Vector Double -> S.Vector Double -> Maybe (Test ()) #-}+-- FIXME: Find source for approximation for D++++----------------------------------------------------------------+-- Kolmogorov's statistic+----------------------------------------------------------------++-- | Calculate Kolmogorov's statistic /D/ for given cumulative+--   distribution function (CDF) and data sample. If sample is empty+--   returns 0.+kolmogorovSmirnovCdfD :: G.Vector v Double+                      => (Double -> Double) -- ^ CDF function+                      -> v Double           -- ^ Sample+                      -> Double+kolmogorovSmirnovCdfD cdf sample+  | G.null sample = 0+  | otherwise     = G.maximum+                  $ G.zipWith3 (\p a b -> abs (p-a) `max` abs (p-b))+                    ps steps (G.tail steps)+  where+    xs = gsort sample+    n  = G.length xs+    --+    ps    = G.map cdf xs+    steps = G.map (/ fromIntegral n)+          $ G.generate (n+1) fromIntegral+{-# INLINABLE  kolmogorovSmirnovCdfD #-}+{-# SPECIALIZE kolmogorovSmirnovCdfD :: (Double -> Double) -> U.Vector Double -> Double #-}+{-# SPECIALIZE kolmogorovSmirnovCdfD :: (Double -> Double) -> V.Vector Double -> Double #-}+{-# SPECIALIZE kolmogorovSmirnovCdfD :: (Double -> Double) -> S.Vector Double -> Double #-}+++-- | Calculate Kolmogorov's statistic /D/ for given cumulative+--   distribution function (CDF) and data sample. If sample is empty+--   returns 0.+kolmogorovSmirnovD :: (Distribution d, G.Vector v Double)+                   => d         -- ^ Distribution+                   -> v Double  -- ^ Sample+                   -> Double+kolmogorovSmirnovD d = kolmogorovSmirnovCdfD (cumulative d)+{-# INLINE kolmogorovSmirnovD #-}+++-- | Calculate Kolmogorov's statistic /D/ for two data samples. If+--   either of samples is empty returns 0.+kolmogorovSmirnov2D :: (G.Vector v Double)+                    => v Double   -- ^ First sample+                    -> v Double   -- ^ Second sample+                    -> Double+kolmogorovSmirnov2D sample1 sample2+  | G.null sample1 || G.null sample2 = 0+  | otherwise                        = worker 0 0 0+  where+    xs1 = gsort sample1+    xs2 = gsort sample2+    n1  = G.length xs1+    n2  = G.length xs2+    en1 = fromIntegral n1+    en2 = fromIntegral n2+    -- Find new index+    skip x i xs = go (i+1)+      where go n | n >= G.length xs = n+                 | xs ! n == x      = go (n+1)+                 | otherwise        = n+    -- Main loop+    worker d i1 i2+      | i1 >= n1 || i2 >= n2 = d+      | otherwise            = worker d' i1' i2'+      where+        d1  = xs1 ! i1+        d2  = xs2 ! i2+        i1' | d1 <= d2  = skip d1 i1 xs1+            | otherwise = i1+        i2' | d2 <= d1  = skip d2 i2 xs2+            | otherwise = i2+        d'  = max d (abs $ fromIntegral i1' / en1 - fromIntegral i2' / en2)+{-# INLINABLE  kolmogorovSmirnov2D #-}+{-# SPECIALIZE kolmogorovSmirnov2D :: U.Vector Double -> U.Vector Double -> Double #-}+{-# SPECIALIZE kolmogorovSmirnov2D :: V.Vector Double -> V.Vector Double -> Double #-}+{-# SPECIALIZE kolmogorovSmirnov2D :: S.Vector Double -> S.Vector Double -> Double #-}++++-- | Calculate cumulative probability function for Kolmogorov's+--   distribution with /n/ parameters or probability of getting value+--   smaller than /d/ with n-elements sample.+--+--   It uses algorithm by Marsgalia et. al. and provide at least+--   7-digit accuracy.+kolmogorovSmirnovProbability :: Int    -- ^ Size of the sample+                             -> Double -- ^ D value+                             -> Double+kolmogorovSmirnovProbability n d+  -- Avoid potentially lengthy calculations for large N and D > 0.999+  | s > 7.24 || (s > 3.76 && n > 99) = 1 - 2 * exp( -(2.000071 + 0.331 / sqrt n' + 1.409 / n') * s)+  -- Exact computation+  | otherwise = fini $ KSMatrix 0 matrix `power` n+  where+    s  = n' * d * d+    n' = fromIntegral n++    size = 2*k - 1+    k    = floor (n' * d) + 1+    h    = fromIntegral k - n' * d+    -- Calculate initial matrix+    matrix =+      let m = U.create $ do+            mat <- M.new (size*size)+            -- Fill matrix with 0 and 1s+            for 0 size $ \row ->+              for 0 size $ \col -> do+                let val | row + 1 >= col = 1+                        | otherwise      = 0 :: Double+                M.write mat (row * size + col) val+            -- Correct left column/bottom row+            for 0 size $ \i -> do+              let delta = h ^^ (i + 1)+              unsafeModify mat (i    * size)         (subtract delta)+              unsafeModify mat (size * size - 1 - i) (subtract delta)+            -- Correct corner element if needed+            when (2*h > 1) $ do+              unsafeModify mat ((size - 1) * size) (+ ((2*h - 1) ^ size))+            -- Divide diagonals by factorial+            let divide g num+                  | num == size = return ()+                  | otherwise   = do for num size $ \i ->+                                       unsafeModify mat (i * (size + 1) - num) (/ g)+                                     divide (g * fromIntegral (num+2)) (num+1)+            divide 2 1+            return mat+      in fromVector size size m+    -- Last calculation+    fini (KSMatrix e m) = loop 1 (center m) e+      where+        loop i ss eQ+          | i  > n       = ss * 10 ^^ eQ+          | ss' < 1e-140 = loop (i+1) (ss' * 1e140) (eQ - 140)+          | otherwise    = loop (i+1)  ss'           eQ+          where ss' = ss * fromIntegral i / fromIntegral n++data KSMatrix = KSMatrix Int Mat.Matrix+++multiply :: KSMatrix -> KSMatrix -> KSMatrix+multiply (KSMatrix e1 m1) (KSMatrix e2 m2) = KSMatrix (e1+e2) (Mat.multiply m1 m2)++power :: KSMatrix -> Int -> KSMatrix+power mat 1 = mat+power mat n = avoidOverflow res+  where+    mat2 = power mat (n `quot` 2)+    pow  = multiply mat2 mat2+    res | odd n     = multiply pow mat+        | otherwise = pow++avoidOverflow :: KSMatrix -> KSMatrix+avoidOverflow ksm@(KSMatrix e m)+  | center m > 1e140 = KSMatrix (e + 140) (Mat.map (* 1e-140) m)+  | otherwise        = ksm+++----------------------------------------------------------------++-- $references+--+-- * G. Marsaglia, W. W. Tsang, J. Wang (2003) Evaluating Kolmogorov's+--   distribution, Journal of Statistical Software, American+--   Statistical Association, vol. 8(i18).
+ Statistics/Test/KruskalWallis.hs view
@@ -0,0 +1,100 @@+-- |+-- Module    : Statistics.Test.KruskalWallis+-- Copyright : (c) 2014 Danny Navarro+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+module Statistics.Test.KruskalWallis+  ( -- * Kruskal-Wallis test+    kruskalWallisTest+    -- ** Building blocks+  , kruskalWallisRank+  , kruskalWallis+  , module Statistics.Test.Types+  ) where++import Data.Ord (comparing)+import qualified Data.Vector.Unboxed as U+import Statistics.Function (sort, sortBy, square)+import Statistics.Distribution (complCumulative)+import Statistics.Distribution.ChiSquared (chiSquared)+import Statistics.Types+import Statistics.Test.Types+import Statistics.Test.Internal (rank)+import Statistics.Sample+import qualified Statistics.Sample.Internal as Sample(sum)+++-- | Kruskal-Wallis ranking.+--+-- All values are replaced by the absolute rank in the combined samples.+--+-- The samples and values need not to be ordered but the values in the result+-- are ordered. Assigned ranks (ties are given their average rank).+kruskalWallisRank :: (U.Unbox a, Ord a) => [U.Vector a] -> [U.Vector Double]+kruskalWallisRank samples = groupByTags+                          . sortBy (comparing fst)+                          . U.zip tags+                          $ rank (==) joinSample+  where+    (tags,joinSample) = U.unzip+                      . sortBy (comparing snd)+                      $ foldMap (uncurry tagSample) $ zip [(1::Int)..] samples+    tagSample t = U.map (\x -> (t,x))++    groupByTags xs+        | U.null xs = []+        | otherwise = sort (U.map snd ys) : groupByTags zs+      where+        (ys,zs) = U.span ((==) (fst $ U.head xs) . fst) xs+++-- | The Kruskal-Wallis Test.+--+-- In textbooks the output value is usually represented by 'K' or 'H'. This+-- function already does the ranking.+kruskalWallis :: (U.Unbox a, Ord a) => [U.Vector a] -> Double+kruskalWallis samples = (nTot - 1) * numerator / denominator+  where+    -- Total number of elements in all samples+    nTot    = fromIntegral $ sumWith rsamples U.length+    -- Average rank of all samples+    avgRank = (nTot + 1) / 2+    --+    numerator = sumWith rsamples $ \sample ->+        let n = fromIntegral $ U.length sample+        in  n * square (mean sample - avgRank)+    denominator = sumWith rsamples $ \sample ->+        Sample.sum $ U.map (\r -> square (r - avgRank)) sample++    rsamples = kruskalWallisRank samples+++-- | Perform Kruskal-Wallis Test for the given samples and required+-- significance. For additional information check 'kruskalWallis'. This is just+-- a helper function.+--+-- It uses /Chi-Squared/ distribution for approximation as long as the sizes are+-- larger than 5. Otherwise the test returns 'Nothing'.+kruskalWallisTest :: (Ord a, U.Unbox a) => [U.Vector a] -> Maybe (Test ())+kruskalWallisTest []      = Nothing+kruskalWallisTest samples+  -- We use chi-squared approximation here+  | all (>4) ns = Just Test { testSignificance = mkPValue $ complCumulative d k+                            , testStatistics   = k+                            , testDistribution = ()+                            }+  | otherwise   = Nothing+  where+    k  = kruskalWallis samples+    ns = map U.length samples+    d  = chiSquared (length ns - 1)++-- * Helper functions++sumWith :: Num a => [Sample] -> (Sample -> a) -> a+sumWith samples f = Prelude.sum $ fmap f samples+{-# INLINE sumWith #-}
+ Statistics/Test/Levene.hs view
@@ -0,0 +1,153 @@+{-# LANGUAGE CPP              #-}+{-# LANGUAGE FlexibleContexts #-}+{-|+Module      : Statistics.Test.Levene+Description : Levene's test for homogeneity of variances.+Copyright   : (c) Praneya Kumar, Alexey Khudyakov, 2025+License     : BSD-3-Clause++Levene's test used to check whether samples have equal variance. Null+hypothesis is all samples are from distributions with same variance+(homoscedacity). Test is robust to non-normality, and versatile with+mean or median centering.++>>> import qualified Data.Vector.Unboxed as VU+>>> import Statistics.Test.Levene+>>> :{+let a = VU.fromList [8.88, 9.12, 9.04, 8.98, 9.00, 9.08, 9.01, 8.85, 9.06, 8.99]+    b = VU.fromList [8.88, 8.95, 9.29, 9.44, 9.15, 9.58, 8.36, 9.18, 8.67, 9.05]+    c = VU.fromList [8.95, 9.12, 8.95, 8.85, 9.03, 8.84, 9.07, 8.98, 8.86, 8.98]+in levenesTest Median [a, b, c]+:}+Right (Test {testSignificance = mkPValue 2.4315059672496814e-3, testStatistics = 7.584952754501659, testDistribution = fDistributionReal 2.0 27.0})+-}+module Statistics.Test.Levene (+    Center(..),+    levenesTest+) where++import Control.Monad+import qualified Data.Vector           as V+import qualified Data.Vector.Unboxed   as VU+import qualified Data.Vector.Generic   as VG+import qualified Data.Vector.Storable  as VS+import qualified Data.Vector.Primitive as VP+#if MIN_VERSION_vector(0,13,2)+import qualified Data.Vector.Strict    as VV+#endif+import Statistics.Distribution (complCumulative)+import Statistics.Distribution.FDistribution (fDistribution, FDistribution)+import Statistics.Types      (mkPValue)+import Statistics.Test.Types (Test(..))+import Statistics.Function   (gsort)+import Statistics.Sample     (mean)++import qualified Statistics.Sample.Internal as IS+import Statistics.Quantile+++-- | Center calculation method+data Center+  = Mean             -- ^ Use arithmetic mean+  | Median           -- ^ Use median+  | Trimmed !Double  -- ^ Trimmed mean with given proportion to cut from each end+  deriving (Eq, Show)++-- | Main Levene's test function with full error handling+levenesTest+  :: (VG.Vector v Double)+  => Center      -- ^ Centering method+  -> [v Double]  -- ^ Input samples+  -> Either String (Test FDistribution)+{-# INLINABLE levenesTest #-}+levenesTest center samples+  | length samples < 2 = Left "At least two samples required"+  -- NOTE: We don't have nice way of computing mean of a list!+  | otherwise = do+      let residuals = computeResiduals center <$> samples+      -- Average of all Z+      let n_tot = sum $ VG.length . vecZ <$> residuals -- Total number of samples+      let zbar = IS.sumF [ meanZ z * sampleN z+                         | z <- residuals]+               / fromIntegral n_tot+      -- Numerator: Sum over (ni * (Z[i] - Z)^2)+      let numerator = IS.sumF [ sampleN z * sqr (meanZ z - zbar)+                              | z <- residuals]+      -- Denominator: Sum over Σ((dev_ij - zbari)^2)+      let denominator = IS.sumF+            [ IS.sum $ VU.map (sqr . subtract (meanZ z)) (vecZ z)+            | z <- residuals+            ]+      -- Handle division by zero and invalid values+      when (denominator <= 0 || isNaN denominator || isInfinite denominator)+        $ Left "Invalid denominator in W-statistic calculation"+      let wStat = (fromIntegral (n_tot - k) / fromIntegral (k - 1)) * (numerator / denominator)+          fDist = fDistribution (k - 1) (n_tot - k)+      Right Test { testStatistics   = wStat+                 , testSignificance = mkPValue $ complCumulative fDist wStat+                 , testDistribution = fDist+                 }+  where+    k = length samples -- Number of groups+{-# SPECIALIZE levenesTest :: Center -> [V.Vector  Double] -> Either String (Test FDistribution) #-}+{-# SPECIALIZE levenesTest :: Center -> [VU.Vector Double] -> Either String (Test FDistribution) #-}+{-# SPECIALIZE levenesTest :: Center -> [VS.Vector Double] -> Either String (Test FDistribution) #-}+{-# SPECIALIZE levenesTest :: Center -> [VP.Vector Double] -> Either String (Test FDistribution) #-}+#if MIN_VERSION_vector(0,13,2)+{-# SPECIALIZE levenesTest :: Center -> [VV.Vector Double] -> Either String (Test FDistribution) #-}+#endif++----------------------------------------------------------------+-- Implementation+----------------------------------------------------------------++-- | Trim data from both ends with error handling and performance optimization+trimboth :: (Ord a, Fractional a, VG.Vector v a)+         => v a+         -> Double+         -> v a+{-# INLINE trimboth #-}+trimboth vec p+  | p < 0 || p >= 0.5 = error "Statistics.Test.Levene: trimming: proportion must be between 0 and 0.5"+  | VG.null vec       = vec+  | otherwise         = VG.slice lowerCut (upperCut - lowerCut) sorted+  where+    n        = VG.length vec+    sorted   = gsort vec+    lowerCut = ceiling $ p * fromIntegral n+    upperCut = n - lowerCut++data Residuals = Residuals+  { sampleN :: !Double+  , meanZ   :: !Double+  , vecZ    :: !(VU.Vector Double)+  }++computeResiduals+  :: VG.Vector v Double+  => Center+  -> v Double+  -> Residuals+{-# INLINE computeResiduals #-}+computeResiduals method xs = case method of+  Mean   ->+    let c  = mean xs+        zs = VU.map (\x -> abs (x - c)) $ VU.convert xs+    in makeR zs+  Median ->+    let c  = median medianUnbiased xs+        zs = VU.map (\x -> abs (x - c)) $ VU.convert xs+    in makeR zs+  Trimmed p ->+    let trimmed = trimboth xs p+        c       = mean trimmed+        zs      = VU.map (\x -> abs (x - c)) $ VU.convert trimmed+    in makeR zs+  where+    makeR zs = Residuals { sampleN = fromIntegral $ VU.length zs+                         , meanZ   = mean zs+                         , vecZ    = zs+                         }++sqr :: Double -> Double+sqr x = x * x
+ Statistics/Test/MannWhitneyU.hs view
@@ -0,0 +1,237 @@+-- |+-- Module    : Statistics.Test.MannWhitneyU+-- Copyright : (c) 2010 Neil Brown+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Mann-Whitney U test (also know as Mann-Whitney-Wilcoxon and+-- Wilcoxon rank sum test) is a non-parametric test for assessing+-- whether two samples of independent observations have different+-- mean.+module Statistics.Test.MannWhitneyU (+    -- * Mann-Whitney U test+    mannWhitneyUtest+  , mannWhitneyU+  , mannWhitneyUCriticalValue+  , mannWhitneyUSignificant+    -- ** Wilcoxon rank sum test+  , wilcoxonRankSums+  , module Statistics.Test.Types+    -- * References+    -- $references+  ) where++import Data.List (findIndex)+import Data.Ord (comparing)+import Numeric.SpecFunctions (choose)+import Prelude hiding (sum)+import Statistics.Distribution (quantile)+import Statistics.Distribution.Normal (standard)+import Statistics.Function (sortBy)+import Statistics.Sample.Internal (sum)+import Statistics.Test.Internal (rank, splitByTags)+import Statistics.Test.Types (TestResult(..), PositionTest(..), significant)+import Statistics.Types (PValue,pValue)+import qualified Data.Vector.Unboxed as U++-- | The Wilcoxon Rank Sums Test.+--+-- This test calculates the sum of ranks for the given two samples.+-- The samples are ordered, and assigned ranks (ties are given their+-- average rank), then these ranks are summed for each sample.+--+-- The return value is (W₁, W₂) where W₁ is the sum of ranks of the first sample+-- and W₂ is the sum of ranks of the second sample.  This test is trivially transformed+-- into the Mann-Whitney U test.  You will probably want to use 'mannWhitneyU'+-- and the related functions for testing significance, but this function is exposed+-- for completeness.+wilcoxonRankSums :: (Ord a, U.Unbox a) => U.Vector a -> U.Vector a -> (Double, Double)+wilcoxonRankSums xs1 xs2 = (sum ranks1, sum ranks2)+  where+    -- Ranks for each sample+    (ranks1,ranks2) = splitByTags $ U.zip tags (rank (==) joinSample)+    -- Sorted and tagged sample+    (tags,joinSample) = U.unzip+                      $ sortBy (comparing snd)+                      $ tagSample True xs1 U.++ tagSample False xs2+    -- Add tag to a sample+    tagSample t = U.map (\x -> (t,x))++++-- | The Mann-Whitney U Test.+--+-- This is sometimes known as the Mann-Whitney-Wilcoxon U test, and+-- confusingly many sources state that the Mann-Whitney U test is the same as+-- the Wilcoxon's rank sum test (which is provided as 'wilcoxonRankSums').+-- The Mann-Whitney U is a simple transform of Wilcoxon's rank sum test.+--+-- Again confusingly, different sources state reversed definitions for U₁+-- and U₂, so it is worth being explicit about what this function returns.+-- Given two samples, the first, xs₁, of size n₁ and the second, xs₂,+-- of size n₂, this function returns (U₁, U₂)+-- where U₁ = W₁ - (n₁(n₁+1))\/2+-- and U₂ = W₂ - (n₂(n₂+1))\/2,+-- where (W₁, W₂) is the return value of @wilcoxonRankSums xs1 xs2@.+--+-- Some sources instead state that U₁ and U₂ should be the other way round, often+-- expressing this using U₁' = n₁n₂ - U₁ (since U₁ + U₂ = n₁n₂).+--+-- All of which you probably don't care about if you just feed this into 'mannWhitneyUSignificant'.+mannWhitneyU :: (Ord a, U.Unbox a) => U.Vector a -> U.Vector a -> (Double, Double)+mannWhitneyU xs1 xs2+  = (fst summedRanks - (n1*(n1 + 1))/2+    ,snd summedRanks - (n2*(n2 + 1))/2)+  where+    n1 = fromIntegral $ U.length xs1+    n2 = fromIntegral $ U.length xs2++    summedRanks = wilcoxonRankSums xs1 xs2++-- | Calculates the critical value of Mann-Whitney U for the given sample+-- sizes and significance level.+--+-- This function returns the exact calculated value of U for all sample sizes;+-- it does not use the normal approximation at all.  Above sample size 20 it is+-- generally recommended to use the normal approximation instead, but this function+-- will calculate the higher critical values if you need them.+--+-- The algorithm to generate these values is a faster, memoised version of the+-- simple unoptimised generating function given in section 2 of \"The Mann Whitney+-- Wilcoxon Distribution Using Linked Lists\"+mannWhitneyUCriticalValue+  :: (Int, Int)     -- ^ The sample size+  -> PValue Double  -- ^ The p-value (e.g. 0.05) for which you want the critical value.+  -> Maybe Int      -- ^ The critical value (of U).+mannWhitneyUCriticalValue (m, n) p+  | m < 1 || n < 1 = Nothing    -- Sample must be nonempty+  | p' <= 1        = Nothing    -- p-value is too small. Null hypothesis couldn't be disproved+  | otherwise      = findIndex (>= p')+                   $ take (m*n)+                   $ tail+                   $ alookup !! (m+n-2) !! (min m n - 1)+  where+    mnCn = (m+n) `choose` n+    p'   = mnCn * pValue p+++{-+-- Original function, without memoisation, from Cheung and Klotz:+-- Double is needed to avoid integer overflows.+a :: Int -> Int -> Int -> Double+a u bigN m+  | u < 0            = 0+  | u >= m * n       = bigN `choose` m+  | m == 1 || n == 1 = fromIntegral (u + 1)+  | otherwise        = a  u      (bigN - 1)  m+                     + a (u - n) (bigN - 1) (m-1)+  where+    n = bigN - m+-}++-- Memoised version of the original a function, above.+--+-- Doubles are stored to avoid integer overflow. 32-bit Ints begin to+-- overflow for bigN as small as 33 (64-bit one at 66) while Double to+-- go to infinity till bigN=1029+--+--+-- outer list is indexed by big N - 2+-- inner list by (m-1) (we know m < bigN)+-- innermost list by u+--+-- So: (alookup !! (bigN - 2) !! (m - 1) ! u) == a u bigN m+alookup :: [[[Double]]]+alookup = gen 2 [1 : repeat 2]+  where+    gen bigN predBigNList+       = let bigNlist = [ [ amemoed u m+                          | u <- [0 .. m*(bigN-m)]+                          ] ++ repeat (bigN `choose` m)+                        | m <- [1 .. (bigN-1)]] -- has bigN-1 elements+         in bigNlist : gen (bigN+1) bigNlist+      where+        amemoed :: Int -> Int -> Double+        amemoed u m+          | m == 1 || n == 1 = fromIntegral (u + 1)+          | otherwise        = mList !! u+                             + if u < n then 0 else predmList !! (u-n)+          where+            n = bigN - m+            (predmList : mList : _) = drop (m-2) predBigNList+            -- Lists for m-1 and m respectively. i-th list correspond to m=i+1+            --+            -- We know that predBigNList has bigN - 2 elements+            -- (and we know that n > 1 therefore bigN > m + 1)+            -- So bigN - 2 >= m, i.e. predBigNList must have at least m elements+            -- elements, so dropping (m-2) must leave at least 2+++-- | Calculates whether the Mann Whitney U test is significant.+--+-- If both sample sizes are less than or equal to 20, the exact U critical value+-- (as calculated by 'mannWhitneyUCriticalValue') is used.  If either sample is+-- larger than 20, the normal approximation is used instead.+--+-- If you use a one-tailed test, the test indicates whether the first sample is+-- significantly larger than the second.  If you want the opposite, simply reverse+-- the order in both the sample size and the (U₁, U₂) pairs.+mannWhitneyUSignificant+  :: PositionTest     -- ^ Perform one-tailed test (see description above).+  -> (Int, Int)       -- ^ The samples' size from which the (U₁,U₂) values were derived.+  -> PValue Double    -- ^ The p-value at which to test (e.g. 0.05)+  -> (Double, Double) -- ^ The (U₁, U₂) values from 'mannWhitneyU'.+  -> Maybe TestResult -- ^ Return 'Nothing' if the sample was too+                      --   small to make a decision.+mannWhitneyUSignificant test (in1, in2) pVal (u1, u2)+  -- Use normal approximation+  | in1 > 20 || in2 > 20 =+    let mean  = n1 * n2 / 2     -- (u1+u2) / 2+        sigma = sqrt $ n1*n2*(n1 + n2 + 1) / 12+        z     = (mean - u1) / sigma+    in Just $ case test of+                AGreater      -> significant $ z     < quantile standard p+                BGreater      -> significant $ (-z)  < quantile standard p+                SamplesDiffer -> significant $ abs z > abs (quantile standard (p/2))+  -- Use exact critical value+  | otherwise = do crit <- fromIntegral <$> mannWhitneyUCriticalValue (in1, in2) pVal+                   return $ case test of+                              AGreater      -> significant $ u2        <= crit+                              BGreater      -> significant $ u1        <= crit+                              SamplesDiffer -> significant $ min u1 u2 <= crit+  where+    n1 = fromIntegral in1+    n2 = fromIntegral in2+    p  = pValue pVal+++-- | Perform Mann-Whitney U Test for two samples and required+-- significance. For additional information check documentation of+-- 'mannWhitneyU' and 'mannWhitneyUSignificant'. This is just a helper+-- function.+--+-- One-tailed test checks whether first sample is significantly larger+-- than second. Two-tailed whether they are significantly different.+mannWhitneyUtest+  :: (Ord a, U.Unbox a)+  => PositionTest     -- ^ Perform one-tailed test (see description above).+  -> PValue Double    -- ^ The p-value at which to test (e.g. 0.05)+  -> U.Vector a       -- ^ First sample+  -> U.Vector a       -- ^ Second sample+  -> Maybe TestResult -- ^ Return 'Nothing' if the sample was too small to+                      --   make a decision.+mannWhitneyUtest ontTail p smp1 smp2 =+  mannWhitneyUSignificant ontTail (n1,n2) p $ mannWhitneyU smp1 smp2+    where+      n1 = U.length smp1+      n2 = U.length smp2++-- $references+--+-- * Cheung, Y.K.; Klotz, J.H. (1997) The Mann Whitney Wilcoxon+--   distribution using linked lists. /Statistica Sinica/+--   7:805&#8211;813.+-- <http://www3.stat.sinica.edu.tw/statistica/oldpdf/A7n316.pdf>.
+ Statistics/Test/StudentT.hs view
@@ -0,0 +1,149 @@+{-# LANGUAGE FlexibleContexts, Rank2Types, ScopedTypeVariables #-}+-- | Student's T-test is for assessing whether two samples have+--   different mean. This module contain several variations of+--   T-test. It's a parametric tests and assumes that samples are+--   normally distributed.+module Statistics.Test.StudentT+    (+      studentTTest+    , welchTTest+    , pairedTTest+    , module Statistics.Test.Types+    ) where++import Statistics.Distribution hiding (mean)+import Statistics.Distribution.StudentT+import Statistics.Sample (mean, varianceUnbiased)+import Statistics.Test.Types+import Statistics.Types    (mkPValue,PValue)+import Statistics.Function (square)+import qualified Data.Vector.Generic  as G+import qualified Data.Vector.Unboxed  as U+import qualified Data.Vector.Storable as S+import qualified Data.Vector          as V++++-- | Two-sample Student's t-test. It assumes that both samples are+--   normally distributed and have same variance. Returns @Nothing@ if+--   sample sizes are not sufficient.+studentTTest :: (G.Vector v Double)+             => PositionTest  -- ^ one- or two-tailed test+             -> v Double      -- ^ Sample A+             -> v Double      -- ^ Sample B+             -> Maybe (Test StudentT)+studentTTest test sample1 sample2+  | G.length sample1 < 2 || G.length sample2 < 2 = Nothing+  | otherwise                                    = Just Test+      { testSignificance = significance test t ndf+      , testStatistics   = t+      , testDistribution = studentT ndf+      }+  where+    (t, ndf) = tStatistics True sample1 sample2+{-# INLINABLE  studentTTest #-}+{-# SPECIALIZE studentTTest :: PositionTest -> U.Vector Double -> U.Vector Double -> Maybe (Test StudentT) #-}+{-# SPECIALIZE studentTTest :: PositionTest -> S.Vector Double -> S.Vector Double -> Maybe (Test StudentT) #-}+{-# SPECIALIZE studentTTest :: PositionTest -> V.Vector Double -> V.Vector Double -> Maybe (Test StudentT) #-}++-- | Two-sample Welch's t-test. It assumes that both samples are+--   normally distributed but doesn't assume that they have same+--   variance. Returns @Nothing@ if sample sizes are not sufficient.+welchTTest :: (G.Vector v Double)+           => PositionTest  -- ^ one- or two-tailed test+           -> v Double      -- ^ Sample A+           -> v Double      -- ^ Sample B+           -> Maybe (Test StudentT)+welchTTest test sample1 sample2+  | G.length sample1 < 2 || G.length sample2 < 2 = Nothing+  | otherwise                                    = Just Test+      { testSignificance = significance test t ndf+      , testStatistics   = t+      , testDistribution = studentT ndf+      }+  where+    (t, ndf) = tStatistics False sample1 sample2+{-# INLINABLE  welchTTest #-}+{-# SPECIALIZE welchTTest :: PositionTest -> U.Vector Double -> U.Vector Double -> Maybe (Test StudentT) #-}+{-# SPECIALIZE welchTTest :: PositionTest -> S.Vector Double -> S.Vector Double -> Maybe (Test StudentT) #-}+{-# SPECIALIZE welchTTest :: PositionTest -> V.Vector Double -> V.Vector Double -> Maybe (Test StudentT) #-}++-- | Paired two-sample t-test. Two samples are paired in a+-- within-subject design. Returns @Nothing@ if sample size is not+-- sufficient.+pairedTTest :: forall v. (G.Vector v (Double, Double))+            => PositionTest          -- ^ one- or two-tailed test+            -> v (Double, Double)    -- ^ paired samples+            -> Maybe (Test StudentT)+pairedTTest test sample+  | G.length sample < 2 = Nothing+  | otherwise           = Just Test+      { testSignificance = significance test t ndf+      , testStatistics   = t+      , testDistribution = studentT ndf+      }+  where+    (t, ndf) = tStatisticsPaired sample+{-# INLINABLE  pairedTTest #-}+{-# SPECIALIZE pairedTTest :: PositionTest -> U.Vector (Double,Double) -> Maybe (Test StudentT) #-}+{-# SPECIALIZE pairedTTest :: PositionTest -> V.Vector (Double,Double) -> Maybe (Test StudentT) #-}+++-------------------------------------------------------------------------------++significance :: PositionTest    -- ^ one- or two-tailed+             -> Double          -- ^ t statistics+             -> Double          -- ^ degree of freedom+             -> PValue Double   -- ^ p-value+significance test t df =+  case test of+    -- Here we exploit symmetry of T-distribution and calculate small tail+    SamplesDiffer -> mkPValue $ 2 * tailArea (negate (abs t))+    AGreater      -> mkPValue $ tailArea (negate t)+    BGreater      -> mkPValue $ tailArea  t+  where+    tailArea = cumulative (studentT df)+++-- Calculate T statistics for two samples+tStatistics :: (G.Vector v Double)+            => Bool               -- variance equality+            -> v Double+            -> v Double+            -> (Double, Double)+{-# INLINE tStatistics #-}+tStatistics varequal sample1 sample2 = (t, ndf)+  where+    -- t-statistics+    t = (m1 - m2) / sqrt (+      if varequal+        then ((n1 - 1) * s1 + (n2 - 1) * s2) / (n1 + n2 - 2) * (1 / n1 + 1 / n2)+        else s1 / n1 + s2 / n2)++    -- degree of freedom+    ndf | varequal  = n1 + n2 - 2+        | otherwise = square (s1 / n1 + s2 / n2)+                    / (square s1 / (square n1 * (n1 - 1)) + square s2 / (square n2 * (n2 - 1)))+    -- statistics of two samples+    n1 = fromIntegral $ G.length sample1+    n2 = fromIntegral $ G.length sample2+    m1 = mean sample1+    m2 = mean sample2+    s1 = varianceUnbiased sample1+    s2 = varianceUnbiased sample2+++-- Calculate T-statistics for paired sample+tStatisticsPaired :: (G.Vector v (Double, Double))+                  => v (Double, Double)+                  -> (Double, Double)+{-# INLINE tStatisticsPaired #-}+tStatisticsPaired sample = (t, ndf)+  where+    -- t-statistics+    t = let d    = U.map (uncurry (-)) $ G.convert sample+            sumd = U.sum d+        in sumd / sqrt ((n * U.sum (U.map square d) - square sumd) / ndf)+    -- degree of freedom+    ndf = n - 1+    n   = fromIntegral $ G.length sample
+ Statistics/Test/Types.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE DeriveFunctor, DeriveDataTypeable,DeriveGeneric  #-}+module Statistics.Test.Types (+    Test(..)+  , isSignificant+  , TestResult(..)+  , significant+  , PositionTest(..)+  ) where++import Control.DeepSeq  (NFData(..))+import Control.Monad    (liftM3)+import Data.Aeson       (FromJSON, ToJSON)+import Data.Binary      (Binary (..))+import Data.Data (Typeable, Data)+import GHC.Generics++import Statistics.Types (PValue)+++-- | Result of hypothesis testing+data TestResult = Significant    -- ^ Null hypothesis should be rejected+                | NotSignificant -- ^ Data is compatible with hypothesis+                  deriving (Eq,Ord,Show,Typeable,Data,Generic)++instance Binary   TestResult where+  get = do+      sig <- get+      if sig then return Significant else return NotSignificant+  put = put . (== Significant)+instance FromJSON TestResult+instance ToJSON   TestResult+instance NFData   TestResult++++-- | Result of statistical test.+data Test distr = Test+  { testSignificance :: !(PValue Double)+    -- ^ Probability of getting value of test statistics at least as+    --   extreme as measured.+  , testStatistics   :: !Double+    -- ^ Statistic used for test.+  , testDistribution :: distr+    -- ^ Distribution of test statistics if null hypothesis is correct.+  }+  deriving (Eq,Ord,Show,Typeable,Data,Generic,Functor)++instance (Binary   d) => Binary   (Test d) where+  get = liftM3 Test get get get+  put (Test sign stat distr) = put sign >> put stat >> put distr+instance (FromJSON d) => FromJSON (Test d)+instance (ToJSON   d) => ToJSON   (Test d)+instance (NFData   d) => NFData   (Test d) where+  rnf (Test _ _ a) = rnf a++-- | Check whether test is significant for given p-value.+isSignificant :: PValue Double -> Test d -> TestResult+isSignificant p t+  = significant $ p >= testSignificance t+++-- | Test type for test which compare positional (mean,median etc.)+--   information of samples.+data PositionTest+  = SamplesDiffer+    -- ^ Test whether samples differ in position. Null hypothesis is+    --   samples are not different+  | AGreater+    -- ^ Test if first sample (A) is larger than second (B). Null+    --   hypothesis is first sample is not larger than second.+  | BGreater+    -- ^ Test if second sample is larger than first.+  deriving (Eq,Ord,Show,Typeable,Data,Generic)++instance Binary   PositionTest where+  get = do+    i <- get+    case (i :: Int) of+      0 -> return SamplesDiffer+      1 -> return AGreater+      2 -> return BGreater+      _ -> fail "Invalid PositionTest"+  put SamplesDiffer = put (0 :: Int)+  put AGreater      = put (1 :: Int)+  put BGreater      = put (2 :: Int)+instance FromJSON PositionTest+instance ToJSON   PositionTest+instance NFData   PositionTest++-- | significant if parameter is 'True', not significant otherwise+significant :: Bool -> TestResult+significant True  = Significant+significant False = NotSignificant
+ Statistics/Test/WilcoxonT.hs view
@@ -0,0 +1,245 @@+{-# LANGUAGE ViewPatterns #-}+-- |+-- Module    : Statistics.Test.WilcoxonT+-- Copyright : (c) 2010 Neil Brown+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- The Wilcoxon matched-pairs signed-rank test is non-parametric test+-- which could be used to test whether two related samples have+-- different means.+module Statistics.Test.WilcoxonT (+    -- * Wilcoxon signed-rank matched-pair test+    -- ** Test+    wilcoxonMatchedPairTest+    -- ** Building blocks+  , wilcoxonMatchedPairSignedRank+  , wilcoxonMatchedPairSignificant+  , wilcoxonMatchedPairSignificance+  , wilcoxonMatchedPairCriticalValue+  , module Statistics.Test.Types+    -- * References+    -- $references+  ) where++++--+--+--+-- Note that: wilcoxonMatchedPairSignedRank == (\(x, y) -> (y, x)) . flip wilcoxonMatchedPairSignedRank+-- The samples are zipped together: if one is longer than the other, both are truncated+-- The value returned is the pair (T+, T-).  T+ is the sum of positive ranks (the+-- These values mean little by themselves, and should be combined with the 'wilcoxonSignificant'+-- function in this module to get a meaningful result.+-- ranks of the differences where the first parameter is higher) whereas T- is+-- the sum of negative ranks (the ranks of the differences where the second parameter is higher).+-- to the length of the shorter sample.++import Data.Function (on)+import Data.List (findIndex)+import Data.Ord (comparing)+import qualified Data.Vector.Unboxed as U+import Prelude hiding (sum)+import Statistics.Function (sortBy)+import Statistics.Sample.Internal (sum)+import Statistics.Test.Internal (rank, splitByTags)+import Statistics.Test.Types+import Statistics.Types -- (CL,pValue,getPValue)+import Statistics.Distribution+import Statistics.Distribution.Normal+++-- | Calculate (n,T⁺,T⁻) values for both samples. Where /n/ is reduced+--   sample where equal pairs are removed.+wilcoxonMatchedPairSignedRank :: (Ord a, Num a, U.Unbox a) => U.Vector (a,a) -> (Int, Double, Double)+wilcoxonMatchedPairSignedRank ab+  = (nRed, sum ranks1, negate (sum ranks2))+  where+    -- Positive and negative ranks+    (ranks1, ranks2) = splitByTags+                     $ U.zip tags (rank ((==) `on` abs) diffs)+    -- Sorted list of differences+    diffsSorted = sortBy (comparing abs)    -- Sort the differences by absolute difference+                $ U.filter  (/= 0)          -- Remove equal elements+                $ U.map (uncurry (-)) ab    -- Work out differences+    nRed = U.length diffsSorted+    -- Sign tags and differences+    (tags,diffs) = U.unzip+                 $ U.map (\x -> (x>0 , x))   -- Attach tags to distribution elements+                 $ diffsSorted++++-- | The coefficients for x^0, x^1, x^2, etc, in the expression+-- \prod_{r=1}^s (1 + x^r).  See the Mitic paper for details.+--+-- We can define:+-- f(1) = 1 + x+-- f(r) = (1 + x^r)*f(r-1)+--      = f(r-1) + x^r * f(r-1)+-- The effect of multiplying the equation by x^r is to shift+-- all the coefficients by r down the list.+--+-- This list will be processed lazily from the head.+coefficients :: Int -> [Integer]+coefficients 1 = [1, 1] -- 1 + x+coefficients r = let coeffs = coefficients (r-1)+                     (firstR, rest) = splitAt r coeffs+  in firstR ++ add rest coeffs+  where+    add (x:xs) (y:ys) = x + y : add xs ys+    add xs [] = xs+    add [] ys = ys++-- This list will be processed lazily from the head.+summedCoefficients :: Int -> [Double]+summedCoefficients n+  | n < 1     = error "Statistics.Test.WilcoxonT.summedCoefficients: nonpositive sample size"+  | n > 1023  = error "Statistics.Test.WilcoxonT.summedCoefficients: sample is too large (see bug #18)"+  | otherwise = map fromIntegral $ scanl1 (+) $ coefficients n++++-- | Tests whether a given result from a Wilcoxon signed-rank matched-pairs test+-- is significant at the given level.+--+-- This function can perform a one-tailed or two-tailed test.  If the first+-- parameter to this function is 'TwoTailed', the test is performed two-tailed to+-- check if the two samples differ significantly.  If the first parameter is+-- 'OneTailed', the check is performed one-tailed to decide whether the first sample+-- (i.e. the first sample you passed to 'wilcoxonMatchedPairSignedRank') is+-- greater than the second sample (i.e. the second sample you passed to+-- 'wilcoxonMatchedPairSignedRank').  If you wish to perform a one-tailed test+-- in the opposite direction, you can either pass the parameters in a different+-- order to 'wilcoxonMatchedPairSignedRank', or simply swap the values in the resulting+-- pair before passing them to this function.+wilcoxonMatchedPairSignificant+  :: PositionTest          -- ^ How to compare two samples+  -> PValue Double         -- ^ The p-value at which to test (e.g. @mkPValue 0.05@)+  -> (Int, Double, Double) -- ^ The (n,T⁺, T⁻) values from 'wilcoxonMatchedPairSignedRank'.+  -> Maybe TestResult      -- ^ Return 'Nothing' if the sample was too+                           --   small to make a decision.+wilcoxonMatchedPairSignificant test pVal (sampleSize, tPlus, tMinus) =+  case test of+    -- According to my nearest book (Understanding Research Methods and Statistics+    -- by Gary W. Heiman, p590), to check that the first sample is bigger you must+    -- use the absolute value of T- for a one-tailed check:+    AGreater      -> do crit <- wilcoxonMatchedPairCriticalValue sampleSize pVal+                        return $ significant $ abs tMinus <= fromIntegral crit+    BGreater      -> do crit <- wilcoxonMatchedPairCriticalValue sampleSize pVal+                        return $ significant $ abs tPlus <= fromIntegral crit+    -- Otherwise you must use the value of T+ and T- with the smallest absolute value:+    --+    -- Note that in absence of ties sum of |T+| and |T-| is constant+    -- so by selecting minimal we are performing two-tailed test and+    -- look and both tails of distribution of T.+    SamplesDiffer -> do crit <- wilcoxonMatchedPairCriticalValue sampleSize (mkPValue $ p/2)+                        return $ significant $ t <= fromIntegral crit+  where+    t = min (abs tPlus) (abs tMinus)+    p = pValue pVal+++-- | Obtains the critical value of T to compare against, given a sample size+-- and a p-value (significance level).  Your T value must be less than or+-- equal to the return of this function in order for the test to work out+-- significant.  If there is a Nothing return, the sample size is too small to+-- make a decision.+--+-- 'wilcoxonSignificant' tests the return value of 'wilcoxonMatchedPairSignedRank'+-- for you, so you should use 'wilcoxonSignificant' for determining test results.+--  However, this function is useful, for example, for generating lookup tables+-- for Wilcoxon signed rank critical values.+--+-- The return values of this function are generated using the method+-- detailed in the Mitic's paper. According to that paper, the results+-- may differ from other published lookup tables, but (Mitic claims)+-- the values obtained by this function will be the correct ones.+wilcoxonMatchedPairCriticalValue ::+     Int                -- ^ The sample size+  -> PValue Double      -- ^ The p-value (e.g. @mkPValue 0.05@) for which you want the critical value.+  -> Maybe Int          -- ^ The critical value (of T), or Nothing if+                        --   the sample is too small to make a decision.+wilcoxonMatchedPairCriticalValue n pVal+  | n < 100   =+      case subtract 1 <$> findIndex (> m) (summedCoefficients n) of+        Just k | k < 0     -> Nothing+               | otherwise -> Just k+        Nothing  -> error "Statistics.Test.WilcoxonT.wilcoxonMatchedPairCriticalValue: impossible happened"+  | otherwise =+     case quantile (normalApprox n) p of+       z | z < 0     -> Nothing+         | otherwise -> Just (round z)+  where+    p = pValue pVal+    m = (2 ** fromIntegral n) * p+++-- | Works out the significance level (p-value) of a T value, given a sample+-- size and a T value from the Wilcoxon signed-rank matched-pairs test.+--+-- See the notes on 'wilcoxonCriticalValue' for how this is calculated.+wilcoxonMatchedPairSignificance+  :: Int           -- ^ The sample size+  -> Double        -- ^ The value of T for which you want the significance.+  -> PValue Double -- ^ The significance (p-value).+wilcoxonMatchedPairSignificance n t+  = mkPValue p+  where+    p | n < 100   = (summedCoefficients n !! floor t) / 2 ** fromIntegral n+      | otherwise = cumulative (normalApprox n) t+++-- | Normal approximation for Wilcoxon T statistics+normalApprox :: Int -> NormalDistribution+normalApprox ni+  = normalDistr m s+  where+    m = n * (n + 1) / 4+    s = sqrt $ (n * (n + 1) * (2*n + 1)) / 24+    n = fromIntegral ni+++-- | The Wilcoxon matched-pairs signed-rank test. The samples are+-- zipped together: if one is longer than the other, both are+-- truncated to the length of the shorter sample.+--+-- For one-tailed test it tests whether first sample is significantly+-- greater than the second. For two-tailed it checks whether they+-- significantly differ+--+-- Check 'wilcoxonMatchedPairSignedRank' and+-- 'wilcoxonMatchedPairSignificant' for additional information.+wilcoxonMatchedPairTest+  :: (Ord a, Num a, U.Unbox a)+  => PositionTest     -- ^ Perform one-tailed test.+  -> U.Vector (a,a)   -- ^ Sample of pairs+  -> Test ()          -- ^ Return 'Nothing' if the sample was too+                      --   small to make a decision.+wilcoxonMatchedPairTest test pairs =+  Test { testSignificance = pVal+       , testStatistics   = t+       , testDistribution = ()+       }+  where+    (n,tPlus,tMinus) = wilcoxonMatchedPairSignedRank pairs+    (t,pVal) = case test of+                 AGreater      -> (abs tMinus, wilcoxonMatchedPairSignificance n (abs tMinus))+                 BGreater      -> (abs tPlus,  wilcoxonMatchedPairSignificance n (abs tPlus ))+                 -- Since we take minimum of T+,T- we can't get more+                 -- that p=0.5 and can multiply it by 2 without risk+                 -- of error.+                 SamplesDiffer -> let t' = min (abs tMinus) (abs tPlus)+                                      p  = wilcoxonMatchedPairSignificance n t'+                                  in (t', mkPValue $ min 1 $ 2 * pValue p)+++-- $references+--+-- * \"Critical Values for the Wilcoxon Signed Rank Statistic\", Peter+--   Mitic, The Mathematica Journal, volume 6, issue 3, 1996+--   (<http://www.mathematica-journal.com/issue/v6i3/article/mitic/contents/63mitic.pdf>)
+ Statistics/Transform.hs view
@@ -0,0 +1,176 @@+{-# LANGUAGE BangPatterns, FlexibleContexts #-}+-- |+-- Module    : Statistics.Transform+-- Copyright : (c) 2011 Bryan O'Sullivan+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Fourier-related transformations of mathematical functions.+--+-- These functions are written for simplicity and correctness, not+-- speed.  If you need a fast FFT implementation for your application,+-- you should strongly consider using a library of FFTW bindings+-- instead.++module Statistics.Transform+    (+    -- * Type synonyms+      CD+    -- * Discrete cosine transform+    , dct+    , dct_+    , idct+    , idct_+    -- * Fast Fourier transform+    , fft+    , ifft+    ) where++import Control.Monad (when)+import Control.Monad.ST (ST)+import Data.Bits (shiftL, shiftR)+import Data.Complex (Complex(..), conjugate, realPart)+import Numeric.SpecFunctions (log2)+import qualified Data.Vector.Generic         as G+import qualified Data.Vector.Generic.Mutable as M+import qualified Data.Vector.Unboxed         as U+import qualified Data.Vector                 as V++type CD = Complex Double++-- | Discrete cosine transform (DCT-II).+dct :: (G.Vector v CD, G.Vector v Double, G.Vector v Int) => v Double -> v Double+dct = dctWorker . G.map (:+0)+{-# INLINABLE  dct #-}+{-# SPECIAlIZE dct :: U.Vector Double -> U.Vector Double #-}+{-# SPECIAlIZE dct :: V.Vector Double -> V.Vector Double #-}++-- | Discrete cosine transform (DCT-II). Only real part of vector is+--   transformed, imaginary part is ignored.+dct_ :: (G.Vector v CD, G.Vector v Double, G.Vector v Int) => v CD -> v Double+dct_ = dctWorker . G.map (\(i :+ _) -> i :+ 0)+{-# INLINABLE  dct_ #-}+{-# SPECIAlIZE dct_ :: U.Vector CD -> U.Vector Double #-}+{-# SPECIAlIZE dct_ :: V.Vector CD -> V.Vector Double#-}++dctWorker :: (G.Vector v CD, G.Vector v Double, G.Vector v Int) => v CD -> v Double+{-# INLINE dctWorker #-}+dctWorker xs+  -- length 1 is special cased because shuffle algorithms fail for it.+  | G.length xs == 1 = G.map ((2*) . realPart) xs+  | vectorOK xs      = G.map realPart $ G.zipWith (*) weights (fft interleaved)+  | otherwise        = error "Statistics.Transform.dct: bad vector length"+  where+    interleaved = G.backpermute xs $ G.enumFromThenTo 0 2 (len-2) G.+++                                     G.enumFromThenTo (len-1) (len-3) 1+    weights = G.cons 2 . G.generate (len-1) $ \x ->+              2 * exp ((0:+(-1))*fi (x+1)*pi/(2*n))+      where n = fi len+    len = G.length xs++++-- | Inverse discrete cosine transform (DCT-III). It's inverse of+-- 'dct' only up to scale parameter:+--+-- > (idct . dct) x = (* length x)+idct :: (G.Vector v CD, G.Vector v Double) => v Double -> v Double+idct = idctWorker . G.map (:+0)+{-# INLINABLE  idct #-}+{-# SPECIAlIZE idct :: U.Vector Double -> U.Vector Double #-}+{-# SPECIAlIZE idct :: V.Vector Double -> V.Vector Double #-}++-- | Inverse discrete cosine transform (DCT-III). Only real part of vector is+--   transformed, imaginary part is ignored.+idct_ :: (G.Vector v CD, G.Vector v Double) => v CD -> v Double+idct_ = idctWorker . G.map (\(i :+ _) -> i :+ 0)+{-# INLINABLE  idct_ #-}+{-# SPECIAlIZE idct_ :: U.Vector CD -> U.Vector Double #-}+{-# SPECIAlIZE idct_ :: V.Vector CD -> V.Vector Double #-}++idctWorker :: (G.Vector v CD, G.Vector v Double) => v CD -> v Double+{-# INLINE idctWorker #-}+idctWorker xs+  | vectorOK xs = G.generate len interleave+  | otherwise   = error "Statistics.Transform.dct: bad vector length"+  where+    interleave z | even z    = vals `G.unsafeIndex` halve z+                 | otherwise = vals `G.unsafeIndex` (len - halve z - 1)+    vals = G.map realPart . ifft $ G.zipWith (*) weights xs+    weights+      = G.cons n+      $ G.generate (len - 1) $ \x -> 2 * n * exp ((0:+1) * fi (x+1) * pi/(2*n))+      where n = fi len+    len = G.length xs++++-- | Inverse fast Fourier transform.+ifft :: G.Vector v CD => v CD -> v CD+ifft xs+  | vectorOK xs = G.map ((/fi (G.length xs)) . conjugate) . fft . G.map conjugate $ xs+  | otherwise   = error "Statistics.Transform.ifft: bad vector length"+{-# INLINABLE  ifft #-}+{-# SPECIAlIZE ifft :: U.Vector CD -> U.Vector CD #-}+{-# SPECIAlIZE ifft :: V.Vector CD -> V.Vector CD #-}++-- | Radix-2 decimation-in-time fast Fourier transform.+fft :: G.Vector v CD => v CD -> v CD+fft v | vectorOK v  = G.create $ do mv <- G.thaw v+                                    mfft mv+                                    return mv+      | otherwise   = error "Statistics.Transform.fft: bad vector length"+{-# INLINABLE  fft #-}+{-# SPECIAlIZE fft :: U.Vector CD -> U.Vector CD #-}+{-# SPECIAlIZE fft :: V.Vector CD -> V.Vector CD #-}++-- Vector length must be power of two. It's not checked+mfft :: (M.MVector v CD) => v s CD -> ST s ()+{-# INLINE mfft #-}+mfft vec = bitReverse 0 0+ where+  bitReverse i j | i == len-1 = stage 0 1+                 | otherwise  = do+    when (i < j) $ M.swap vec i j+    let inner k l | k <= l    = inner (k `shiftR` 1) (l-k)+                  | otherwise = bitReverse (i+1) (l+k)+    inner (len `shiftR` 1) j+  stage l !l1 | l == m    = return ()+              | otherwise = do+    let !l2 = l1 `shiftL` 1+        !e  = -6.283185307179586/fromIntegral l2+        flight j !a | j == l1   = stage (l+1) l2+                    | otherwise = do+          let butterfly i | i >= len  = flight (j+1) (a+e)+                          | otherwise = do+                let i1 = i + l1+                xi1 :+ yi1 <- M.read vec i1+                let !c = cos a+                    !s = sin a+                    d  = (c*xi1 - s*yi1) :+ (s*xi1 + c*yi1)+                ci <- M.read vec i+                M.write vec i1 (ci - d)+                M.write vec i (ci + d)+                butterfly (i+l2)+          butterfly j+    flight 0 0+  len = M.length vec+  m   = log2 len+++----------------------------------------------------------------+-- Helpers+----------------------------------------------------------------++fi :: Int -> CD+fi = fromIntegral++halve :: Int -> Int+halve = (`shiftR` 1)++vectorOK :: G.Vector v a => v a -> Bool+{-# INLINE vectorOK #-}+vectorOK v = (1 `shiftL` log2 n) == n where n = G.length v
Statistics/Types.hs view
@@ -1,3 +1,9 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} -- | -- Module    : Statistics.Types -- Copyright : (c) 2009 Bryan O'Sullivan@@ -7,23 +13,509 @@ -- Stability   : experimental -- Portability : portable ----- Types for working with statistics.-+-- Data types common used in statistics module Statistics.Types-    (-      Estimator+    ( -- * Confidence level+      CL+      -- ** Accessors+    , confidenceLevel+    , significanceLevel+      -- ** Constructors+    , mkCL+    , mkCLE+    , mkCLFromSignificance+    , mkCLFromSignificanceE+      -- ** Constants and conversion to nσ+    , cl90+    , cl95+    , cl99+      -- *** Normal approximation+    , nSigma+    , nSigma1+    , getNSigma+    , getNSigma1+      -- * p-value+    , PValue+      -- ** Accessors+    , pValue+      -- ** Constructors+    , mkPValue+    , mkPValueE+      -- * Estimates and upper/lower limits+    , Estimate(..)+    , NormalErr(..)+    , ConfInt(..)+    , UpperLimit(..)+    , LowerLimit(..)+      -- ** Constructors+    , estimateNormErr+    , (±)+    , estimateFromInterval+    , estimateFromErr+      -- ** Accessors+    , confidenceInterval+    , asymErrors+    , Scale(..)+      -- * Other     , Sample+    , WeightedSample     , Weights     ) where -import Data.Array.Vector (UArr)+import Control.Monad                ((<=<), liftM2, liftM3)+import Control.DeepSeq              (NFData(..))+import Data.Aeson                   (FromJSON(..), ToJSON)+import Data.Binary                  (Binary(..))+import Data.Data                    (Data,Typeable)+import Data.Maybe                   (fromMaybe)+import Data.Vector.Unboxed          (Unbox)+import Data.Vector.Unboxed.Deriving (derivingUnbox)+import GHC.Generics                 (Generic)+import Statistics.Internal+import Statistics.Types.Internal+import Statistics.Distribution+import Statistics.Distribution.Normal --- | Sample data.-type Sample = UArr Double --- | A function that estimates a property of a sample, such as its--- 'mean'.-type Estimator = Sample -> Double+----------------------------------------------------------------+-- Data type for confidence level+---------------------------------------------------------------- --- | Weights for affecting the importance of elements of a sample.-type Weights = UArr Double+-- |+-- Confidence level. In context of confidence intervals it's+-- probability of said interval covering true value of measured+-- value. In context of statistical tests it's @1-α@ where α is+-- significance of test.+--+-- Since confidence level are usually close to 1 they are stored as+-- @1-CL@ internally. There are two smart constructors for @CL@:+-- 'mkCL' and 'mkCLFromSignificance' (and corresponding variant+-- returning @Maybe@). First creates @CL@ from confidence level and+-- second from @1 - CL@ or significance level.+--+-- >>> cl95+-- mkCLFromSignificance 5.0e-2+--+-- Prior to 0.14 confidence levels were passed to function as plain+-- @Doubles@. Use 'mkCL' to convert them to @CL@.+newtype CL a = CL a+               deriving (Eq, Typeable, Data, Generic)++instance Show a => Show (CL a) where+  showsPrec n (CL p) = defaultShow1 "mkCLFromSignificance" p n+instance (Num a, Ord a, Read a) => Read (CL a) where+  readPrec = defaultReadPrecM1 "mkCLFromSignificance" mkCLFromSignificanceE++instance (Binary a, Num a, Ord a) => Binary (CL a) where+  put (CL p) = put p+  get        = maybe (fail errMkCL) return . mkCLFromSignificanceE =<< get++instance (ToJSON a)                 => ToJSON   (CL a)+instance (FromJSON a, Num a, Ord a) => FromJSON (CL a) where+  parseJSON = maybe (fail errMkCL) return . mkCLFromSignificanceE <=< parseJSON++instance NFData   a => NFData   (CL a) where+  rnf (CL a) = rnf a++-- |+-- >>> cl95 > cl90+-- True+instance Ord a => Ord (CL a) where+  CL a <  CL b = a >  b+  CL a <= CL b = a >= b+  CL a >  CL b = a <  b+  CL a >= CL b = a <= b+  max (CL a) (CL b) = CL (min a b)+  min (CL a) (CL b) = CL (max a b)+++-- | Create confidence level from probability β or probability+--   confidence interval contain true value of estimate. Will throw+--   exception if parameter is out of [0,1] range+--+-- >>> mkCL 0.95    -- same as cl95+-- mkCLFromSignificance 5.0000000000000044e-2+mkCL :: (Ord a, Num a) => a -> CL a+mkCL+  = fromMaybe (error "Statistics.Types.mkCL: probability is out if [0,1] range")+  . mkCLE++-- | Same as 'mkCL' but returns @Nothing@ instead of error if+--   parameter is out of [0,1] range+--+-- >>> mkCLE 0.95    -- same as cl95+-- Just (mkCLFromSignificance 5.0000000000000044e-2)+mkCLE :: (Ord a, Num a) => a -> Maybe (CL a)+mkCLE p+  | p >= 0 && p <= 1 = Just $ CL (1 - p)+  | otherwise        = Nothing++-- | Create confidence level from probability α or probability that+--   confidence interval does not contain true value of estimate. Will+--   throw exception if parameter is out of [0,1] range+--+-- >>> mkCLFromSignificance 0.05    -- same as cl95+-- mkCLFromSignificance 5.0e-2+mkCLFromSignificance :: (Ord a, Num a) => a -> CL a+mkCLFromSignificance = fromMaybe (error errMkCL) . mkCLFromSignificanceE++-- | Same as 'mkCLFromSignificance' but returns @Nothing@ instead of error if+--   parameter is out of [0,1] range+--+-- >>> mkCLFromSignificanceE 0.05    -- same as cl95+-- Just (mkCLFromSignificance 5.0e-2)+mkCLFromSignificanceE :: (Ord a, Num a) => a -> Maybe (CL a)+mkCLFromSignificanceE p+  | p >= 0 && p <= 1 = Just $ CL p+  | otherwise        = Nothing++errMkCL :: String+errMkCL = "Statistics.Types.mkPValCL: probability is out if [0,1] range"+++-- | Get confidence level. This function is subject to rounding+--   errors. If @1 - CL@ is needed use 'significanceLevel' instead+confidenceLevel :: (Num a) => CL a -> a+confidenceLevel (CL p) = 1 - p++-- | Get significance level.+significanceLevel :: CL a -> a+significanceLevel (CL p) = p++++-- | 90% confidence level+cl90 :: Fractional a => CL a+cl90 = CL 0.10++-- | 95% confidence level+cl95 :: Fractional a => CL a+cl95 = CL 0.05++-- | 99% confidence level+cl99 :: Fractional a => CL a+cl99 = CL 0.01++++----------------------------------------------------------------+-- Data type for p-value+----------------------------------------------------------------++-- | Newtype wrapper for p-value.+newtype PValue a = PValue a+               deriving (Eq,Ord, Typeable, Data, Generic)++instance Show a => Show (PValue a) where+  showsPrec n (PValue p) = defaultShow1 "mkPValue" p n+instance (Num a, Ord a, Read a) => Read (PValue a) where+  readPrec = defaultReadPrecM1 "mkPValue" mkPValueE++instance (Binary a, Num a, Ord a) => Binary (PValue a) where+  put (PValue p) = put p+  get            = maybe (fail errMkPValue) return . mkPValueE =<< get++instance (ToJSON a)                 => ToJSON   (PValue a)+instance (FromJSON a, Num a, Ord a) => FromJSON (PValue a) where+  parseJSON = maybe (fail errMkPValue) return . mkPValueE <=< parseJSON++instance NFData a => NFData (PValue a) where+  rnf (PValue a) = rnf a+++-- | Construct PValue. Throws error if argument is out of [0,1] range.+--+mkPValue :: (Ord a, Num a) => a -> PValue a+mkPValue = fromMaybe (error errMkPValue) . mkPValueE++-- | Construct PValue. Returns @Nothing@ if argument is out of [0,1] range.+mkPValueE :: (Ord a, Num a) => a -> Maybe (PValue a)+mkPValueE p+  | p >= 0 && p <= 1 = Just $ PValue p+  | otherwise        = Nothing++-- | Get p-value+pValue :: PValue a -> a+pValue (PValue p) = p+++-- | P-value expressed in sigma. This is convention widely used in+--   experimental physics. N sigma confidence level corresponds to+--   probability within N sigma of normal distribution.+--+--   Note that this correspondence is for normal distribution. Other+--   distribution will have different dependency. Also experimental+--   distribution usually only approximately normal (especially at+--   extreme tails).+nSigma :: Double -> PValue Double+nSigma n+  | n > 0     = PValue $ 2 * cumulative standard (-n)+  | otherwise = error "Statistics.Extra.Error.nSigma: non-positive number of sigma"++-- | P-value expressed in sigma for one-tail hypothesis. This correspond to+--   probability of obtaining value less than @N·σ@.+nSigma1 :: Double -> PValue Double+nSigma1 n+  | n > 0     = PValue $ cumulative standard (-n)+  | otherwise = error "Statistics.Extra.Error.nSigma1: non-positive number of sigma"++-- | Express confidence level in sigmas+getNSigma :: PValue Double -> Double+getNSigma (PValue p) = negate $ quantile standard (p / 2)++-- | Express confidence level in sigmas for one-tailed hypothesis.+getNSigma1 :: PValue Double -> Double+getNSigma1 (PValue p) = negate $ quantile standard p++++errMkPValue :: String+errMkPValue = "Statistics.Types.mkPValue: probability is out if [0,1] range"++++----------------------------------------------------------------+-- Point estimates+----------------------------------------------------------------++-- |+-- A point estimate and its confidence interval. It's parametrized by+-- both error type @e@ and value type @a@. This module provides two+-- types of error: 'NormalErr' for normally distributed errors and+-- 'ConfInt' for error with normal distribution. See their+-- documentation for more details.+--+-- For example @144 ± 5@ (assuming normality) could be expressed as+--+-- > Estimate { estPoint = 144+-- >          , estError = NormalErr 5+-- >          }+--+-- Or if we want to express @144 + 6 - 4@ at CL95 we could write:+--+-- > Estimate { estPoint = 144+-- >          , estError = ConfInt+-- >                       { confIntLDX = 4+-- >                       , confIntUDX = 6+-- >                       , confIntCL  = cl95+-- >                       }+-- >          }+--+-- Prior to statistics 0.14 @Estimate@ data type used following definition:+--+-- > data Estimate = Estimate {+-- >      estPoint           :: {-# UNPACK #-} !Double+-- >    , estLowerBound      :: {-# UNPACK #-} !Double+-- >    , estUpperBound      :: {-# UNPACK #-} !Double+-- >    , estConfidenceLevel :: {-# UNPACK #-} !Double+-- >    }+--+-- Now type @Estimate ConfInt Double@ should be used instead. Function+-- 'estimateFromInterval' allow to easily construct estimate from same inputs.+data Estimate e a = Estimate+    { estPoint           :: !a+      -- ^ Point estimate.+    , estError           :: !(e a)+      -- ^ Confidence interval for estimate.+    } deriving (Eq, Read, Show, Generic+               , Typeable, Data+               )++instance (Binary   (e a), Binary   a) => Binary   (Estimate e a) where+  get = liftM2 Estimate get get+  put (Estimate ep ee) = put ep >> put ee+instance (FromJSON (e a), FromJSON a) => FromJSON (Estimate e a)+instance (ToJSON   (e a), ToJSON   a) => ToJSON   (Estimate e a)+instance (NFData   (e a), NFData   a) => NFData   (Estimate e a) where+    rnf (Estimate x dx) = rnf x `seq` rnf dx++++-- |+-- Normal errors. They are stored as 1σ errors which corresponds to+-- 68.8% CL. Since we can recalculate them to any confidence level if+-- needed we don't store it.+newtype NormalErr a = NormalErr+  { normalError :: a+  }+  deriving (Eq, Read, Show, Typeable, Data, Generic)++instance Binary   a => Binary   (NormalErr a) where+  get = fmap NormalErr get+  put = put . normalError+instance FromJSON a => FromJSON (NormalErr a)+instance ToJSON   a => ToJSON   (NormalErr a)+instance NFData   a => NFData   (NormalErr a) where+    rnf (NormalErr x) = rnf x+++-- | Confidence interval. It assumes that confidence interval forms+--   single interval and isn't set of disjoint intervals.+data ConfInt a = ConfInt+  { confIntLDX :: !a+    -- ^ Lower error estimate, or distance between point estimate and+    --   lower bound of confidence interval.+  , confIntUDX :: !a+    -- ^ Upper error estimate, or distance between point estimate and+    --   upper bound of confidence interval.+  , confIntCL  :: !(CL Double)+    -- ^ Confidence level corresponding to given confidence interval.+  }+  deriving (Read,Show,Eq,Typeable,Data,Generic)++instance Binary   a => Binary   (ConfInt a) where+  get = liftM3 ConfInt get get get+  put (ConfInt l u cl) = put l >> put u >> put cl +instance FromJSON a => FromJSON (ConfInt a)+instance ToJSON   a => ToJSON   (ConfInt a)+instance NFData   a => NFData   (ConfInt a) where+    rnf (ConfInt x y _) = rnf x `seq` rnf y++++----------------------------------------+-- Constructors++-- | Create estimate with normal errors+estimateNormErr :: a            -- ^ Point estimate+                -> a            -- ^ 1σ error+                -> Estimate NormalErr a+estimateNormErr x dx = Estimate x (NormalErr dx)++-- | Synonym for 'estimateNormErr'+(±) :: a      -- ^ Point estimate+    -> a      -- ^ 1σ error+    -> Estimate NormalErr a+(±) = estimateNormErr++-- | Create estimate with asymmetric error.+estimateFromErr+  :: a                     -- ^ Central estimate+  -> (a,a)                 -- ^ Lower and upper errors. Both should be+                           --   positive but it's not checked.+  -> CL Double             -- ^ Confidence level for interval+  -> Estimate ConfInt a+estimateFromErr x (ldx,udx) cl = Estimate x (ConfInt ldx udx cl)++-- | Create estimate with asymmetric error.+estimateFromInterval+  :: Num a+  => a                     -- ^ Point estimate. Should lie within+                           --   interval but it's not checked.+  -> (a,a)                 -- ^ Lower and upper bounds of interval+  -> CL Double             -- ^ Confidence level for interval+  -> Estimate ConfInt a+estimateFromInterval x (lx,ux) cl+  = Estimate x (ConfInt (x-lx) (ux-x) cl)+++----------------------------------------+-- Accessors++-- | Get confidence interval+confidenceInterval :: Num a => Estimate ConfInt a -> (a,a)+confidenceInterval (Estimate x (ConfInt ldx udx _))+  = (x - ldx, x + udx)++-- | Get asymmetric errors+asymErrors :: Estimate ConfInt a -> (a,a)+asymErrors (Estimate _ (ConfInt ldx udx _)) = (ldx,udx)++++-- | Data types which could be multiplied by constant.+class Scale e where+  scale :: (Ord a, Num a) => a -> e a -> e a++instance Scale NormalErr where+  scale a (NormalErr e) = NormalErr (abs a * e)++instance Scale ConfInt where+  scale a (ConfInt l u cl) | a >= 0    = ConfInt  (a*l)  (a*u) cl+                           | otherwise = ConfInt (-a*u) (-a*l) cl++instance Scale e => Scale (Estimate e) where+  scale a (Estimate x dx) = Estimate (a*x) (scale a dx)++++----------------------------------------------------------------+-- Upper/lower limit+----------------------------------------------------------------++-- | Upper limit. They are usually given for small non-negative values+--   when it's not possible detect difference from zero.+data UpperLimit a = UpperLimit+    { upperLimit        :: !a+      -- ^ Upper limit+    , ulConfidenceLevel :: !(CL Double)+      -- ^ Confidence level for which limit was calculated+    } deriving (Eq, Read, Show, Typeable, Data, Generic)+++instance Binary   a => Binary   (UpperLimit a) where+  get = liftM2 UpperLimit get get+  put (UpperLimit l cl) = put l >> put cl+instance FromJSON a => FromJSON (UpperLimit a)+instance ToJSON   a => ToJSON   (UpperLimit a)+instance NFData   a => NFData   (UpperLimit a) where+    rnf (UpperLimit x cl) = rnf x `seq` rnf cl++++-- | Lower limit. They are usually given for large quantities when+--   it's not possible to measure them. For example: proton half-life+data LowerLimit a = LowerLimit {+    lowerLimit        :: !a+    -- ^ Lower limit+  , llConfidenceLevel :: !(CL Double)+    -- ^ Confidence level for which limit was calculated+  } deriving (Eq, Read, Show, Typeable, Data, Generic)++instance Binary   a => Binary   (LowerLimit a) where+  get = liftM2 LowerLimit get get+  put (LowerLimit l cl) = put l >> put cl+instance FromJSON a => FromJSON (LowerLimit a)+instance ToJSON   a => ToJSON   (LowerLimit a)+instance NFData   a => NFData   (LowerLimit a) where+    rnf (LowerLimit x cl) = rnf x `seq` rnf cl+++----------------------------------------------------------------+-- Deriving unbox instances+----------------------------------------------------------------++derivingUnbox "CL"+  [t| forall a. Unbox a => CL a -> a |]+  [| \(CL a) -> a |]+  [| CL           |]++derivingUnbox "PValue"+  [t| forall a. Unbox a => PValue a -> a |]+  [| \(PValue a) -> a |]+  [| PValue           |]++derivingUnbox "Estimate"+  [t| forall a e. (Unbox a, Unbox (e a)) => Estimate e a -> (a, e a) |]+  [| \(Estimate x dx) -> (x,dx) |]+  [| \(x,dx) -> (Estimate x dx) |]++derivingUnbox "NormalErr"+  [t| forall a. Unbox a => NormalErr a -> a |]+  [| \(NormalErr a) -> a |]+  [| NormalErr           |]++derivingUnbox "ConfInt"+  [t| forall a. Unbox a => ConfInt a -> (a, a, CL Double) |]+  [| \(ConfInt a b c) -> (a,b,c) |]+  [| \(a,b,c) -> ConfInt a b c   |]++derivingUnbox "UpperLimit"+  [t| forall a. Unbox a => UpperLimit a -> (a, CL Double) |]+  [| \(UpperLimit a b) -> (a,b) |]+  [| \(a,b) -> UpperLimit a b   |]++derivingUnbox "LowerLimit"+  [t| forall a. Unbox a => LowerLimit a -> (a, CL Double) |]+  [| \(LowerLimit a b) -> (a,b) |]+  [| \(a,b) -> LowerLimit a b   |]
+ Statistics/Types/Internal.hs view
@@ -0,0 +1,24 @@+-- |+-- Module    : Statistics.Types.Internal+-- Copyright : (c) 2009 Bryan O'Sullivan+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Types for working with statistics.+module Statistics.Types.Internal where+++import qualified Data.Vector.Unboxed as U (Vector)++-- | Sample data.+type Sample = U.Vector Double++-- | Sample with weights. First element of sample is data, second is weight+type WeightedSample = U.Vector (Double,Double)++-- | Weights for affecting the importance of elements of a sample.+type Weights = U.Vector Double+
+ bench-papi/Bench.hs view
@@ -0,0 +1,14 @@+-- |+-- Here we reexport definitions of tasty-bench+module Bench+  ( whnf+  , nf+  , nfIO+  , whnfIO+  , bench+  , bgroup+  , defaultMain+  , benchIngredients+  ) where++import Test.Tasty.PAPI
+ bench-time/Bench.hs view
@@ -0,0 +1,14 @@+-- |+-- Here we reexport definitions of tasty-bench+module Bench+  ( whnf+  , nf+  , nfIO+  , whnfIO+  , bench+  , bgroup+  , defaultMain+  , benchIngredients+  ) where++import Test.Tasty.Bench
+ benchmark/Main.hs view
@@ -0,0 +1,77 @@+module Main where++import Data.Complex+import Statistics.Sample+import Statistics.Transform+import Statistics.Correlation+import System.Random.MWC+import qualified Data.Vector.Unboxed as VU+import qualified Data.Vector.Unboxed.Mutable as MVU++import Bench+++-- Test sample+sample :: VU.Vector Double+sample = VU.create $ do g <- create+                        MVU.replicateM 10000 (uniform g)++-- Weighted test sample+sampleW :: VU.Vector (Double,Double)+sampleW = VU.zip sample (VU.reverse sample)++-- Complex vector for FFT tests+sampleC :: VU.Vector (Complex Double)+sampleC = VU.zipWith (:+) sample (VU.reverse sample)+++-- Simple benchmark for functions from Statistics.Sample+main :: IO ()+main =+  defaultMain+  [ bgroup "sample"+    [ bench "range"            $ nf (\x -> range x)            sample+      -- Mean+    , bench "mean"             $ nf (\x -> mean x)             sample+    , bench "meanWeighted"     $ nf (\x -> meanWeighted x)     sampleW+    , bench "harmonicMean"     $ nf (\x -> harmonicMean x)     sample+    , bench "geometricMean"    $ nf (\x -> geometricMean x)    sample+      -- Variance+    , bench "variance"         $ nf (\x -> variance x)         sample+    , bench "varianceUnbiased" $ nf (\x -> varianceUnbiased x) sample+    , bench "varianceWeighted" $ nf (\x -> varianceWeighted x) sampleW+      -- Correlation+    , bench "pearson"          $ nf pearson     sampleW+    , bench "covariance"       $ nf covariance  sampleW+    , bench "correlation"      $ nf correlation sampleW+    , bench "covariance2"      $ nf (covariance2  sample) sample+    , bench "correlation2"     $ nf (correlation2 sample) sample+      -- Other+    , bench "stdDev"           $ nf (\x -> stdDev x)           sample+    , bench "skewness"         $ nf (\x -> skewness x)         sample+    , bench "kurtosis"         $ nf (\x -> kurtosis x)         sample+      -- Central moments+    , bench "C.M. 2"           $ nf (\x -> centralMoment 2 x)  sample+    , bench "C.M. 3"           $ nf (\x -> centralMoment 3 x)  sample+    , bench "C.M. 4"           $ nf (\x -> centralMoment 4 x)  sample+    , bench "C.M. 5"           $ nf (\x -> centralMoment 5 x)  sample+    ]+  , bgroup "FFT"+    [ bgroup "fft"+      [ bench  (show n) $ whnf fft   (VU.take n sampleC) | n <- fftSizes ]+    , bgroup "ifft"+      [ bench  (show n) $ whnf ifft  (VU.take n sampleC) | n <- fftSizes ]+    , bgroup "dct"+      [ bench  (show n) $ whnf dct   (VU.take n sample)  | n <- fftSizes ]+    , bgroup "dct_"+      [ bench  (show n) $ whnf dct_  (VU.take n sampleC) | n <- fftSizes ]+    , bgroup "idct"+      [ bench  (show n) $ whnf idct  (VU.take n sample)  | n <- fftSizes ]+    , bgroup "idct_"+      [ bench  (show n) $ whnf idct_ (VU.take n sampleC) | n <- fftSizes ]+    ]+  ]+++fftSizes :: [Int]+fftSizes = [32,128,512,2048]
+ changelog.md view
@@ -0,0 +1,425 @@+## Changes in 0.16.5.0 [2026.01.09]++ * `ContGen` and `DiscreteGen` instances for `Poisson` distributions are added.+++## Changes in 0.16.4.0 [2025.10.23]++ * Bartlett's test (`Statistics.Test.Bartlett`) and Levene's test+   (`Statistics.Test.Levene`) for homogeneity of variances is added.++ * Improved performance in calculation of moments.++ * Improved precision in calculation of `logDensity` of Student T distribution.+++## Changes in 0.16.3.0++ * `S.Sample.correlation`, `S.Sample.covariance`,+   `S.Correlation.pearson` do not allocate temporary arrays.++ * Variants of correlation which take two vectors as input are added:+   `S.Sample.correlation2`, `S.Sample.covariance2`, `S.Correlation.pearson2`,+   `S.Correlation.spearman2`.++ * Contexts for `S.Function.indexed`, `S.Correlation.spearman`, `S.pairedTTest`,+   `S.Sample.correlation`, `S.Sample.covariance`, reduced.++ * Computation of `rSquare` in linear regression has special case for case when+   data variation is 0.++ * Doctests added.++ * Benchmarks using `tasty-bench` and `tasty-papi` added.++ * Spurious test failures fixed.+++## Changes in 0.16.2.1++ * Unnecessary constraint dropped from `tStatisticsPaired`.++ * Compatibility with QuickCheck-2.14. Test suite doesn't fail every time.+++## Changes in 0.16.2.0++ * Improved precision for `complCumulative` for hypergeometric and binomial+   distributions. Precision improvements of geometric distribution++ * Negative binomial distribution added.+++## Changes in 0.16.1.2++ * Fixed bug in `fromSample` for exponential distribudion (#190)+++## Changes in 0.16.1.0++ * Dependency on monad-par is dropped. `parMap` from `parallel` is used instead.+++## Changes in 0.16.0.2++ * Bug in constructor of binomial distribution is fixed (#181). It accepted+   out-of range probability before.+++## Changes in 0.16.0.0++ * Random number generation switched to API introduced in random-1.2++ * Support of GHC<7.10 is dropped++ * Fix for chi-squared test (#167) which was completely wrong++ * Computation of CDF and quantiles of Cauchy distribution is now numerically+   stable.++ * Fix loss of precision in computing of CDF of gamma distribution++ * Log-normal and Weibull distributions added.++ * `DiscreteGen` instance added for `DiscreteUniform`+++## Changes in 0.15.2.0++ * Test suite is finally fixed (#42, #123). It took very-very-very long+   time but finally happened.++ * Avoid loss of precision when computing CDF for exponential distribution.++ * Avoid loss of precision when computing CDF for geometric distribution. Add+   complement of CDF.++ * Correctly handle case of n=0 in poissonCI+++## Changes in 0.15.1.1++ * Fix build for GHC8.0 & 7.10+++## Changes in 0.15.1.0++ * GHCJS support++ * Concurrent resampling now uses `async` instead of hand-rolled primitives+++## Changes in 0.15.0.0++ * Modules `Statistics.Matrix.*` are split into new package+   `dense-linear-algebra` and exponent field is removed from `Matrix` data type.++ * Module `Statistics.Normalize` which contains functions for normalization of+   samples++ * Module `Statistics.Quantile` reworked:++   - `ContParam` given `Default` instance+   - `quantile` should be used instead of `continuousBy`+   - `median` and `mad` are added+   - `quantiles` and `quantilesVec` functions for computation of set of+     quantiles added.++ * Modules `Statistics.Function.Comparison` and `Statistics.Math.RootFinding`+   are removed. Corresponding functionality could be found in `math-functions`+   package.++ * Fix vector index out of bounds in `bootstrapBCA` and `bootstrapRegress`+   (see issue #149)++## Changes in 0.14.0.2++ * Compatibility fixes with older GHC+++## Changes in 0.14.0.1++ * Restored compatibility with GHC 7.4 & 7.6+++## Changes in 0.14.0.0++Breaking update. It seriously changes parts of API. It adds new data types for+dealing with estimates, confidence intervals, confidence levels and+p-value. Also API for statistical tests is changed.++ * Module `Statistis.Types` now contains new data types for estimates,+   upper/lower bounds, confidence level, and p-value.++	- `CL` for representing confidence level+	- `PValue` for representing p-values+	- `Estimate` data type moved here from `Statistis.Resampling.Bootstrap` and+      now parametrized by type of error.+	- `NormalError` — represents normal error.+    - `ConfInt` — generic confidence interval+    - `UpperLimit`,`LowerLimit` for upper/lower limits.++ * New API for statistical tests. Instead of simply return significant/not+   significant it returns p-value, test statistics and distribution of test+   statistics if it's available. Tests also return `Nothing` instead of throwing+   error if sample size is not sufficient. Fixes #25.++ * `Statistics.Tests.Types.TestType` data type dropped++ * New smart constructors for distributions are added. They return `Nothing` if+   parameters are outside of allowed range.++ * Serialization instances (`Show/Read, Binary, ToJSON/FromJSON`) for+   distributions no longer allows to create data types with invalid+   parameters. They will fail to parse. Cached values are not serialized either+   so `Binary` instances changed normal and F-distributions.++   Encoding to JSON changed for Normal, F-distribution, and χ²+   distributions. However data created using older statistics will be+   successfully decoded.++   Fixes #59.++ * Statistics.Resample.Bootstrap uses new data types for central estimates.++ * Function for calculation of confidence intervals for Poisson and binomial+   distribution added in `Statistics.ConfidenceInt`++ * Tests of position now allow to ask whether first sample on average larger+   than second, second larger than first or whether they differ significantly.+   Affects Wilcoxon-T, Mann-Whitney-U, and Student-T tests.++ * API for bootstrap changed. New data types added.++ * Bug fixes for #74, #81, #83, #92, #94++ * `complCumulative` added for many distributions.++++## Changes in 0.13.3.0++ * Kernel density estimation and FFT use generic versions now.++ * Code for calculation of Spearman and Pearson correlation added. Modules+   `Statistics.Correlation.Spearman` and `Statistics.Correlation.Pearson`.++ * Function for calculation covariance added in `Statistics.Sample`.++ * `Statistics.Function.pair` added. It zips vector and check that lengths are+   equal.++ * New functions added to `Statistics.Matrix`++ * Laplace distribution added.+++## Changes in 0.13.2.3++ * Vector dependency restored to >=0.10+++## Changes in 0.13.2.2++ * Vector dependency lowered to >=0.9+++## Changes in 0.13.2.1++ * Vector dependency bumped to >=0.10+++## Changes in 0.13.2.0++ * Support for regression bootstrap added+++## Changes in 0.13.1.1++ * Fix for out of bound access in bootstrap (see `bos/criterion#52`)+++## Changes in 0.13.1.0++  * All types now support JSON encoding and decoding.+++## Changes in 0.12.0.0++  * The `Statistics.Math` module has been removed, after being+    deprecated for several years.  Use the+    [math-functions](http://hackage.haskell.org/package/math-functions)+    package instead.++  * The `Statistics.Test.NonParametric` module has been removed, after+    being deprecated for several years.++  * Added support for Kendall's tau.++  * Added support for OLS regression.++  * Added basic 2D matrix support.++  * Added the Kruskal-Wallis test.++## Changes in 0.11.0.3++  * Fixed a subtle bug in calculation of the jackknifed unbiased variance.++  * The test suite now requires QuickCheck 2.7.++  * We now calculate quantiles for normal distribution in a more+    numerically stable way (bug #64).++## Changes in 0.10.6.0++  * The Estimator type has become an algebraic data type.  This allows+    the jackknife function to potentially use more efficient jackknife+    implementations.++  * jackknifeMean, jackknifeStdDev, jackknifeVariance,+    jackknifeVarianceUnb: new functions.  These have O(n) cost instead+    of the O(n^2) cost of the standard jackknife.++  * The mean function has been renamed to welfordMean; a new+    implementation of mean has better numerical accuracy in almost all+    cases.++## Changes in 0.10.5.2++  * histogram correctly chooses range when all elements in the sample are same+    (bug #57)+++## Changes in 0.10.5.1++  * Bug fix for S.Distributions.Normal.standard introduced in 0.10.5.0 (Bug #56)+++## Changes in 0.10.5.0++  * Enthropy type class for distributions is added.++  * Probability and probability density of distribution is given in+    log domain too.++## Changes in 0.10.4.0++  * Support for versions of GHC older than 7.2 is discontinued.++  * All datatypes now support 'Data.Binary' and 'GHC.Generics'.++## Changes in 0.10.3.0++  * Bug fixes++## Changes in 0.10.2.0++  * Bugs in DCT and IDCT are fixed.++  * Accessors for uniform distribution are added.++  * ContGen instances for all continuous distributions are added.++  * Beta distribution is added.++  * Constructor for improper gamma distribution is added.++  * Binomial distribution allows zero trials.++  * Poisson distribution now accept zero parameter.++  * Integer overflow in calculation of Wilcoxon-T test is fixed.++  * Bug in 'ContGen' instance for normal distribution is fixed.++## Changes in 0.10.1.0++  * Kolmogorov-Smirnov nonparametric test added.++  * Pearson chi squared test added.++  * Type class for generating random variates for given distribution+    is added.++  * Modules 'Statistics.Math' and 'Statistics.Constants' are moved to+    the `math-functions` package. They are still available but marked+    as deprecated.+++## Changes in 0.10.0.1++  * `dct` and `idct` now have type `Vector Double -> Vector Double`+++## Changes in 0.10.0.0++  * The type classes Mean and Variance are split in two. This is+    required for distributions which do not have finite variance or+    mean.++  * The S.Sample.KernelDensity module has been renamed, and+    completely rewritten to be much more robust.  The older module+    oversmoothed multi-modal data.  (The older module is still+    available under the name S.Sample.KernelDensity.Simple).++  * Histogram computation is added, in S.Sample.Histogram.++  * Discrete Fourie transform is added, in S.Transform++  * Root finding is added, in S.Math.RootFinding.++  * The complCumulative function is added to the Distribution+    class in order to accurately assess probabilities P(X>x) which are+    used in one-tailed tests.++  * A stdDev function is added to the Variance class for+    distributions.++  * The constructor S.Distribution.normalDistr now takes standard+    deviation instead of variance as its parameter.++  * A bug in S.Quantile.weightedAvg is fixed. It produced a wrong+    answer if a sample contained only one element.++  * Bugs in quantile estimations for chi-square and gamma distribution+    are fixed.++  * Integer overflow in mannWhitneyUCriticalValue is fixed. It+    produced incorrect critical values for moderately large+    samples. Something around 20 for 32-bit machines and 40 for 64-bit+    ones.++  * A bug in mannWhitneyUSignificant is fixed. If either sample was+    larger than 20, it produced a completely incorrect answer.++  * One- and two-tailed tests in S.Tests.NonParametric are selected+    with sum types instead of Bool.++  * Test results returned as enumeration instead of `Bool`.++  * Performance improvements for Mann-Whitney U and Wilcoxon tests.++  * Module `S.Tests.NonParamtric` is split into `S.Tests.MannWhitneyU`+    and `S.Tests.WilcoxonT`++  * sortBy is added to S.Function.++  * Mean and variance for gamma distribution are fixed.++  * Much faster cumulative probability functions for Poisson and+    hypergeometric distributions.++  * Better density functions for gamma and Poisson distributions.++  * Student-T, Fisher-Snedecor F-distributions and Cauchy-Lorentz+    distribution are added.++  * The function S.Function.create is removed. Use generateM from+    the vector package instead.++  * Function to perform approximate comparison of doubles is added to+    S.Function.Comparison++  * Regularized incomplete beta function and its inverse are added to+    S.Function
+ examples/kde/KDE.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE OverloadedStrings #-}++import Control.Applicative ((<$>))+import Statistics.Sample.KernelDensity (kde)+import Text.Hastache (MuType(..), defaultConfig, hastacheFile)+import Text.Hastache.Context (mkStrContext)+import qualified Data.Attoparsec.ByteString as B+import qualified Data.Attoparsec.ByteString.Char8 as A+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L+import qualified Data.Vector.Unboxed as U+import qualified Data.Text.Lazy.IO as TL++csv = do+  B.takeTill A.isEndOfLine+  (A.double `A.sepBy` A.char ',') `A.sepBy` A.endOfLine++main = do+  waits <- (either error (U.fromList . map last . filter (not.null)) .+            A.parseOnly csv) <$> B.readFile "data/faithful.csv"+  let xs = map (\(a,b) -> [a,b]) . U.toList . uncurry U.zip . kde 64 $ waits+      context "data" = MuVariable . show $ xs+  s <- hastacheFile defaultConfig "kde.tpl" (mkStrContext context)+  TL.writeFile "kde.html" s
+ examples/kde/data/faithful.csv view
@@ -0,0 +1,273 @@+eruption,wait+3.6,79+1.8,54+3.333,74+2.283,62+4.533,85+2.883,55+4.7,88+3.6,85+1.95,51+4.35,85+1.833,54+3.917,84+4.2,78+1.75,47+4.7,83+2.167,52+1.75,62+4.8,84+1.6,52+4.25,79+1.8,51+1.75,47+3.45,78+3.067,69+4.533,74+3.6,83+1.967,55+4.083,76+3.85,78+4.433,79+4.3,73+4.467,77+3.367,66+4.033,80+3.833,74+2.017,52+1.867,48+4.833,80+1.833,59+4.783,90+4.35,80+1.883,58+4.567,84+1.75,58+4.533,73+3.317,83+3.833,64+2.1,53+4.633,82+2,59+4.8,75+4.716,90+1.833,54+4.833,80+1.733,54+4.883,83+3.717,71+1.667,64+4.567,77+4.317,81+2.233,59+4.5,84+1.75,48+4.8,82+1.817,60+4.4,92+4.167,78+4.7,78+2.067,65+4.7,73+4.033,82+1.967,56+4.5,79+4,71+1.983,62+5.067,76+2.017,60+4.567,78+3.883,76+3.6,83+4.133,75+4.333,82+4.1,70+2.633,65+4.067,73+4.933,88+3.95,76+4.517,80+2.167,48+4,86+2.2,60+4.333,90+1.867,50+4.817,78+1.833,63+4.3,72+4.667,84+3.75,75+1.867,51+4.9,82+2.483,62+4.367,88+2.1,49+4.5,83+4.05,81+1.867,47+4.7,84+1.783,52+4.85,86+3.683,81+4.733,75+2.3,59+4.9,89+4.417,79+1.7,59+4.633,81+2.317,50+4.6,85+1.817,59+4.417,87+2.617,53+4.067,69+4.25,77+1.967,56+4.6,88+3.767,81+1.917,45+4.5,82+2.267,55+4.65,90+1.867,45+4.167,83+2.8,56+4.333,89+1.833,46+4.383,82+1.883,51+4.933,86+2.033,53+3.733,79+4.233,81+2.233,60+4.533,82+4.817,77+4.333,76+1.983,59+4.633,80+2.017,49+5.1,96+1.8,53+5.033,77+4,77+2.4,65+4.6,81+3.567,71+4,70+4.5,81+4.083,93+1.8,53+3.967,89+2.2,45+4.15,86+2,58+3.833,78+3.5,66+4.583,76+2.367,63+5,88+1.933,52+4.617,93+1.917,49+2.083,57+4.583,77+3.333,68+4.167,81+4.333,81+4.5,73+2.417,50+4,85+4.167,74+1.883,55+4.583,77+4.25,83+3.767,83+2.033,51+4.433,78+4.083,84+1.833,46+4.417,83+2.183,55+4.8,81+1.833,57+4.8,76+4.1,84+3.966,77+4.233,81+3.5,87+4.366,77+2.25,51+4.667,78+2.1,60+4.35,82+4.133,91+1.867,53+4.6,78+1.783,46+4.367,77+3.85,84+1.933,49+4.5,83+2.383,71+4.7,80+1.867,49+3.833,75+3.417,64+4.233,76+2.4,53+4.8,94+2,55+4.15,76+1.867,50+4.267,82+1.75,54+4.483,75+4,78+4.117,79+4.083,78+4.267,78+3.917,70+4.55,79+4.083,70+2.417,54+4.183,86+2.217,50+4.45,90+1.883,54+1.85,54+4.283,77+3.95,79+2.333,64+4.15,75+2.35,47+4.933,86+2.9,63+4.583,85+3.833,82+2.083,57+4.367,82+2.133,67+4.35,74+2.2,54+4.45,83+3.567,73+4.5,73+4.15,88+3.817,80+3.917,71+4.45,83+2,56+4.283,79+4.767,78+4.533,84+1.85,58+4.25,83+1.983,43+2.25,60+4.75,75+4.117,81+2.15,46+4.417,90+1.817,46+4.467,74
+ examples/kde/kde.html view
@@ -0,0 +1,28 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">+<html>+ <head>+    <meta http-equiv="Content-Type" content="text/html; charset=utf-8">+    <title>Kernel density</title>+    <!--[if lte IE 8]><script language="javascript" type="text/javascript" src="http://people.iola.dk/olau/flot/excanvas.min.js"></script><![endif]-->+    <script language="javascript" type="text/javascript" src="https://ajax.googleapis.com/ajax/libs/jquery/1.6.4/jquery.min.js"></script>+    <script language="javascript" type="text/javascript" src="http://people.iola.dk/olau/flot/jquery.flot.js"></script>+ </head>+    <body>+    <h1>Kernel density</h1>++    <div id="placeholder" style="width:600px;height:450px;"></div>++    <p>This is a 64-point kernel density estimate+      of <a href="http://stat.ethz.ch/R-manual/R-patched/library/datasets/html/faithful.html">wait+        times between eruptions</a> of+      the <a href="http://en.wikipedia.org/wiki/Old_Faithful">Old+      Faithful</a> geyser.</p>++<script type="text/javascript">+$(function () {+    $.plot($("#placeholder"), [ [[37.7,2.5161110551039025e-4],[38.709523809523816,4.447091645179541e-4],[39.71904761904762,8.89495267293151e-4],[40.72857142857143,1.6826638124416372e-3],[41.73809523809524,2.915853030152525e-3],[42.747619047619054,4.617384776241099e-3],[43.75714285714286,6.707125941058233e-3],[44.766666666666666,9.002680047224753e-3],[45.77619047619048,1.1289358222230473e-2],[46.78571428571429,1.3413998627118355e-2],[47.7952380952381,1.5334009498412205e-2],[48.804761904761904,1.7084636391985843e-2],[49.81428571428572,1.869160073198233e-2],[50.82380952380953,2.0093659237928833e-2],[51.833333333333336,2.1129704241951732e-2],[52.84285714285714,2.160813072660192e-2],[53.852380952380955,2.142690467760544e-2],[54.86190476190477,2.0663894588783302e-2],[55.871428571428574,1.9554774751720513e-2],[56.88095238095238,1.835784852185525e-2],[57.89047619047619,1.721364996782301e-2],[58.900000000000006,1.611898372722214e-2],[59.90952380952381,1.5018622544779535e-2],[60.91904761904762,1.3900964326230551e-2],[61.92857142857143,1.2803755503590803e-2],[62.938095238095244,1.175952549012556e-2],[63.94761904761905,1.0778427101353434e-2],[64.95714285714286,9.90254113687662e-3],[65.96666666666667,9.263754969613376e-3],[66.97619047619048,9.065069215913515e-3],[67.9857142857143,9.489824501493842e-3],[68.9952380952381,1.062157012231642e-2],[70.0047619047619,1.2443698406039176e-2],[71.01428571428572,1.4902887084493477e-2],[72.02380952380952,1.7957646715371086e-2],[73.03333333333333,2.155509535870428e-2],[74.04285714285714,2.5555036677672206e-2],[75.05238095238096,2.967437285217729e-2],[76.06190476190477,3.3517062326339185e-2],[77.07142857142857,3.6695760198314636e-2],[78.08095238095238,3.897328209325028e-2],[79.0904761904762,4.0310862807977195e-2],[80.1,4.076878209020111e-2],[81.10952380952381,4.034443197900639e-2],[82.11904761904762,3.8916020257382e-2],[83.12857142857143,3.6371579849283686e-2],[84.13809523809525,3.2813879362105385e-2],[85.14761904761905,2.8641170617233373e-2],[86.15714285714286,2.440986212690428e-2],[87.16666666666667,2.0578794105541566e-2],[88.17619047619047,1.7329418869432917e-2],[89.18571428571428,1.4578610745209346e-2],[90.1952380952381,1.2139322012628417e-2],[91.20476190476191,9.885013669357134e-3],[92.21428571428572,7.807129857922685e-3],[93.22380952380952,5.966284588636623e-3],[94.23333333333333,4.415584046924452e-3],[95.24285714285715,3.1632654187895254e-3],[96.25238095238095,2.1821132245726424e-3],[97.26190476190476,1.43459816068524e-3],[98.27142857142857,8.875453007766301e-4],[99.28095238095239,5.128125355532956e-4],[100.2904761904762,2.8384986932914304e-4],[101.3,1.768029983316066e-4]] ]);+});+</script>++ </body>+</html>
+ examples/kde/kde.tpl view
@@ -0,0 +1,28 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">+<html>+ <head>+    <meta http-equiv="Content-Type" content="text/html; charset=utf-8">+    <title>Kernel density</title>+    <!--[if lte IE 8]><script language="javascript" type="text/javascript" src="http://people.iola.dk/olau/flot/excanvas.min.js"></script><![endif]-->+    <script language="javascript" type="text/javascript" src="https://ajax.googleapis.com/ajax/libs/jquery/1.6.4/jquery.min.js"></script>+    <script language="javascript" type="text/javascript" src="http://people.iola.dk/olau/flot/jquery.flot.js"></script>+ </head>+    <body>+    <h1>Kernel density</h1>++    <div id="placeholder" style="width:600px;height:450px;"></div>++    <p>This is a 64-point kernel density estimate+      of <a href="http://stat.ethz.ch/R-manual/R-patched/library/datasets/html/faithful.html">wait+        times between eruptions</a> of+      the <a href="http://en.wikipedia.org/wiki/Old_Faithful">Old+      Faithful</a> geyser.</p>++<script type="text/javascript">+$(function () {+    $.plot($("#placeholder"), [ {{data}} ]);+});+</script>++ </body>+</html>
statistics.cabal view
@@ -1,71 +1,241 @@+cabal-version:  3.0+build-type:     Simple+ name:           statistics-version:        0.4.1+version:        0.16.5.0 synopsis:       A library of statistical types, data, and functions description:   This library provides a number of common functions and types useful-  in statistics.  Our focus is on high performance, numerical-  robustness, and use of good algorithms.  Where possible, we provide+  in statistics.  We focus on high performance, numerical robustness,+  and use of good algorithms.  Where possible, we provide   references to the statistical literature.   .-  The library's facilities can be divided into three broad categories:+  The library's facilities can be divided into four broad categories:   .-  Working with widely used discrete and continuous probability-  distributions.  (There are dozens of exotic distributions in use; we-  focus on the most common.)+  * Working with widely used discrete and continuous probability+    distributions.  (There are dozens of exotic distributions in use;+    we focus on the most common.)   .-  Computing with sample data: quantile estimation, kernel density-  estimation, bootstrap methods, and autocorrelation analysis.+  * Computing with sample data: quantile estimation, kernel density+    estimation, histograms, bootstrap methods, significance testing,+    and regression and autocorrelation analysis.   .-  Random variate generation under several different distributions.-license:        BSD3+  * Random variate generation under several different distributions.+  .+  * Common statistical tests for significant differences between+    samples.++license:        BSD-2-Clause license-file:   LICENSE-homepage:       http://darcs.serpentine.com/statistics-author:         Bryan O'Sullivan <bos@serpentine.com>-maintainer:     Bryan O'Sullivan <bos@serpentine.com>-copyright:      2009 Bryan O'Sullivan+homepage:       https://github.com/haskell/statistics+bug-reports:    https://github.com/haskell/statistics/issues+author:         Bryan O'Sullivan <bos@serpentine.com>, Alexey Khudaykov <alexey.skladnoy@gmail.com>+maintainer:     Alexey Khudaykov <alexey.skladnoy@gmail.com>+copyright:      2009-2014 Bryan O'Sullivan category:       Math, Statistics-build-type:     Simple-cabal-version:  >= 1.2-extra-source-files: README +extra-source-files:+  README.markdown+  examples/kde/KDE.hs+  examples/kde/data/faithful.csv+  examples/kde/kde.html+  examples/kde/kde.tpl+  tests/utils/Makefile+  tests/utils/fftw.c++extra-doc-files:+  changelog.md++tested-with:+  GHC ==8.4.4+   || ==8.6.5+   || ==8.8.4+   || ==8.10.7+   || ==9.0.2+   || ==9.2.8+   || ==9.4.8+   || ==9.6.7+   || ==9.8.4+   || ==9.10.2+   || ==9.12.2++source-repository head+  type:     git+  location: https://github.com/haskell/statistics++flag BenchPAPI+  Description: Enable building of benchmarks which use instruction counters.+               It requires libpapi and only works on Linux so it's protected by flag+  Default: False+  Manual:  True+ library+  default-language: Haskell2010   exposed-modules:     Statistics.Autocorrelation-    Statistics.Constants+    Statistics.ConfidenceInt+    Statistics.Correlation+    Statistics.Correlation.Kendall     Statistics.Distribution+    Statistics.Distribution.Beta     Statistics.Distribution.Binomial+    Statistics.Distribution.CauchyLorentz+    Statistics.Distribution.ChiSquared+    Statistics.Distribution.DiscreteUniform+    Statistics.Distribution.Exponential+    Statistics.Distribution.FDistribution     Statistics.Distribution.Gamma     Statistics.Distribution.Geometric-    Statistics.Distribution.Exponential     Statistics.Distribution.Hypergeometric+    Statistics.Distribution.Laplace+    Statistics.Distribution.Lognormal+    Statistics.Distribution.NegativeBinomial     Statistics.Distribution.Normal     Statistics.Distribution.Poisson+    Statistics.Distribution.StudentT+    Statistics.Distribution.Transform+    Statistics.Distribution.Uniform+    Statistics.Distribution.Weibull     Statistics.Function-    Statistics.KernelDensity-    Statistics.Math     Statistics.Quantile-    Statistics.RandomVariate+    Statistics.Regression     Statistics.Resampling     Statistics.Resampling.Bootstrap     Statistics.Sample+    Statistics.Sample.Internal+    Statistics.Sample.Histogram+    Statistics.Sample.KernelDensity+    Statistics.Sample.KernelDensity.Simple+    Statistics.Sample.Normalize     Statistics.Sample.Powers+    Statistics.Test.Bartlett+    Statistics.Test.Levene+    Statistics.Test.ChiSquared+    Statistics.Test.KolmogorovSmirnov+    Statistics.Test.KruskalWallis+    Statistics.Test.MannWhitneyU+--    Statistics.Test.Runs+    Statistics.Test.StudentT+    Statistics.Test.Types+    Statistics.Test.WilcoxonT+    Statistics.Transform     Statistics.Types   other-modules:+    Statistics.Distribution.Poisson.Internal     Statistics.Internal-  build-depends:-    base < 5,-    erf,-    mwc-random,-    time,-    uvector >= 0.1.0.4,-    uvector-algorithms >= 0.2-  if impl(ghc >= 6.10)+    Statistics.Test.Internal+    Statistics.Types.Internal+  build-depends: base                    >= 4.9 && < 5+                 --+               , math-functions          >= 0.3.4.1+               , mwc-random              >= 0.15.3.0+               , random                  >= 1.2+                 --+               , aeson                   >= 0.6.0.0+               , async                   >= 2.2.2 && <2.3+               , deepseq                 >= 1.1.0.2+               , binary                  >= 0.5.1.0+               , primitive               >= 0.3+               , dense-linear-algebra    >= 0.1 && <0.2+               , parallel                >= 3.2.2.0 && <3.4+               , vector                  >= 0.10+               , vector-algorithms       >= 0.4+               , vector-th-unbox+               , vector-binary-instances >= 0.2.1+               , data-default-class      >= 0.1.2++  -- Older GHC+  if impl(ghc < 7.6)     build-depends:-      base >= 4+      ghc-prim+  ghc-options: -O2 -Wall -fwarn-tabs -funbox-strict-fields -  -- gather extensive profiling data for now-  ghc-prof-options: -auto-all+test-suite statistics-tests+  default-language: Haskell2010+  type:           exitcode-stdio-1.0+  hs-source-dirs: tests+  main-is:        tests.hs+  other-modules:+    Tests.ApproxEq+    Tests.Correlation+    Tests.Distribution+    Tests.ExactDistribution+    Tests.Function+    Tests.Helpers+    Tests.KDE+    Tests.Matrix+    Tests.Matrix.Types+    Tests.NonParametric+    Tests.NonParametric.Table+    Tests.Orphanage+    Tests.Parametric+    Tests.Serialization+    Tests.Transform+    Tests.Quantile+  ghc-options:+    -Wall -threaded -rtsopts -fsimpl-tick-factor=500+  if impl(ghc >= 9.8)+    ghc-options: -Wno-x-partial+  build-depends: base+               , statistics+               , dense-linear-algebra+               , QuickCheck >= 2.7.5+               , binary+               , erf+               , aeson+               , ieee754 >= 0.7.3+               , math-functions+               , primitive+               , tasty+               , tasty-hunit+               , tasty-quickcheck+               , tasty-expected-failure+               , vector+               , vector-algorithms -  ghc-options: -Wall -funbox-strict-fields-  if impl(ghc >= 6.8)-    ghc-options: -fwarn-tabs+test-suite statistics-doctests+  default-language: Haskell2010+  type:             exitcode-stdio-1.0+  hs-source-dirs:   tests+  main-is:          doctest.hs+  if impl(ghcjs) || impl(ghc < 8.0)+    Buildable: False+  -- Linker on macos prints warnings to console which confuses doctests.+  -- We simply disable doctests on ma for older GHC+  -- > warning: -single_module is obsolete+  if os(darwin) && impl(ghc < 9.6)+    buildable: False+  build-depends:+            base       -any+          , statistics -any+          , doctest    >=0.15 && <0.25++-- We want to be able to build benchmarks using both tasty-bench and tasty-papi.+-- They have similar API so we just create two shim modules which reexport+-- definitions from corresponding library and pick one in cabal file.+common bench-stanza+  ghc-options:      -Wall+  default-language: Haskell2010+  build-depends: base < 5+               , vector          >= 0.12.3+               , statistics+               , mwc-random+               , tasty           >=1.3.1++benchmark statistics-bench+  import:         bench-stanza+  type:           exitcode-stdio-1.0+  hs-source-dirs: benchmark bench-time+  main-is:        Main.hs+  Other-modules:  Bench+  build-depends:  tasty-bench >= 0.3++benchmark statistics-bench-papi+  import:         bench-stanza+  type:           exitcode-stdio-1.0+  if impl(ghcjs) || !flag(BenchPAPI)+     buildable: False+  hs-source-dirs: benchmark bench-papi+  main-is:        Main.hs+  Other-modules:  Bench+  build-depends:  tasty-papi >= 0.1.2
+ tests/Tests/ApproxEq.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances, TypeFamilies #-}++module Tests.ApproxEq+    (+      ApproxEq(..)+    ) where++import Data.Complex (Complex(..), realPart)+import Data.List (intersperse)+import Data.Maybe (catMaybes)+import Numeric.MathFunctions.Constants (m_epsilon)+import Statistics.Matrix hiding (map, toList)+import Test.QuickCheck+import qualified Data.Vector as V+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Unboxed as U+import qualified Statistics.Matrix as M++class (Eq a, Show a) => ApproxEq a where+    type Bounds a++    eq   :: Bounds a -> a -> a -> Bool+    eql  :: Bounds a -> a -> a -> Property+    eql eps a b = counterexample (show a ++ " /=~ " ++ show b) (eq eps a b)++    (=~)  :: a -> a -> Bool++    (==~) :: a -> a -> Property+    a ==~ b = counterexample (show a ++ " /=~ " ++ show b) (a =~ b)++instance ApproxEq Double where+    type Bounds Double = Double++    eq eps a b+      | a == 0 && b == 0 = True+      | otherwise        = abs (a - b) <= eps * max (abs a) (abs b)+    (=~)  = eq m_epsilon++instance ApproxEq (Complex Double) where+    type Bounds (Complex Double) = Double++    eq eps a@(ar :+ ai) b@(br :+ bi)+      | a == 0 && b == 0 = True+      | otherwise        = abs (ar - br) <= eps * d+                        && abs (ai - bi) <= eps * d+      where+        d = max (realPart $ abs a) (realPart $ abs b)++    (=~)  = eq m_epsilon++instance ApproxEq [Double] where+    type Bounds [Double] = Double++    eq  eps (x:xs) (y:ys) = eq eps x y && eq eps xs ys+    eq  _   []     []     = True+    eq  _   _      _      = False++    eql   = eqll length id id+    (=~)  = eq m_epsilon+    (==~) = eql m_epsilon++instance ApproxEq (U.Vector Double) where+    type Bounds (U.Vector Double) = Double++    eq    = eqv+    (=~)  = eq m_epsilon+    eql   = eqlv+    (==~) = eqlv m_epsilon++instance ApproxEq (V.Vector Double) where+    type Bounds (V.Vector Double) = Double++    eq    = eqv+    (=~)  = eq m_epsilon+    eql   = eqlv+    (==~) = eqlv m_epsilon++instance ApproxEq Matrix where+    type Bounds Matrix = Double++    eq eps (Matrix r1 c1 v1) (Matrix r2 c2 v2) =+      (r1,c1) == (r2,c2) && eq eps v1 v2+    (=~)  = eq m_epsilon+    eql eps a b = eqll dimension M.toList (`quotRem` cols a) eps a b+    (==~) = eql m_epsilon++eqv :: (ApproxEq a, G.Vector v Bool, G.Vector v a) =>+       Bounds a -> v a -> v a -> Bool+eqv eps a b = G.length a == G.length b && G.and (G.zipWith (eq eps) a b)++eqlv :: (ApproxEq [a], G.Vector v a) => Bounds [a] -> v a -> v a -> Property+eqlv eps a b = eql eps (G.toList a) (G.toList b)++eqll :: (ApproxEq l, ApproxEq a, Show c, Show d, Eq d, Bounds l ~ Bounds a) =>+        (l -> d) -> (l -> [a]) -> (Int -> c) -> Bounds l -> l -> l -> Property+eqll dim toList coord eps a b = counterexample fancy $ eq eps a b+  where+    fancy+      | la /= lb  = "size mismatch: " ++ show la ++ " /= " ++ show lb+      | length summary < length full = summary+      | otherwise = full+    summary = concat . intersperse ", " . catMaybes $+              zipWith3 whee (map coord [(0::Int)..]) xs ys+    full | '\n' `elem` sa = sa ++ "  /=~\n" ++ sb+         | otherwise      = sa ++ " /=~" ++ sb+    (sa, sb) = (show a, show b)+    (xs, ys) = (toList a, toList b)+    (la, lb) = (dim a, dim b)+    whee i x y | eq eps x y = Nothing+               | otherwise  = Just $ show i ++ ": " ++ show x ++ " /=~ " ++ show y
+ tests/Tests/Correlation.hs view
@@ -0,0 +1,171 @@+{-#LANGUAGE BangPatterns #-}++module Tests.Correlation+    ( tests ) where++import Control.Arrow (Arrow(..))+import qualified Data.Vector as V+import Data.Maybe+import Statistics.Correlation+import Statistics.Correlation.Kendall+import Test.Tasty+import Test.Tasty.QuickCheck hiding (sample)+import Test.Tasty.HUnit++import Tests.ApproxEq++----------------------------------------------------------------+-- Tests list+----------------------------------------------------------------++tests :: TestTree+tests = testGroup "Correlation"+    [ testProperty "Pearson correlation"           testPearson+    , testProperty "Spearman correlation is scale invariant" testSpearmanScale+    , testProperty "Spearman correlation, nonlinear"         testSpearmanNonlinear+    , testProperty "Kendall test -- general"       testKendall+    , testCase     "Kendall test -- special cases" testKendallSpecial+    ]+++----------------------------------------------------------------+-- Pearson's correlation+----------------------------------------------------------------++testPearson :: [(Double,Double)] -> Property+testPearson sample+  = (length sample > 1 && isJust exact) ==> (case exact of+                                               Just e  -> e ~= fast+                                               Nothing -> property False+                                            )+  where+    (~=) = eql 1e-12+    exact = exactPearson $ map (realToFrac *** realToFrac) sample+    fast  = pearson $ V.fromList sample++exactPearson :: [(Rational,Rational)] -> Maybe Double+exactPearson sample+  | varX == 0 || varY == 0 = Nothing+  | otherwise              = Just $ realToFrac cov / sqrt (realToFrac (varX * varY))+  where+    (xs,ys) = unzip sample+    n       = fromIntegral $ length sample+    -- Mean+    muX  = sum xs / n+    muY  = sum ys / n+    -- Mean of squares+    muX2 = sum (map (\x->x*x) xs) / n+    muY2 = sum (map (\x->x*x) ys) / n+    -- Covariance+    cov  = sum (zipWith (*) [x - muX | x<-xs] [y - muY | y<-ys]) / n+    varX = muX2 - muX*muX+    varY = muY2 - muY*muY++----------------------------------------------------------------+-- Spearman's correlation+----------------------------------------------------------------++-- Test that Spearman correlation is scale invariant+testSpearmanScale :: [(Double,Double)] -> Double -> Property+testSpearmanScale xs a+  = and [ length xs > 1       -- Enough to calculate underflow+        , a /= 0+        , not (isNaN c1)+        , not (isNaN c2)+        , not (isNaN c3)+        , not (isNaN c4)+        ]+  ==> ( counterexample (show xs2)+      $ counterexample (show xs3)+      $ counterexample (show xs4)+      $ counterexample (show (c1,c2,c3,c4))+      $ and [ c1 == c4+           , c1 == signum a * c2+           , c1 == signum a * c3+           ]+      )+  where+    xs2 = map ((*a) *** id  ) xs+    xs3 = map (id   *** (*a)) xs+    xs4 = map ((*a) *** (*a)) xs+    c1 = spearman $ V.fromList xs+    c2 = spearman $ V.fromList xs2+    c3 = spearman $ V.fromList xs3+    c4 = spearman $ V.fromList xs4++-- Test that Spearman correlation allows to transform sample with+testSpearmanNonlinear :: [(Double,Double)] -> Property+testSpearmanNonlinear sample0+  = and [ length sample0 > 1+        , not (isNaN c1)+        , not (isNaN c2)+        , not (isNaN c3)+        , not (isNaN c4)+        ]+  ==> ( counterexample ("S0 = " ++ show sample0)+      $ counterexample ("S1 = " ++ show sample1)+      $ counterexample ("S2 = " ++ show sample2)+      $ counterexample ("S3 = " ++ show sample3)+      $ counterexample ("S4 = " ++ show sample4)+      $ counterexample (show (c1,c2,c3,c4))+      $ and [ c1 == c2+            , c1 == c3+            , c1 == c4+            ]+      )+  where+    -- We need to stretch sample into [-10 .. 10] range to avoid+    -- problems with under/overflows etc.+    stretch xs+      | a == b    = xs+      | otherwise = [ ((x - a)/(b - a) - 0.5) * 20 | x <- xs ]+      where+        a = minimum xs+        b = maximum xs+    sample1 = uncurry zip $ (stretch *** stretch) $ unzip sample0+    sample2 = map (exp *** id ) sample1+    sample3 = map (id  *** exp) sample1+    sample4 = map (exp *** exp) sample1+    c1 = spearman $ V.fromList sample1+    c2 = spearman $ V.fromList sample2+    c3 = spearman $ V.fromList sample3+    c4 = spearman $ V.fromList sample4+++----------------------------------------------------------------+-- Kendall's correlation+----------------------------------------------------------------++testKendall :: [(Double, Double)] -> Bool+testKendall xy | isNaN r1 = isNaN r2+               | otherwise = r1 == r2+  where+    r1 = kendallBruteForce xy+    r2 = kendall $ V.fromList xy++testKendallSpecial :: Assertion+testKendallSpecial = vs @=? map (\(xs, ys) -> kendall $ V.fromList $ zip xs ys) d+  where+    (d, vs) = unzip testData+    testData :: [(([Double], [Double]), Double)]+    testData = [ (([1, 2, 3, 1, 2], [1, 2, 1, 5, 2]), -0.375)+               , (([1, 1, 1, 3, 3], [3, 3, 3, 2, 5]), 0)+               ]+++kendallBruteForce :: [(Double, Double)] -> Double+kendallBruteForce xy = (n_c - n_d) / sqrt ((n_0 - n_1) * (n_0 - n_2))+  where+    allPairs = f xy+    (n_c, n_d, n_1, n_2) = foldl g (0,0,0,0) allPairs+    n_0 = fromIntegral.length $ allPairs+    g (!nc, !nd, !n1, !n2) ((x1, y1), (x2, y2))+      | (x2 - x1) * (y2 - y1) > 0 = (nc+1, nd, n1, n2)+      | (x2 - x1) * (y2 - y1) < 0 = (nc, nd+1, n1, n2)+      | otherwise = if x1 == x2+                       then if y1 == y2+                               then (nc, nd, n1+1, n2+1)+                               else (nc, nd, n1+1, n2)+                       else (nc, nd, n1, n2+1)+    f (x:xs) = zip (repeat x) xs ++ f xs+    f _ = []
+ tests/Tests/Distribution.hs view
@@ -0,0 +1,439 @@+{-# LANGUAGE FlexibleInstances, ScopedTypeVariables,+    ViewPatterns #-}+module Tests.Distribution (tests) where++import qualified Control.Exception as E+import Data.List (find)+import Data.Typeable (Typeable)+import Data.Word+import Numeric.MathFunctions.Constants (m_tiny,m_huge,m_epsilon)+import Numeric.MathFunctions.Comparison+import Statistics.Distribution+import Statistics.Distribution.Beta           (BetaDistribution)+import Statistics.Distribution.Binomial       (BinomialDistribution)+import Statistics.Distribution.CauchyLorentz+import Statistics.Distribution.ChiSquared     (ChiSquared)+import Statistics.Distribution.Exponential    (ExponentialDistribution)+import Statistics.Distribution.FDistribution  (FDistribution,fDistribution)+import Statistics.Distribution.Gamma          (GammaDistribution,gammaDistr)+import Statistics.Distribution.Geometric+import Statistics.Distribution.Hypergeometric+import Statistics.Distribution.Laplace        (LaplaceDistribution)+import Statistics.Distribution.Lognormal      (LognormalDistribution)+import Statistics.Distribution.NegativeBinomial (NegativeBinomialDistribution)+import Statistics.Distribution.Normal         (NormalDistribution)+import Statistics.Distribution.Poisson        (PoissonDistribution)+import Statistics.Distribution.StudentT+import Statistics.Distribution.Transform      (LinearTransform)+import Statistics.Distribution.Uniform        (UniformDistribution)+import Statistics.Distribution.Weibull        (WeibullDistribution)+import Statistics.Distribution.DiscreteUniform (DiscreteUniform)+import Test.Tasty                 (TestTree, testGroup)+import Test.Tasty.QuickCheck      (testProperty)+import Test.Tasty.ExpectedFailure (ignoreTest)+import Test.QuickCheck as QC+import Test.QuickCheck.Monadic as QC+import Text.Printf (printf)++import Tests.ApproxEq  (ApproxEq(..))+import Tests.ExactDistribution (exactDistributionTests)+import Tests.Helpers   (T(..), Double01(..), testAssertion, typeName)+import Tests.Helpers   (monotonicallyIncreasesIEEE,isDenorm)+import Tests.Orphanage ()++-- | Tests for all distributions+tests :: TestTree+tests = testGroup "Tests for all distributions"+  [ contDistrTests (T :: T BetaDistribution        )+  , contDistrTests (T :: T CauchyDistribution      )+  , contDistrTests (T :: T ChiSquared              )+  , contDistrTests (T :: T ExponentialDistribution )+  , contDistrTests (T :: T GammaDistribution       )+  , contDistrTests (T :: T LaplaceDistribution     )+  , contDistrTests (T :: T LognormalDistribution   )+  , contDistrTests (T :: T NormalDistribution      )+  , contDistrTests (T :: T UniformDistribution     )+  , contDistrTests (T :: T WeibullDistribution     )+  , contDistrTests (T :: T StudentT                )+  , contDistrTests (T :: T (LinearTransform NormalDistribution))+  , contDistrTests (T :: T FDistribution           )++  , discreteDistrTests (T :: T BinomialDistribution       )+  , discreteDistrTests (T :: T GeometricDistribution      )+  , discreteDistrTests (T :: T GeometricDistribution0     )+  , discreteDistrTests (T :: T HypergeometricDistribution )+  , discreteDistrTests (T :: T NegativeBinomialDistribution )+  , discreteDistrTests (T :: T PoissonDistribution        )+  , discreteDistrTests (T :: T DiscreteUniform            )++  , exactDistributionTests+  , unitTests+  ]++----------------------------------------------------------------+-- Tests+----------------------------------------------------------------++-- Tests for continuous distribution+contDistrTests :: (Param d, ContDistr d, QC.Arbitrary d, Typeable d, Show d) => T d -> TestTree+contDistrTests t = testGroup ("Tests for: " ++ typeName t) $+  cdfTests t +++  [ testProperty "PDF sanity"              $ pdfSanityCheck     t+  , (if quantileIsInvCDF_enabled t then id else ignoreTest)+  $ testProperty "Quantile is CDF inverse" $ quantileIsInvCDF t+  , testProperty "quantile fails p<0||p>1" $ quantileShouldFail t+  , testProperty "log density check"       $ logDensityCheck    t+  , testProperty "complQuantile"           $ complQuantileCheck t+  ]++-- Tests for discrete distribution+discreteDistrTests :: (Param d, DiscreteDistr d, QC.Arbitrary d, Typeable d, Show d) => T d -> TestTree+discreteDistrTests t = testGroup ("Tests for: " ++ typeName t) $+  cdfTests t +++  [ testProperty "Prob. sanity"         $ probSanityCheck       t+  , testProperty "CDF is sum of prob."  $ discreteCDFcorrect    t+  , testProperty "Discrete CDF is OK"   $ cdfDiscreteIsCorrect  t+  , testProperty "log probability check" $ logProbabilityCheck   t+  ]++-- Tests for distributions which have CDF+cdfTests :: (Param d, Distribution d, QC.Arbitrary d, Show d) => T d -> [TestTree]+cdfTests t =+  [ testProperty "C.D.F. sanity"        $ cdfSanityCheck         t+  , testProperty "CDF limit at +inf"    $ cdfLimitAtPosInfinity  t+  , (if cdfLimitAtNegInfinity_enabled t then id else ignoreTest)+  $ testProperty "CDF limit at -inf"    $ cdfLimitAtNegInfinity  t+  , testProperty "CDF at +inf = 1"      $ cdfAtPosInfinity       t+  , testProperty "CDF at -inf = 1"      $ cdfAtNegInfinity       t+  , testProperty "CDF is nondecreasing" $ cdfIsNondecreasing     t+  , testProperty "1-CDF is correct"     $ cdfComplementIsCorrect t+  ]+++----------------------------------------------------------------++-- CDF is in [0,1] range+cdfSanityCheck :: (Distribution d) => T d -> d -> Double -> Bool+cdfSanityCheck _ d x = c >= 0 && c <= 1+  where c = cumulative d x++-- CDF never decreases+cdfIsNondecreasing :: (Distribution d) => T d -> d -> Double -> Double -> Bool+cdfIsNondecreasing _ d = monotonicallyIncreasesIEEE $ cumulative d++-- cumulative d +∞ = 1+cdfAtPosInfinity :: (Distribution d) => T d -> d -> Bool+cdfAtPosInfinity _ d+  = cumulative d (1/0) == 1++-- cumulative d - ∞ = 0+cdfAtNegInfinity :: (Distribution d) => T d -> d -> Bool+cdfAtNegInfinity _ d+  = cumulative d (-1/0) == 0++-- CDF limit at +∞ is 1+cdfLimitAtPosInfinity :: (Param d, Distribution d) => T d -> d -> Bool+cdfLimitAtPosInfinity _ d+  = Just 1.0 == find (>=1) probs+  where+    probs = map (cumulative d)+          $ takeWhile (< (m_huge/2))+          $ iterate (*1.4) 1++-- CDF limit at -∞ is 0+cdfLimitAtNegInfinity :: (Param d, Distribution d) => T d -> d -> Bool+cdfLimitAtNegInfinity _ d+  = Just 0 == find (<=0) probs+  where+    probs = map (cumulative d)+          $ takeWhile (> (-m_huge/2))+          $ iterate (*1.4) (-1)+++-- CDF's complement is implemented correctly+cdfComplementIsCorrect :: (Distribution d, Param d) => T d -> d -> Double -> Property+cdfComplementIsCorrect _ d x+  = counterexample ("err. tolerance = " ++ show tol)+  $ counterexample ("difference     = " ++ show delta)+  $ delta <= tol+  where+    tol   = prec_complementCDF d+    delta = 1 - (cumulative d x + complCumulative d x)++-- CDF for discrete distribution uses <= for comparison+cdfDiscreteIsCorrect :: (Param d, DiscreteDistr d) => T d -> d -> Property+cdfDiscreteIsCorrect _ d+  = counterexample (unlines badN)+  $ null badN+  where+    -- We are checking that:+    --+    -- > CDF(i) - CDF(i-e) = P(i)+    --+    -- Approximate equality is tricky here. Scale is set by maximum+    -- value of CDF and probability. Case when all probabilities are+    -- zero should be treated specially.+    badN = [ printf "N=%3i    p[i]=%g\tp[i+1]=%g\tdP=%g\trelerr=%g" i p p1 dp ((p1-p-dp) / max p1 dp)+           | i <- [0 .. 100]+           , let p      = cumulative d $ fromIntegral i - 1e-6+                 p1     = cumulative d $ fromIntegral i+                 dp     = probability d i+                 relerr = ((p1 - p) - dp) / max p1 dp+           , p  > m_tiny || p == 0+           , p1 > m_tiny+           , dp > m_tiny+           , relerr > tol+           ]+    tol = prec_discreteCDF d++logDensityCheck :: (Param d, ContDistr d) => T d -> d -> Double -> Property+logDensityCheck _ d x+  = not (isDenorm x)+  ==> ( counterexample (printf "density    = %g" p)+      $ counterexample (printf "logDensity = %g" logP)+      $ counterexample (printf "log p      = %g" (log p))+      $ counterexample (printf "ulps[log]  = %i" ulpsLog)+      $ counterexample (printf "ulps[lin]  = %i" ulpsLin)+      $ or [ p == 0      && logP == (-1/0)+           , p <= m_tiny && logP < log m_tiny+             -- To avoid problems with roundtripping error in case+             -- when density is computed as exponent of logDensity we+             -- accept either inequality+           ,  (ulpsLog <= n) || (ulpsLin <= n)+           ])+  where+    p       = density d x+    logP    = logDensity d x+    n       = prec_logDensity d+    ulpsLog = ulpDistance (log p) logP+    ulpsLin = ulpDistance p       (exp logP)++-- PDF is positive+pdfSanityCheck :: (ContDistr d) => T d -> d -> Double -> Bool+pdfSanityCheck _ d x = p >= 0+  where p = density d x++complQuantileCheck :: (ContDistr d) => T d -> d -> Double01 -> Property+complQuantileCheck _ d (Double01 p)+  = counterexample (printf "x0 = %g" x0)+  $ counterexample (printf "x1 = %g" x1)+  $ counterexample (printf "abs err = %g" $ abs (x1 - x0))+  $ counterexample (printf "rel err = %g" $ relativeError x1 x0)+  -- We avoid extreme tails of distributions+  --+  -- FIXME: all parameters are arbitrary at the moment+  $ and [ p > 0.01+        , p < 0.99+        , not $ isInfinite x0+        , not $ isInfinite x1+        ] ==> (if x0 < 1e6 then abs (x1 - x0) < 1e-6 else relativeError x1 x0 < 1e-12)+  where+    x0 = quantile      d (1 - p)+    x1 = complQuantile d p++-- Quantile is inverse of CDF+quantileIsInvCDF :: (Param d, ContDistr d) => T d -> d -> Double01 -> Property+quantileIsInvCDF _ d (Double01 p) =+  and [ p > m_tiny+      , p < 1+      , x > m_tiny+      , dens > 0+      ] ==>+    ( counterexample (printf "Quantile      = %g" x )+    $ counterexample (printf "Probability   = %g" p )+    $ counterexample (printf "Probability'  = %g" p')+    $ counterexample (printf "Rel. error    = %g" (relativeError p p'))+    $ counterexample (printf "Abs. error    = %e" (abs $ p - p'))+    $ counterexample (printf "Expected err. = %g" err)+    $ counterexample (printf "Distance      = %i" (ulpDistance p p'))+    $ counterexample (printf "Err/est       = %g" (fromIntegral (ulpDistance p p') / err))+    $ ulpDistance p p' <= round err+    )+  where+    -- Algorithm for error estimation is taken from here+    --+    -- http://sepulcarium.org/posts/2012-07-19-rounding_effect_on_inverse.html+    dens = density    d x+    err  = eps + eps' * abs (x / p) * dens+    --+    x    = quantile   d p+    p'   = cumulative d x+    (eps,eps') = prec_quantile_CDF d++-- Test that quantile fails if p<0 or p>1+quantileShouldFail :: (ContDistr d) => T d -> d -> Double -> Property+quantileShouldFail _ d p =+  p < 0 || p > 1 ==> QC.monadicIO $ do r <- QC.run $ E.catch+                                              (False <$ (return $! quantile d p))+                                              (\(_ :: E.SomeException) -> return True)+                                       QC.assert r+++-- Probability is in [0,1] range+probSanityCheck :: (DiscreteDistr d) => T d -> d -> Int -> Bool+probSanityCheck _ d x = p >= 0 && p <= 1+  where p = probability d x++-- Check that discrete CDF is correct+discreteCDFcorrect :: (DiscreteDistr d) => T d -> d -> Int -> Int -> Property+discreteCDFcorrect _ d a b+  = counterexample (printf "CDF   = %g" p1)+  $ counterexample (printf "Sum   = %g" p2)+  $ counterexample (printf "Delta = %g" (abs (p1 - p2)))+  $ abs (p1 - p2) < 3e-10+  -- Avoid too large differences. Otherwise there is to much to sum+  --+  -- Absolute difference is used guard against precision loss when+  -- close values of CDF are subtracted+  where+    n  = min a b+    m  = n + (abs (a - b) `mod` 100)+    p1 = cumulative d (fromIntegral m + 0.5) - cumulative d (fromIntegral n - 0.5)+    p2 = sum $ map (probability d) [n .. m]++logProbabilityCheck :: (Param d, DiscreteDistr d) => T d -> d -> Int -> Property+logProbabilityCheck _ d x+  = counterexample (printf "probability    = %g" p)+  $ counterexample (printf "logProbability = %g" logP)+  $ counterexample (printf "log p          = %g" (log p))+  $ counterexample (printf "ulps[log]      = %i" ulpsLog)+  $ counterexample (printf "ulps[lin]      = %i" ulpsLin)+  $ or [ p == 0     && logP == (-1/0)+       , p < 1e-308 && logP < 609+         -- To avoid problems with roundtripping error in case+         -- when density is computed as exponent of logDensity we+         -- accept either inequality+       ,  (ulpsLog <= n) || (ulpsLin <= n)+       ]+  where+    p    = probability d x+    logP = logProbability d x+    n    = prec_logDensity d+    ulpsLog = ulpDistance (log p) logP+    ulpsLin = ulpDistance p       (exp logP)+++-- | Parameters for distribution testing. Some distribution require+--   relaxing parameters a bit+class Param a where+  -- | Whether quantileIsInvCDF is enabled+  quantileIsInvCDF_enabled :: T a -> Bool+  quantileIsInvCDF_enabled _ = True+  -- | Whether cdfLimitAtNegInfinity is enabled+  cdfLimitAtNegInfinity_enabled :: T a -> Bool+  cdfLimitAtNegInfinity_enabled _ = True+  -- | Precision for 'quantileIsInvCDF' test+  prec_quantile_CDF :: a -> (Double,Double)+  prec_quantile_CDF _ = (16,16)+  -- |+  prec_discreteCDF :: a -> Double+  prec_discreteCDF _ = 32 * m_epsilon+  -- | Precision of CDF's complement+  prec_complementCDF :: a -> Double+  prec_complementCDF _ = 1e-14+  -- | Precision for logDensity check+  prec_logDensity :: a -> Word64+  prec_logDensity _ = 32++instance Param StudentT where+  -- FIXME: disabled unless incompleteBeta troubles are sorted out+  quantileIsInvCDF_enabled _ = False++instance Param BetaDistribution where+  -- FIXME: See https://github.com/haskell/statistics/issues/161 for details+  quantileIsInvCDF_enabled _ = False++instance Param FDistribution where+  -- FIXME: disabled unless incompleteBeta troubles are sorted out+  quantileIsInvCDF_enabled _ = False+  -- We compute CDF and complement using same method so precision+  -- should be very good here.+  prec_complementCDF _ = 64 * m_epsilon++instance Param ChiSquared where+  prec_quantile_CDF _ = (32,32)++instance Param BinomialDistribution where+  prec_discreteCDF _ = 1e-12+  prec_logDensity  _ = 48+instance Param CauchyDistribution where+  -- Distribution is long-tailed enough that we may never get to zero+  cdfLimitAtNegInfinity_enabled _ = False++instance Param DiscreteUniform+instance Param ExponentialDistribution+instance Param GammaDistribution where+  -- We lose precision near `incompleteGamma 10` because of error+  -- introduced by exp . logGamma.  This could only be fixed in+  -- math-function by implementing gamma+  prec_quantile_CDF _ = (24,24)+  prec_logDensity   _ = 512+instance Param GeometricDistribution+instance Param GeometricDistribution0+instance Param HypergeometricDistribution+instance Param LaplaceDistribution+instance Param LognormalDistribution where+  prec_quantile_CDF _ = (64,64)+instance Param NegativeBinomialDistribution where+  prec_discreteCDF  _ = 1e-12+  prec_logDensity   _ = 48+instance Param NormalDistribution+instance Param PoissonDistribution+instance Param UniformDistribution+instance Param WeibullDistribution+instance Param a => Param (LinearTransform a)++----------------------------------------------------------------+-- Unit tests+----------------------------------------------------------------++unitTests :: TestTree+unitTests = testGroup "Unit tests"+  [ testAssertion "density (gammaDistr 150 1/150) 1 == 4.883311" $+      4.883311418525483 =~ density (gammaDistr 150 (1/150)) 1+    -- Student-T+  , testStudentPDF 0.3  1.34  0.0648215  -- PDF+  , testStudentPDF 1    0.42  0.27058+  , testStudentPDF 4.4  0.33  0.352994+  , testStudentCDF 0.3  3.34  0.757146   -- CDF+  , testStudentCDF 1    0.42  0.626569+  , testStudentCDF 4.4  0.33  0.621739+    -- Student-T General+  , testStudentUnstandardizedPDF 0.3    1.2  4      0.45 0.0533456  -- PDF+  , testStudentUnstandardizedPDF 4.3  (-2.4) 3.22 (-0.6) 0.0971141+  , testStudentUnstandardizedPDF 3.8    0.22 7.62   0.14 0.0490523+  , testStudentUnstandardizedCDF 0.3    1.2  4      0.45 0.458035   -- CDF+  , testStudentUnstandardizedCDF 4.3  (-2.4) 3.22 (-0.6) 0.698001+  , testStudentUnstandardizedCDF 3.8    0.22 7.62   0.14 0.496076+    -- F-distribution+  , testFdistrPDF  1  3   3     (1/(6 * pi)) -- PDF+  , testFdistrPDF  2  2   1.2   0.206612+  , testFdistrPDF  10 12  8     0.000385613179281892790166+  , testFdistrCDF  1  3   3     0.81830988618379067153 -- CDF+  , testFdistrCDF  2  2   1.2   0.545455+  , testFdistrCDF  10 12  8     0.99935509863451408041+  ]+  where+    -- Student-T+    testStudentPDF ndf x exact+      = testAssertion (printf "density (studentT %f) %f ~ %f" ndf x exact)+      $ eq 1e-5  exact  (density (studentT ndf) x)+    testStudentCDF ndf x exact+      = testAssertion (printf "cumulative (studentT %f) %f ~ %f" ndf x exact)+      $ eq 1e-5  exact  (cumulative (studentT ndf) x)+    -- Student-T General+    testStudentUnstandardizedPDF ndf mu sigma x exact+      = testAssertion (printf "density (studentTUnstandardized %f %f %f) %f ~ %f" ndf mu sigma x exact)+      $ eq 1e-5  exact  (density (studentTUnstandardized ndf mu sigma) x)+    testStudentUnstandardizedCDF ndf mu sigma x exact+      = testAssertion (printf "cumulative (studentTUnstandardized %f %f %f) %f ~ %f" ndf mu sigma x exact)+      $ eq 1e-5  exact  (cumulative (studentTUnstandardized ndf mu sigma) x)+    -- F-distribution+    testFdistrPDF n m x exact+      = testAssertion (printf "density (fDistribution %i %i) %f ~ %f [got %f]" n m x exact d)+      $ eq 1e-5  exact d+      where d = density (fDistribution n m) x+    testFdistrCDF n m x exact+      = testAssertion (printf "cumulative (fDistribution %i %i) %f ~ %f [got %f]" n m x exact d)+      $ eq 1e-5  exact d+      where d = cumulative (fDistribution n m) x
+ tests/Tests/ExactDistribution.hs view
@@ -0,0 +1,387 @@+{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications    #-}+{-# LANGUAGE TypeFamilies        #-}+-- |+-- Module    : Tests.ExactDistribution+-- Copyright : (c) 2022 Lorenz Minder+-- License   : BSD3+--+-- Maintainer  : lminder@gmx.net+-- Stability   : experimental+-- Portability : portable+--+-- Tests comparing distributions to exact versions.+--+-- This module provides exact versions of some distributions, and tests+-- to compare them to the production implementations in+-- Statistics.Distribution.*.  It also contains the functionality to+-- test the production distributions against the exact versions.  Errors+-- are flagged if data points are discovered where the probability mass+-- function, the cumulative probability function, or its complement+-- deviates too far (more than a prescribed tolerance) from the exact+-- calculation.+--+-- The distributions here are implemented with rational integer+-- arithmetic, using pretty much the textbook definitions formulas.+-- Numerical problems like overflow or rounding errors cannot occur with+-- this approach, making them are easy to write, read and verify.  They+-- are, of course, substantially slower than the production+-- distributions in Statistics.Distribution.*.  This makes them+-- unsuitable for most uses other than testing and debugging.  (Also,+-- only a handful of distributions can be implemented exactly with+-- rational arithmetic.)+--+-- This module has the following sub-components:+-- +-- * Exact (rational) definitions of some distribution functions,+--   including both the probability mass as well as the CDF.+--+-- * QC.Arbitrary implementations to sample test cases (i.e.,+--   distribution parameters and evaluation points).+--+-- * "Linkage": a mechanism to construct a production distribution+--   corresponding to a test case for an exact distribution.+--+-- * A set of tests for the distributions derived using all of the above+--   components.+--+-- This module exports a number symbols which can be useful for+-- debugging and experimentation.  For use in a test suite, only the+-- `exactDistributionTests` function is needed.++module Tests.ExactDistribution (+    -- * Exact math functions+      exactChoose++    -- * Exact distributions+    , ExactDiscreteDistr(..)++    , ExactBinomialDistr(..)+    , ExactDiscreteUniformDistr(..)+    , ExactGeometricDistr(..)+    , ExactHypergeomDistr(..)++    -- * Linking to production distributions+    , ProductionLinkage++    -- * Individual test routines+    , pmfMatch+    , cdfMatch+    , complCdfMatch++    -- * Test groups+    , Tag(..)+    , distTests+    , exactDistributionTests+) where++----------------------------------------------------------------++import Data.Foldable+import Data.Ratio++import Test.Tasty                       (TestTree, testGroup)+import Test.Tasty.QuickCheck            (testProperty)+import Test.QuickCheck as QC+import Numeric.MathFunctions.Comparison (relativeError)+import Numeric.MathFunctions.Constants  (m_tiny)++import Statistics.Distribution+import Statistics.Distribution.Binomial+import Statistics.Distribution.DiscreteUniform+import Statistics.Distribution.Geometric+import Statistics.Distribution.Hypergeometric++----------------------------------------------------------------+--+-- Math functions.+--+-- Used for implementing the distributions below.+--+----------------------------------------------------------------++-- | Exactly compute binomial coefficient.+--+-- /n/ need not be an integer, can be fractional.+exactChoose :: Ratio Integer -> Integer -> Ratio Integer+exactChoose n k+    | k < 0     = 0+    | otherwise = foldl' (*) 1 factors+    where   factors = [ (n - k' + j) / j | j <- [1..k'] ]+            k' = fromInteger k :: Ratio Integer++----------------------------------------------------------------+--+-- Exact distributions.+--+----------------------------------------------------------------++-- | Exact discrete distribution.+class ExactDiscreteDistr a where+    -- | Probability mass function.+    exactProb :: a -> Integer -> Ratio Integer+    exactProb d x = exactCumulative d x - exactCumulative d (x - 1)++    -- | Cumulative distribution function.+    exactCumulative :: a -> Integer -> Ratio Integer++-- | Exact Binomial distribution.+data ExactBinomialDistr = ExactBD Integer (Ratio Integer)+    deriving(Show)++instance ExactDiscreteDistr ExactBinomialDistr where+    -- Probability mass, computed with textbook formula.+    exactProb (ExactBD n p) k+        | k < 0 || k > n    = 0+        | otherwise         = exactChoose n' k * p^k * (1-p)^(n-k)+        where n' = fromIntegral n+    -- CDF +    --+    -- Computed iteratively by summing up all the probabilities+    -- <= /k/.  Rather than computing everything from scratch for each+    -- probability, we reuse previous results.  The meanings of the+    -- variables in the "update" function are:+    -- +    -- bc   is the binomial coefficient (n choose j),+    -- pj   is the term p^j,+    -- pnj  is the term (1 - p)^(n - j)+    -- r    is the (partial) sum of the probabilities +    --+    exactCumulative (ExactBD n p) k+        | k < 0             = 0+        | k >= n            = 1+        -- Special case for p = 1, since in the below fold we+        -- divide by (1 - p).+        | p == 1            = if k == n then 1 else 0+        | otherwise+          = result $ foldl' update (1, 1, (1 - p)^n, (1 - p)^n) [1..k]+          where update (!bc, !pj, !pnj, !r) !j =+                    let bc' = bc * (n - j + 1) `div` j +                        pj' = pj * p+                        pnj' = pnj / (1 - p)+                        r' = r + (fromIntegral bc') * pj' * pnj'+                    in  (bc', pj', pnj', r')+                result (_, _, _, r) = r++-- | Exact Discrete Uniform distribution.+data ExactDiscreteUniformDistr = ExactDU Integer Integer+    deriving(Show)++instance ExactDiscreteDistr ExactDiscreteUniformDistr  where+    exactProb (ExactDU lower upper) k+        | k < lower || k > upper    = 0+        | otherwise                 = 1 % (upper - lower + 1)+    exactCumulative (ExactDU lower upper) k+        | k < lower                 = 0+        | k > upper                 = 1+        | otherwise                 =+            let d = (k - lower + 1)+            in  d % (upper - lower + 1)++-- | Geometric distribution.+data ExactGeometricDistr = ExactGeom (Ratio Integer)+    deriving(Show)++instance ExactDiscreteDistr ExactGeometricDistr where+    exactProb (ExactGeom p) k+        | k < 1                     = 0+        | otherwise                 = (1 - p)^(k - 1) * p++    exactCumulative (ExactGeom p) k = 1 - (1 - p)^k++-- | Hypergeometric distribution.+--+--   Parameters are /K/, /N/ and /n/, where:+--   - /N/ is the total sample space size.+--   - /K/ is number of "good" objects among /N/.+--   - /n/ is the number of draws without replacement.+data ExactHypergeomDistr = ExactHG Integer Integer Integer+    deriving(Show)++instance ExactDiscreteDistr ExactHypergeomDistr where+    exactProb (ExactHG nK nN n) k+        | k < 0                     = 0+        | k > n || k > nN           = 0+        | otherwise                 =+            exactChoose nK' k * exactChoose (nN' - nK') (n - k)+                / exactChoose nN' n+            where nN' = fromIntegral nN+                  nK' = fromIntegral nK++    exactCumulative d k = sum [ exactProb d i | i <- [0..k] ]++----------------------------------------------------------------+--+-- TestCase construction.+--+-- Contains the TestCase data type which encapsulates an instance of an+-- exact distribution together with an evaluation point.+--+-- Then in contains the QC.Arbitrary implementations for TestCases of+-- the different exact distributions.  As a general rule, we try the+-- sampling to be relatively efficient, i.e., we only want to sample+-- valid distribution parameters.  The evaluation points are sampled+-- such that most points are within the support of the distribution.+--+----------------------------------------------------------------++-- Divisor to compute a rational number from an integer.+--+-- We want input parameters to be exactly representable as+-- Double values.  This is so that the production distribution does not+-- mismatch the exact one simply because the input values don't exactly+-- match.  (This can happen if the derivative of the distribution+-- function is large.)   For this reason, the gd value needs to be a+-- power of 2, and <= 2^53, since the mantissa of a Double is 53 bits.+--+-- A value of 2^53 gives the most accurate and diverse tests, but the+-- cost is increased running times, as the computed numerators and+-- denominators will become quite large.+gd :: Integer+gd = 2^(16 :: Int)++-- TestCase+--+-- Combination of an exact distribution together with an evaluation point.+data TestCase a = TestCase a Integer deriving (Show)++instance QC.Arbitrary (TestCase ExactBinomialDistr) where+    arbitrary = do+        -- This somewhat odd sampling of /n/ is done so that lower+        -- values (<1000) are more often represented as the larger ones.+        n <- (*) <$> chooseInteger (1,1000) <*> chooseInteger(1,2)+        p <- (% gd) <$> chooseInteger (0, gd)+        k <- chooseInteger (-1, n + 1)+        return $ TestCase (ExactBD n p) k+    shrink _ = []++instance QC.Arbitrary (TestCase ExactDiscreteUniformDistr) where+    arbitrary = do+        a <- chooseInteger (-1000, 1000)+        sz <- chooseInteger (1, 1000)+        let b = a + sz+        k <- chooseInteger (a - 10, b + 10)+        return $ TestCase (ExactDU a b) k+    shrink _ = []++instance QC.Arbitrary (TestCase ExactGeometricDistr) where+    arbitrary = do+        p <- (% gd) <$> chooseInteger (1, gd)+        let lim = (floor $ 100 / p) :: Integer+        k <- chooseInteger (0, lim)+        return $ TestCase (ExactGeom p) k+    shrink _ = []++instance QC.Arbitrary (TestCase ExactHypergeomDistr) where+    arbitrary = do+        nN <- chooseInteger (1, 100)        -- XXX lower bound should be 0+        nK <- chooseInteger (0, nN)+        n  <- chooseInteger (1, nN)         -- XXX lower bound should be 0+        k  <- chooseInteger (0, min n nK)+        return $ TestCase (ExactHG nK nN n) k+    shrink _ = []++----------------------------------------------------------------+--+-- Linking to the production distributions+--+-- This section contains the ProductionLinkage typeclass and+-- implementation, that allows to obtain a functions for evaluating+-- the production distribution functions for a corresponding exact+-- distribution.+--+----------------------------------------------------------------++class (ExactDiscreteDistr a, DiscreteDistr (ProdDistrib a)+      ) => ProductionLinkage a where+  type ProdDistrib a+  toProd :: a -> ProdDistrib a++instance ProductionLinkage ExactBinomialDistr where+  type ProdDistrib ExactBinomialDistr = BinomialDistribution+  toProd (ExactBD n p) = binomial (fromIntegral n) (fromRational p)++instance ProductionLinkage ExactDiscreteUniformDistr where+  type ProdDistrib ExactDiscreteUniformDistr = DiscreteUniform+  toProd (ExactDU lower upper) = discreteUniformAB (fromIntegral lower) (fromIntegral upper)++instance ProductionLinkage ExactGeometricDistr where+  type ProdDistrib ExactGeometricDistr = GeometricDistribution+  toProd (ExactGeom p) = geometric $ fromRational p++instance ProductionLinkage ExactHypergeomDistr where+  type ProdDistrib ExactHypergeomDistr = HypergeometricDistribution+  toProd (ExactHG nK nN n) =+    hypergeometric (fromIntegral nK) (fromIntegral nN) (fromIntegral n)+++----------------------------------------------------------------+-- Tests+----------------------------------------------------------------++-- Compare that probabilities agree. If they are denormalized just+-- return True. You can't say much about precision+probabilityAgree :: Double -> Double -> Double -> Bool+probabilityAgree tol pe pa+  | pa < 0      = False+  | pe < 0      = False+  | pe < m_tiny = True+  | otherwise   = relativeError pe pa < tol++-- Check production probability mass function accuracy.+--+-- Inputs: tolerance (max relative error) and test case+pmfMatch :: (Show a, ProductionLinkage a) => Double -> TestCase a -> Property+pmfMatch tol (TestCase dExact k)+  = counterexample ("Exact  = " ++ show pe)+  $ counterexample ("Approx = " ++ show pa)+  $ probabilityAgree tol pe pa+  where+    pe = fromRational $ exactProb dExact k+    pa = probability (toProd dExact) (fromIntegral k)++-- Check production cumulative probability function accuracy.+--+-- Inputs:  tolerance (max relative error) and test case.+cdfMatch :: (Show a, ProductionLinkage a) => Double -> TestCase a -> Bool+cdfMatch tol (TestCase dExact k)+  = probabilityAgree tol pe pa+  where+    pe = fromRational $ exactCumulative dExact k+    pa = cumulative (toProd dExact) (fromIntegral k)++-- Check production complement cumulative function accuracy.+--+-- Inputs:  tolerance (max relative error) and test case.+complCdfMatch :: (Show a, ProductionLinkage a) => Double -> TestCase a -> Bool+complCdfMatch tol (TestCase dExact k)+  = probabilityAgree tol pe pa+  where+    pe = fromRational $ 1 - exactCumulative dExact k+    pa = complCumulative (toProd dExact) (fromIntegral k)++-- Phantom type to encode an exact distribution.+data Tag a = Tag++distTests :: forall a. (Show a, ProductionLinkage a, Arbitrary (TestCase a)) =>+    Tag a -> String -> Double -> TestTree+distTests (Tag :: Tag a) name tol =+  testGroup ("Exact tests for " ++ name)+    [ testProperty "PMF match"     $ pmfMatch      @a tol+    , testProperty "CDF match"     $ cdfMatch      @a tol+    , testProperty "1 - CDF match" $ complCdfMatch @a tol+    ]+++-- Test driver -------------------------------------------------++exactDistributionTests :: TestTree+exactDistributionTests = testGroup "Test distributions against exact"+  [ distTests (Tag @ExactBinomialDistr)        "Binomial"         1.0e-12+  , distTests (Tag @ExactDiscreteUniformDistr) "DiscreteUniform"  1.0e-12+  , distTests (Tag @ExactGeometricDistr)       "Geometric"        1.0e-13+  , distTests (Tag @ExactHypergeomDistr)       "Hypergeometric"   1.0e-12+  ]
+ tests/Tests/Function.hs view
@@ -0,0 +1,29 @@+module Tests.Function ( tests ) where++import Statistics.Function+import Test.Tasty+import Test.Tasty.QuickCheck+import Test.QuickCheck+import Tests.Helpers+import qualified Data.Vector.Unboxed as U+++tests :: TestTree+tests = testGroup "S.Function"+  [ testProperty  "Sort is sort"                p_sort+  , testAssertion "nextHighestPowerOfTwo is OK" p_nextHighestPowerOfTwo+  ]+++p_sort :: [Double] -> Property+p_sort xs =+  not (null xs) ==> U.all (uncurry (<=)) (U.zip v $ U.tail v)+    where+      v = sort $ U.fromList xs++p_nextHighestPowerOfTwo :: Bool+p_nextHighestPowerOfTwo+  = all (\(good, is) -> all ((==good) . nextHighestPowerOfTwo) is) lists+  where+    pows  = [1 .. 17 :: Int]+    lists = [ (2^m, [2^n+1 .. 2^m]) | (n,m) <- pows `zip` tail pows ]
+ tests/Tests/Helpers.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE ScopedTypeVariables #-}+-- | Helpers for testing+module Tests.Helpers (+    -- * helpers+    T(..)+  , typeName+  , Double01(..)+    -- * IEEE 754+  , isDenorm+    -- * Generic QC tests+  , monotonicallyIncreases+  , monotonicallyIncreasesIEEE+    -- * HUnit helpers+  , testAssertion+  , testEquality+    -- * QC helpers+  , small+  , unsquare+  , shrinkFixedList+  ) where++import Data.Typeable+import Numeric.MathFunctions.Constants (m_tiny)+import Test.Tasty+import Test.Tasty.HUnit+import Test.QuickCheck+import qualified Numeric.IEEE     as IEEE+import qualified Test.Tasty.HUnit as HU++-- | Phantom typed value used to select right instance in QC tests+data T a = T++-- | String representation of type name+typeName :: Typeable a => T a -> String+typeName = show . typeOf . typeParam+  where+    typeParam :: T a -> a+    typeParam _ = undefined++-- | Check if Double denormalized+isDenorm :: Double -> Bool+isDenorm x = let ax = abs x in ax > 0 && ax < m_tiny++-- | Generates Doubles in range [0,1]+newtype Double01 = Double01 Double+                   deriving (Show)+instance Arbitrary Double01 where+  arbitrary = do+    (_::Int, x) <- fmap properFraction arbitrary+    return $ Double01 x++----------------------------------------------------------------+-- Generic QC+----------------------------------------------------------------++-- Check that function is nondecreasing+monotonicallyIncreases :: (Ord a, Ord b) => (a -> b) -> a -> a -> Bool+monotonicallyIncreases f x1 x2 = f (min x1 x2) <= f (max x1 x2)++-- Check that function is nondecreasing taking rounding errors into+-- account.+--+-- In fact function is allowed to decrease less than one ulp in order+-- to guard against problems with excess precision. On x86 FPU works+-- with 80-bit numbers but doubles are 64-bit so rounding happens+-- whenever values are moved from registers to memory+monotonicallyIncreasesIEEE :: (Ord a, IEEE.IEEE b)  => (a -> b) -> a -> a -> Bool+monotonicallyIncreasesIEEE f x1 x2 =+  y1 <= y2 || (y1 - y2) < y2 * IEEE.epsilon+  where+    y1 = f (min x1 x2)+    y2 = f (max x1 x2)++----------------------------------------------------------------+-- HUnit helpers+----------------------------------------------------------------++testAssertion :: String -> Bool -> TestTree+testAssertion str cont = testCase str $ HU.assertBool str cont++testEquality :: (Show a, Eq a) => String -> a -> a -> TestTree+testEquality msg a b = testCase msg $ HU.assertEqual msg a b++unsquare :: (Arbitrary a, Show a, Testable b) => (a -> b) -> Property+unsquare = forAll (small arbitrary)++small :: Gen a -> Gen a+small act = sized $ \n -> resize (smallish n) act+  where smallish = round . (sqrt :: Double -> Double) . fromIntegral . abs++shrinkFixedList :: (a -> [a]) -> [a] -> [[a]]+shrinkFixedList shr (x:xs) = map (:xs) (shr x) ++ map (x:) (shrinkFixedList shr xs)+shrinkFixedList _   []     = []
+ tests/Tests/KDE.hs view
@@ -0,0 +1,43 @@+-- | Tests for Kernel density estimates.+module Tests.KDE (+  tests+  )where++import Data.Vector.Unboxed             ((!))+import Numeric.Sum                     (kbn, sumVector)+import Statistics.Sample.KernelDensity+import Test.Tasty                      (TestTree, testGroup)+import Test.Tasty.QuickCheck           (testProperty)+import Test.QuickCheck                 (Property, (==>), counterexample)+import Text.Printf                     (printf)+import qualified Data.Vector.Unboxed as U+++tests :: TestTree+tests = testGroup "KDE"+  [ testProperty "integral(PDF) == 1" t_densityIsPDF+  ]++t_densityIsPDF :: [Double] -> Property+t_densityIsPDF vec+  = not (null vec) ==> test+  where+    (xs,ys)  = kde 4096 (U.fromList vec)+    step     = (xs ! 1) - (xs ! 0)+    integral = integratePDF step ys+    --+    test = counterexample (printf "Integral %f" integral)+         $ abs (1 - integral) <= 1e-3++++integratePDF :: Double -> U.Vector Double -> Double+integratePDF step vec+  = step * sumVector kbn (U.zipWith (*) vec weights)+  where+    n       = U.length vec+    weights = U.generate n go+      where+        go i | i == 0    = 0.5+             | i == n-1  = 0.5+             | otherwise = 1
+ tests/Tests/Matrix.hs view
@@ -0,0 +1,51 @@+module Tests.Matrix (tests) where++import Statistics.Matrix hiding (map)+import Statistics.Matrix.Algorithms+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.QuickCheck (testProperty)+import Test.QuickCheck+import Tests.Matrix.Types+import qualified Data.Vector.Unboxed as U++t_row :: Mat Double -> Gen Property+t_row ms@(Mat r _ xs) = do+  i <- choose (0,r-1)+  return $ row (fromMat ms) i === U.fromList (xs !! i)++t_column :: Mat Double -> Gen Property+t_column ms@(Mat _ c xs) = do+  i <- choose (0,c-1)+  return $ column (fromMat ms) i === U.fromList (map (!! i) xs)++t_center :: Mat Double -> Property+t_center ms@(Mat r c xs) =+  (xs !! (r `quot` 2)) !! (c `quot` 2) === center (fromMat ms)++t_transpose :: Matrix -> Property+t_transpose m = U.concat (map (column n) [0..rows m-1]) === toVector m+  where n = transpose m++t_qr :: Property+t_qr = property $ do+  a <- do (r,c) <- arbitrary+          fromMat <$> arbMatWith r c (fromIntegral <$> choose (-10, 10::Int))+  let (q,r) = qr a+      a'    = multiply q r+  pure $ counterexample ("A  = \n"++show a)+       $ counterexample ("A' = \n"++show a')+       $ counterexample ("Q  = \n"++show q)+       $ counterexample ("R  = \n"++show r)+       $ dimension a == dimension a'+      && ( hasNaN a'+        || and (zipWith (\x y -> abs (x - y) < 1e-12) (toList a) (toList a'))+         )++tests :: TestTree+tests = testGroup "Matrix"+  [ testProperty "t_row" t_row+  , testProperty "t_column" t_column+  , testProperty "t_center" t_center+  , testProperty "t_transpose" t_transpose+  , testProperty "t_qr" t_qr+  ]
+ tests/Tests/Matrix/Types.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE DeriveFunctor #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Tests.Matrix.Types+    (+      Mat(..)+    , fromMat+    , toMat+    , arbMat+    , arbMatWith+    ) where++import Control.Monad (join)+import Control.Applicative ((<$>), (<*>))+import Statistics.Matrix (Matrix(..), fromList)+import Test.QuickCheck+import Tests.Helpers (shrinkFixedList, small)+import qualified Data.Vector.Unboxed as U++data Mat a = Mat { mrows :: Int , mcols :: Int+                 , asList :: [[a]] }+              deriving (Eq, Ord, Show, Functor)++fromMat :: Mat Double -> Matrix+fromMat (Mat r c xs) = fromList r c (concat xs)++toMat :: Matrix -> Mat Double+toMat (Matrix r c v) = Mat r c . split . U.toList $ v+  where split xs@(_:_) = let (h,t) = splitAt c xs+                         in h : split t+        split []       = []++instance (Arbitrary a) => Arbitrary (Mat a) where+    arbitrary = small $ join (arbMat <$> arbitrary <*> arbitrary)+    shrink (Mat r c xs) = Mat r c <$> shrinkFixedList (shrinkFixedList shrink) xs++arbMat+  :: (Arbitrary a)+  => Positive (Small Int)+  -> Positive (Small Int)+  -> Gen (Mat a)+arbMat r c = arbMatWith r c arbitrary++arbMatWith+  :: (Arbitrary a)+  => Positive (Small Int)+  -> Positive (Small Int)+  -> Gen a+  -> Gen (Mat a)+arbMatWith (Positive (Small r)) (Positive (Small c)) genA =+    Mat r c <$> vectorOf r (vectorOf c genA)++instance Arbitrary Matrix where+    arbitrary = fromMat <$> arbitrary+    -- shrink    = map fromMat . shrink . toMat
+ tests/Tests/NonParametric.hs view
@@ -0,0 +1,303 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ViewPatterns     #-}+-- Tests for Statistics.Test.NonParametric+module Tests.NonParametric (tests) where++import Statistics.Distribution.Normal (standard)+import Statistics.Test.KolmogorovSmirnov+import Statistics.Test.MannWhitneyU+import Statistics.Test.KruskalWallis+import Statistics.Test.WilcoxonT+import Statistics.Types (PValue,pValue,mkPValue)++import Test.Tasty                (testGroup)+import Test.Tasty.HUnit+import Tests.ApproxEq            (eq)+import Tests.Helpers             (testAssertion, testEquality)+import Tests.NonParametric.Table (tableKSD, tableKS2D)+import qualified Test.Tasty          as Tst+import qualified Data.Vector.Unboxed as U+++tests :: Tst.TestTree+tests = testGroup "Nonparametric tests"+        $ concat [ mannWhitneyTests+                 , wilcoxonSumTests+                 , wilcoxonPairTests+                 , kruskalWallisRankTests+                 , kruskalWallisTests+                 , kolmogorovSmirnovDTest+                 ]++----------------------------------------------------------------++mannWhitneyTests :: [Tst.TestTree]+mannWhitneyTests = zipWith test [(0::Int)..] testData +++  [ testEquality "Mann-Whitney U Critical Values, m=1"+      (replicate (20*3) Nothing)+      [mannWhitneyUCriticalValue (1,x) (mkPValue p) | x <- [1..20], p <- [0.005,0.01,0.025]]+  , testEquality "Mann-Whitney U Critical Values, m=2, p=0.025"+      (replicate 7 Nothing ++ map Just [0,0,0,0,1,1,1,1,1,2,2,2,2])+      [mannWhitneyUCriticalValue (2,x) (mkPValue 0.025) | x <- [1..20]]+  , testEquality "Mann-Whitney U Critical Values, m=6, p=0.05"+      (replicate 1 Nothing ++ map Just [0, 2,3,5,7,8,10,12,14,16,17,19,21,23,25,26,28,30,32])+      [mannWhitneyUCriticalValue (6,x) (mkPValue 0.05) | x <- [1..20]]+  , testEquality "Mann-Whitney U Critical Values, m=20, p=0.025"+      (replicate 1 Nothing ++ map Just [2,8,14,20,27,34,41,48,55,62,69,76,83,90,98,105,112,119,127])+      [mannWhitneyUCriticalValue (20,x) (mkPValue 0.025) | x <- [1..20]]+  ]+  where+    test n (a, b, c, d)+      = testCase "Mann-Whitney" $ do+          assertEqual ("Mann-Whitney U "     ++ show n) c us+          assertEqual ("Mann-Whitney U Sig " ++ show n) d ss+      where+        us = mannWhitneyU (U.fromList a) (U.fromList b)+        ss = mannWhitneyUSignificant SamplesDiffer (length a, length b) p005 us+    -- List of (Sample A, Sample B, (Positive Rank, Negative Rank))+    testData :: [([Double], [Double], (Double, Double), Maybe TestResult)]+    testData = [ ( [3,4,2,6,2,5]+                 , [9,7,5,10,6,8]+                 , (2, 34)+                 , Just Significant+                 )+               , ( [540,480,600,590,605]+                 , [760,890,1105,595,940]+                 , (2, 23)+                 , Just Significant+                 )+               , ( [19,22,16,29,24]+                 , [20,11,17,12]+                 , (17, 3)+                 , Just NotSignificant+                 )+               , ( [126,148,85,61, 179,93, 45,189,85,93]+                 , [194,128,69,135,171,149,89,248,79,137]+                 , (35,65)+                 , Just NotSignificant+                 )+               , ( [1..30]+                 , [1..30]+                 , (450,450)+                 , Just NotSignificant+                 )+               , ( [1 .. 30]+                 , [11.5 .. 40 ]+                 , (190.0,710.0)+                 , Just Significant+                 )+               ]++wilcoxonSumTests :: [Tst.TestTree]+wilcoxonSumTests = zipWith test [(0::Int)..] testData+  where+    test n (a, b, c) = testCase "Wilcoxon Sum"+                     $ assertEqual ("Wilcoxon Sum " ++ show n) c (wilcoxonRankSums (U.fromList a) (U.fromList b))+    -- List of (Sample A, Sample B, (Positive Rank, Negative Rank))+    testData :: [([Double], [Double], (Double, Double))]+    testData = [ ( [8.50,9.48,8.65,8.16,8.83,7.76,8.63]+                 , [8.27,8.20,8.25,8.14,9.00,8.10,7.20,8.32,7.70]+                 , (75, 61)+                 )+               , ( [0.45,0.50,0.61,0.63,0.75,0.85,0.93]+                 , [0.44,0.45,0.52,0.53,0.56,0.58,0.58,0.65,0.79]+                 , (71.5, 64.5)+                 )+               ]++wilcoxonPairTests :: [Tst.TestTree]+wilcoxonPairTests = zipWith test [(0::Int)..] testData +++  -- Taken from the Mitic paper:+  [ testAssertion "Sig 16, 35" (to4dp 0.0467 $ wilcoxonMatchedPairSignificance 16 35)+  , testAssertion "Sig 16, 36" (to4dp 0.0523 $ wilcoxonMatchedPairSignificance 16 36)+  , testEquality   "Wilcoxon critical values, p=0.05"+      (replicate 4 Nothing ++ map Just [0,2,3,5,8,10,13,17,21,25,30,35,41,47,53,60,67,75,83,91,100,110,119])+      [wilcoxonMatchedPairCriticalValue x (mkPValue 0.05) | x <- [1..27]]+  , testEquality "Wilcoxon critical values, p=0.025"+      (replicate 5 Nothing ++ map Just [0,2,3,5,8,10,13,17,21,25,29,34,40,46,52,58,65,73,81,89,98,107])+      [wilcoxonMatchedPairCriticalValue x (mkPValue 0.025) | x <- [1..27]]+  , testEquality "Wilcoxon critical values, p=0.01"+      (replicate 6 Nothing ++ map Just [0,1,3,5,7,9,12,15,19,23,27,32,37,43,49,55,62,69,76,84,92])+      [wilcoxonMatchedPairCriticalValue x (mkPValue 0.01) | x <- [1..27]]+  , testEquality "Wilcoxon critical values, p=0.005"+      (replicate 7 Nothing ++ map Just [0,1,3,5,7,9,12,15,19,23,27,32,37,42,48,54,61,68,75,83])+      [wilcoxonMatchedPairCriticalValue x (mkPValue 0.005) | x <- [1..27]]+  ]+  where+    test n (a, b, c) = testEquality ("Wilcoxon Paired " ++ show n) c res+      where res = wilcoxonMatchedPairSignedRank (U.zip (U.fromList a) (U.fromList b))++    -- List of (Sample A, Sample B, (Positive Rank, Negative Rank))+    testData :: [([Double], [Double], (Int,Double, Double))]+    testData = [ ([1..10], [1..10], (0, 0, 0     ))+               , ([1..5],  [6..10], (5, 0, 5*(-3)))+               -- Worked example from the Internet:+               , ( [125,115,130,140,140,115,140,125,140,135]+                 , [110,122,125,120,140,124,123,137,135,145]+                 , ( 9+                   , sum $ filter (> 0) [7,-3,1.5,9,0,-4,8,-6,1.5,-5]+                   , sum $ filter (< 0) [7,-3,1.5,9,0,-4,8,-6,1.5,-5]+                   )+                 )+               -- Worked examples from books/papers:+               , ( [2.4,1.9,2.3,1.9,2.4,2.5]+                 , [2.0,2.1,2.0,2.0,1.8,2.0]+                 , (6, 18, -3)+                 )+               , ( [130,170,125,170,130,130,145,160]+                 , [120,163,120,135,143,136,144,120]+                 , (8, 27, -9)+                 )+               , ( [540,580,600,680,430,740,600,690,605,520]+                 , [760,710,1105,880,500,990,1050,640,595,520]+                 , (9, 3, -42)+                 )+               ]+    to4dp tgt (pValue -> x) = x >= tgt - 0.00005 && x < tgt + 0.00005++----------------------------------------------------------------++kruskalWallisRankTests :: [Tst.TestTree]+kruskalWallisRankTests = zipWith test [(0::Int)..] testData+  where+    test n (a, b) = testCase "Kruskal-Wallis Ranking"+                  $ assertEqual ("Kruskal-Wallis " ++ show n) (map U.fromList b) (kruskalWallisRank $ map U.fromList a)+    testData :: [([[Int]],[[Double]])]+    testData = [ ( [ [68,93,123,83,108,122]+                   , [119,116,101,103,113,84]+                   , [70,68,54,73,81,68]+                   , [61,54,59,67,59,70]+                   ]+                 , [ [8.0,14.0,16.0,19.0,23.0,24.0]+                   , [15.0,17.0,18.0,20.0,21.0,22.0]+                   , [1.5,8.0,8.0,10.5,12.0,13.0]+                   , [1.5,3.5,3.5,5.0,6.0,10.5]+                   ]+                 )+               ]++kruskalWallisTests :: [Tst.TestTree]+kruskalWallisTests = zipWith test [(0::Int)..] testData+  where+    test n (a, b, c) = testCase "Kruskal-Wallis" $ do+        assertEqual ("Kruskal-Wallis " ++ show n) (round100 b) (round100 kw)+        assertEqual ("Kruskal-Wallis Sig " ++ show n) c kwt+      where+        kw  = kruskalWallis $ map U.fromList a+        kwt = isSignificant p005 `fmap` kruskalWallisTest (map U.fromList a)+        round100 :: Double -> Integer+        round100 = round . (*100)++    testData :: [([[Double]], Double, Maybe TestResult)]+    testData = [ ( [ [68,93,123,83,108,122]+                   , [119,116,101,103,113,84]+                   , [70,68,54,73,81,68]+                   , [61,54,59,67,59,70]+                   ]+                 , 16.03+                 , Just Significant+                 )+               , ( [ [5,5,3,5,5,5,5]+                   , [5,5,5,5,7,5,5]+                   , [5,5,6,5,5,5,5]+                   , [4,5,5,5,6,5,5]+                   ]+               , 2.24+               , Just NotSignificant+               )+               , ( [ [36,48,5,67,53]+                   , [49,33,60,2,55]+                   , [71,31,140,59,42]+                   ]+                 , 1.22+                 , Just NotSignificant+                 )+               , ( [ [6,38,3,17,11,30,15,16,25,5]+                   , [34,28,42,13,40,31,9,32,39,27]+                   , [13,35,19,4,29,0,7,33,18,24]+                   ]+                 , 6.10+                 , Just Significant+                 )+               ]+++----------------------------------------------------------------+-- K-S test+----------------------------------------------------------------+++kolmogorovSmirnovDTest :: [Tst.TestTree]+kolmogorovSmirnovDTest =+  [ testAssertion "K-S D statistics" $+    and [ eq 1e-6 (kolmogorovSmirnovD standard (toU sample)) reference+        | (reference,sample) <- tableKSD+        ]+  , testAssertion "K-S 2-sample statistics" $+    and [ eq 1e-6 (kolmogorovSmirnov2D (toU xs) (toU ys)) reference+        | (reference,xs,ys) <- tableKS2D+        ]+  , testAssertion "K-S probability" $+    and [ eq 1e-14 (kolmogorovSmirnovProbability n d) p+        | (d,n,p) <- testData+        ]+  ]+  where+    toU = U.fromList+    -- Test data for the calculation of cumulative probability+    -- P(D[n] < d).+    --+    -- Test data is:+    --    (D[n], n, p)+    -- Table is generated using sample program from paper+    testData :: [(Double,Int,Double)]+    testData =+      [ (0.09           ,    3, 0                   )+      , (0.2            ,    3, 0.00177777777777778 )+      , (0.301          ,    3, 0.116357025777778   )+      , (0.392          ,    3, 0.383127210666667   )+      , (0.5003         ,    3, 0.667366306558667   )+      , (0.604          ,    3, 0.861569877333333   )+      , (0.699          ,    3, 0.945458198         )+      , (0.802          ,    3, 0.984475216         )+      , (0.9            ,    3, 0.998               )+      , (0.09           ,    5, 0                   )+      , (0.2            ,    5, 0.0384              )+      , (0.301          ,    5, 0.33993786080016    )+      , (0.392          ,    5, 0.66931908083712    )+      , (0.5003         ,    5, 0.888397260183794   )+      , (0.604          ,    5, 0.971609957879808   )+      , (0.699          ,    5, 0.994331075994008   )+      , (0.802          ,    5, 0.999391366368064   )+      , (0.9            ,    5, 0.99998             )+      , (0.09           ,    8, 3.37615237575e-06   )+      , (0.2            ,    8, 0.151622071801758   )+      , (0.301          ,    8, 0.613891042670582   )+      , (0.392          ,    8, 0.871491561427005   )+      , (0.5003         ,    8, 0.977534089199071   )+      , (0.604          ,    8, 0.997473116268255   )+      , (0.699          ,    8, 0.999806082005123   )+      , (0.802          ,    8, 0.999995133786947   )+      , (0.9            ,    8, 0.99999998          )+      , (0.09           ,   10, 3.89639433093119e-05)+      , (0.2            ,   10, 0.25128096          )+      , (0.301          ,   10, 0.732913126355935   )+      , (0.392          ,   10, 0.932185254518767   )+      , (0.5003         ,   10, 0.992276179340446   )+      , (0.604          ,   10, 0.999495533516769   )+      , (0.699          ,   10, 0.999979691783985   )+      , (0.802          ,   10, 0.999999801409237   )+      , (0.09           ,   20, 0.00794502217168886 )+      , (0.2            ,   20, 0.647279826376584   )+      , (0.301          ,   20, 0.958017466965765   )+      , (0.392          ,   20, 0.997206424843499   )+      , (0.5003         ,   20, 0.999962641414228   )+      , (0.09           ,   30, 0.0498147538075168  )+      , (0.2            ,   30, 0.842030838984526   )+      , (0.301          ,   30, 0.993403560017612   )+      , (0.392          ,   30, 0.99988478803318    )+      , (0.09           ,  100, 0.629367974413669   )+      ]++p005 :: PValue Double+p005 = mkPValue 0.05
+ tests/Tests/NonParametric/Table.hs view
@@ -0,0 +1,39 @@+module Tests.NonParametric.Table (+      tableKSD+    , tableKS2D+    ) where++-- Table for Kolmogorov-Smirnov statistics for standard normal+-- distribution. Generated using R.+--+-- First element of tuple is D second is sample for which it was+-- calculated.+tableKSD :: [(Double,[Double])]+tableKSD =+  [ (0.2012078,[1.360645,-0.3151904,-1.245443,0.1741977,-0.1421206,-1.798246,1.171594,-1.335844,-5.050093e-2,1.030063,-1.849005,0.6491455,-0.7028004])+  , (0.2569956,[0.3884734,-1.227821,-0.4166262,0.429118,-0.9280124,0.8025867,-0.6703089,-0.2124872,0.1224496,0.1087734,-4.285284e-2,-1.039936,-0.7071956])+  , (0.1960356,[-1.814745,-0.6327167,0.7082493,0.6264716,1.02061,-0.4094635,0.821026,-0.4255047,-0.4820728,-0.2239833,0.648517,1.114283,0.3610216])+  , (0.2095746,[0.187011,0.1805498,0.4448389,0.6065506,0.2308673,0.5292549,-1.489902,-1.455191,0.5449396,-0.1436403,-0.7977073,-0.2693545,0.8260888,-1.474473,-2.158696e-2,-0.1455387])+  , (0.1922603,[0.5772317,-1.255561,1.605823,0.4923361,0.2470848,1.176101,-0.3767689,-0.6896885,0.4509345,-0.5048447,0.9436534,1.025599,0.2998393,-3.415219e-2,1.264315,-1.44433,-1.646449e-2])+  , (0.2173401,[1.812807,-0.8687497,-0.5710508,1.003647,1.142621,0.6546577,-6.083323e-3,1.628574e-2,1.067499,-1.953143,-0.6060077,1.90859,-0.7480553,0.6715162,-0.928759,1.862,1.604621,-0.2171044,-0.1835918])+  , (0.2510541,[-0.4769572,1.062319,0.9952284,1.198086,1.015589,-0.4154523,-0.6711762,1.202902,0.2217098,5.381759e-2,0.6679715,0.2551287,-0.1371492])+  , (0.1996022,[1.158607,-0.7354863,1.526559,-0.7855418,-2.82999,-0.6045106,-0.1830228,0.3306812,-0.819657,-1.223715,0.2536423,-0.4155781,1.447042])+  , (0.2284761,[1.239965,0.8187093,0.5199788,1.172072,0.748259,1.869376e-2,0.1625921,-1.712065,0.7043582,-1.702702,-0.4792806,-0.1023351,0.1187189])+  , (0.2337866,[0.9417261,-0.1024297,-0.7354359,1.099991,0.801984,-0.3745397,-1.749564,1.795771,1.099963,-0.605557,-2.035897,1.893603,-0.3468928,-0.2593938,2.100988,0.9665698,0.8757091,0.7696328,0.8730729,-0.3990352,2.04361,-0.4617864,-0.155021,2.15774,0.2687795,-0.9853512,-0.3264898,1.260026,4.267695,-0.5571145,0.6307067,-0.1691405,-1.730686])+  , (0.3389167,[2.025542,-1.542641,-1.090238,3.99027,9.949129e-2,-0.8974433,-2.508418,6.390346,-2.675515,1.154459,1.688072,2.220727,-0.4743102])+  , (0.4920231,[0.5192906,-3.260813,-1.245185,1.693084,3.561318,4.058924,2.27063,0.9446943,4.794159,-3.423733,0.8240817,0.644059,0.900175,1.932513,1.024586,2.82823,2.072192,-0.353231,-0.4319673,1.505952,1.0199,4.555054,2.364929,5.531467,3.279415,3.19821,2.726925,1.680027,-0.9041334,-0.8246765,-1.343979,8.454955,1.354581])+  , (0.6727408,[-6.705672,-3.193988,-4.612611,-3.207994,-5.070172,-6.141169,-0.397149,-4.093359,-1.204801,-3.986585,-2.724662,0.9868107,-6.295266,-5.95839,-6.35114,-1.679555,-2.635889,-4.050329,1.557428,-2.548465,-0.9073924,-1.502018,-4.535688,-4.158818,-8.833434,-5.944697,-1.569672,-4.70399,-7.832059,-4.093708,-8.393417,-2.085432,-7.06495,-0.4230419,-3.046822,-3.23895,-0.9265873,-9.227822,3.293713,-5.593577,-5.942398,-4.358421,2.660044,-4.301572,-1.258879,0.1499903,3.572833,-3.19844,0.8652432,-0.3025793,-1.576673,-7.666265,-6.751463,-1.398944,-2.690656,-1.429654,7.508364e-2,0.7998344,-3.562074,-1.021431,1.342968,2.110244,-7.561497,-2.372083,-3.649193,-5.7723,-1.068083,0.7537809,-4.569546,-1.198005,-5.638384,-1.227226,-1.195852,-1.118175,-9.130527,0.9675821,-2.497391,0.5988562,-1.965783,-4.25741,-6.547006,-1.459294,-2.380556,-3.977307,-7.809006,-4.276819,-4.028746,-9.055546,-3.599239,-1.470512,-8.253329,-1.351687,-4.269324,-6.140353,-6.30808,-1.834091,-3.135146,-9.391791,3.117815,-5.554733,-2.556769,-3.287376,-2.064013,-5.741995,-5.047918,-4.808841,-1.488526,-0.2351115,-5.760833,-2.722929,-7.012353,2.281171,-3.890514,-1.516824,-1.41011,-1.828457,-5.561244,-3.472142,-10.16919,-0.4369042,-5.698953,-4.587462,-4.897086])+  ]++-- Table for 2-sample Kolmogorov-Smirnov statistics. Generated using R+--+-- First element is D, second and third are samples+tableKS2D :: [(Double,[Double],[Double])]+tableKS2D =+  [ (0.2820513,[-0.4212928,2.146532,0.7585263,-0.5086105,-0.7725486,6.235548e-2,-0.1849861,0.861972,-0.1958534,-3.379697e-2,-1.316854,0.6701269],[0.4957582,0.4241167,0.9822869,0.4504248,-0.1749617,1.178098,-1.117222,-0.859273,0.3073736,0.4344583,-0.4761338,-1.332374,1.487291])+  , (0.2820513,[-0.712252,0.7990333,-0.7968473,1.443609,1.163096,-1.349071,-0.1553941,-2.003104,-0.3400618,-0.7019282,0.183293,-0.2352167],[-0.4622455,-0.8132221,0.1161614,-1.472115e-2,1.001454,-6.557789e-2,-0.2531216,-1.032432,0.4105478,1.749614,0.9722899,5.850942e-2,-0.3352746])+  , (0.2564103,[0.3509882,-0.2982833,1.314731,1.264223,-0.8156374,0.3734029,-3.288915e-2,0.6766016,0.9786335,0.1079949,-0.4211722,1.58656],[0.8024675,7.464538e-2,0.2739861,-2.334255e-2,0.5611802,0.6683374,0.4358206,0.349843,1.207834,1.402578,-0.4049183,0.4286042,1.665129])+  , (0.1833333,[1.376196,9.926384e-2,2.199292,-2.04993,0.5585353,-0.4812132,0.1041527,2.084774,0.71194,-1.398245,-4.458574e-2,1.484945,-1.473182,1.020076,-0.7019646,0.2182066,-1.702963,-0.3522622,-0.8129267,-0.6338972],[-1.020371,0.3323861,1.513288,0.1958708,-1.0723,5.323446e-2,-0.9993713,-0.7046356,-0.6781067,-0.4471603,1.512042,-0.2650665,-4.765228e-2,-1.501205,1.228664,0.5332935,-0.2960315,-0.1509683])+  , (0.5666667,[0.7145305,0.1255674,2.001531,0.1419216],[2.113474,-0.3352839,-0.4962429,-1.386079,0.6404667,-0.7145304,0.1084008,-0.9821421,-2.270472,-1.003846,-0.5644588,2.699695,-1.296494,-0.1538839,1.319094,-1.127544,0.3568889,0.2004726,-1.313291,0.3581084,0.3313498,0.9336278,0.9850203,-1.309506,1.170459,-0.7517466,-1.771269,0.7156381,-1.129691,0.877729])+  , (0.5,[0.6950626,0.1643805,-0.3102472,0.4810762,0.1844602,1.338836,-0.8083386,-0.5482141,0.9532421,-0.2644837],[7.527945,-1.95654,1.513725,-1.318431,2.453895,0.2078194,0.7371092,2.834245,-2.134794,3.938259])+  ]
+ tests/Tests/Orphanage.hs view
@@ -0,0 +1,117 @@+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- |+-- Orphan instances for common data types+module Tests.Orphanage where++import Control.Applicative+import Statistics.Distribution.Beta            (BetaDistribution, betaDistr)+import Statistics.Distribution.Binomial        (BinomialDistribution, binomial)+import Statistics.Distribution.CauchyLorentz+import Statistics.Distribution.ChiSquared      (ChiSquared, chiSquared)+import Statistics.Distribution.Exponential     (ExponentialDistribution, exponential)+import Statistics.Distribution.FDistribution   (FDistribution, fDistribution)+import Statistics.Distribution.Gamma           (GammaDistribution, gammaDistr)+import Statistics.Distribution.Geometric+import Statistics.Distribution.Hypergeometric+import Statistics.Distribution.Laplace         (LaplaceDistribution, laplace)+import Statistics.Distribution.Lognormal       (LognormalDistribution, lognormalDistr)+import Statistics.Distribution.NegativeBinomial (NegativeBinomialDistribution, negativeBinomial)+import Statistics.Distribution.Normal          (NormalDistribution, normalDistr)+import Statistics.Distribution.Poisson         (PoissonDistribution, poisson)+import Statistics.Distribution.StudentT+import Statistics.Distribution.Transform       (LinearTransform, scaleAround)+import Statistics.Distribution.Uniform         (UniformDistribution, uniformDistr)+import Statistics.Distribution.Weibull         (WeibullDistribution, weibullDistr)+import Statistics.Distribution.DiscreteUniform (DiscreteUniform, discreteUniformAB)+import Statistics.Types++import Test.QuickCheck         as QC+++----------------------------------------------------------------+-- Arbitrary instances for distributions+----------------------------------------------------------------++instance QC.Arbitrary BinomialDistribution where+  arbitrary = binomial <$> QC.choose (1,100) <*> QC.choose (0,1)+instance QC.Arbitrary ExponentialDistribution where+  arbitrary = exponential <$> QC.choose (0,100)+instance QC.Arbitrary LaplaceDistribution where+  arbitrary = laplace <$> QC.choose (-10,10) <*> QC.choose (0, 2)+instance QC.Arbitrary GammaDistribution where+  arbitrary = gammaDistr <$> QC.choose (0.1,100) <*> QC.choose (0.1,100)+instance QC.Arbitrary BetaDistribution where+  arbitrary = betaDistr <$> QC.choose (1e-3,10) <*> QC.choose (1e-3,10)+instance QC.Arbitrary GeometricDistribution where+  arbitrary = geometric <$> QC.choose (1e-10,1)+instance QC.Arbitrary GeometricDistribution0 where+  arbitrary = geometric0 <$> QC.choose (1e-10,1)+instance QC.Arbitrary HypergeometricDistribution where+  arbitrary = do l <- QC.choose (1,20)+                 m <- QC.choose (0,l)+                 k <- QC.choose (1,l)+                 return $ hypergeometric m l k+instance QC.Arbitrary LognormalDistribution where+  -- can't choose sigma too big, otherwise goes outside of double-float limit+  arbitrary = lognormalDistr <$> QC.choose (-100,100) <*> QC.choose (1e-10, 20)+instance QC.Arbitrary NegativeBinomialDistribution where+  arbitrary = negativeBinomial <$> QC.choose (1,100) <*> QC.choose (1e-10,1)+instance QC.Arbitrary NormalDistribution where+  arbitrary = normalDistr <$> QC.choose (-100,100) <*> QC.choose (1e-3, 1e3)+instance QC.Arbitrary PoissonDistribution where+  arbitrary = poisson <$> QC.choose (0,1)+instance QC.Arbitrary ChiSquared where+  arbitrary = chiSquared <$> QC.choose (1,100)+instance QC.Arbitrary UniformDistribution where+  arbitrary = do a <- QC.arbitrary+                 b <- QC.arbitrary `suchThat` (/= a)+                 return $ uniformDistr a b+instance QC.Arbitrary WeibullDistribution where+  arbitrary = weibullDistr <$> QC.choose (1e-3,1e3) <*> QC.choose (1e-3, 1e3)+instance QC.Arbitrary CauchyDistribution where+  arbitrary = cauchyDistribution+                <$> arbitrary+                <*> ((abs <$> arbitrary) `suchThat` (> 0))+instance QC.Arbitrary StudentT where+  arbitrary = studentT <$> ((abs <$> arbitrary) `suchThat` (>0))+instance QC.Arbitrary d => QC.Arbitrary (LinearTransform d) where+  arbitrary = do+    m <- QC.choose (-10,10)+    s <- QC.choose (1e-1,1e1)+    d <- arbitrary+    return $ scaleAround m s d+instance QC.Arbitrary FDistribution where+  arbitrary =  fDistribution+           <$> ((abs <$> arbitrary) `suchThat` (>0))+           <*> ((abs <$> arbitrary) `suchThat` (>0))+++instance (Arbitrary a, Ord a, RealFrac a) => Arbitrary (PValue a) where+  arbitrary = do+    (_::Int,x) <- properFraction <$> arbitrary+    return $ mkPValue $ abs x++instance (Arbitrary a, Ord a, RealFrac a) => Arbitrary (CL a) where+  arbitrary = do+    (_::Int,x) <- properFraction <$> arbitrary+    return $ mkCLFromSignificance $ abs x++instance Arbitrary a => Arbitrary (NormalErr a) where+  arbitrary = NormalErr <$> arbitrary++instance Arbitrary a => Arbitrary (ConfInt a) where+  arbitrary = liftA3 ConfInt arbitrary arbitrary arbitrary++instance (Arbitrary (e a), Arbitrary a) => Arbitrary (Estimate e a) where+  arbitrary = liftA2 Estimate arbitrary arbitrary++instance (Arbitrary a) => Arbitrary (UpperLimit a) where+  arbitrary = liftA2 UpperLimit arbitrary arbitrary++instance (Arbitrary a) => Arbitrary (LowerLimit a) where+  arbitrary = liftA2 LowerLimit arbitrary arbitrary++instance QC.Arbitrary DiscreteUniform where+  arbitrary = discreteUniformAB <$> QC.choose (1,1000) <*> QC.choose(1,1000)
+ tests/Tests/Parametric.hs view
@@ -0,0 +1,224 @@+module Tests.Parametric (tests) where++import Data.Maybe (fromJust)+import Statistics.Test.StudentT+import Statistics.Types+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector as V+import Test.Tasty (testGroup, TestTree)+import Test.Tasty.HUnit (testCase, assertBool)+import Tests.Helpers (testEquality)+import qualified Test.Tasty as Tst++import Statistics.Test.Levene+import Statistics.Test.Bartlett+++tests :: Tst.TestTree+tests = testGroup "Parametric tests" [studentTTests, bartlettTests, leveneTests]++-- 2 samples x 20 obs data+--+-- Both samples are samples from normal distributions with the same variance (= 1.0),+-- but their means are different (0.0 and 0.5, respectively).+--+-- You can reproduce the data with R (3.1.0) as follows:+--   set.seed(0)+--   sample1 = rnorm(20)+--   sample2 = rnorm(20, 0.5)+--   student = t.test(sample1, sample2, var.equal=T)+--   welch = t.test(sample1, sample2)+--   paired = t.test(sample1, sample2, paired=T)+sample1, sample2 :: U.Vector Double+sample1 = U.fromList [+  1.262954284880793e+00,+ -3.262333607056494e-01,+  1.329799262922501e+00,+  1.272429321429405e+00,+  4.146414344564082e-01,+ -1.539950041903710e+00,+ -9.285670347135381e-01,+ -2.947204467905602e-01,+ -5.767172747536955e-03,+  2.404653388857951e+00,+  7.635934611404596e-01,+ -7.990092489893682e-01,+ -1.147657009236351e+00,+ -2.894615736882233e-01,+ -2.992151178973161e-01,+ -4.115108327950670e-01,+  2.522234481561323e-01,+ -8.919211272845686e-01,+  4.356832993557186e-01,+ -1.237538421929958e+00]+sample2 = U.fromList [+  2.757321147216907e-01,+  8.773956459817011e-01,+  6.333363608148415e-01,+  1.304189509744908e+00,+  4.428932256161913e-01,+  1.003607972233726e+00,+  1.585769362145687e+00,+ -1.909538396968303e-01,+ -7.845993538721883e-01,+  5.467261721883520e-01,+  2.642934435604988e-01,+ -4.288825501025439e-02,+  6.668968254321778e-02,+ -1.494716467962331e-01,+  1.226750747385451e+00,+  1.651911754087200e+00,+  1.492160365445798e+00,+  7.048689050811874e-02,+  1.738304100853380e+00,+  2.206537181457307e-01]+++testTTest :: String+          -> PValue Double+          -> Test d+          -> [Tst.TestTree]+testTTest name pVal test =+  [ testEquality name (isSignificant pVal test) NotSignificant+  , testEquality name (isSignificant (mkPValue $ pValue pVal + 1e-5) test)+    Significant+  ]++studentTTests :: Tst.TestTree+studentTTests = testGroup "StudentT test" $ concat+  [ -- R: t.test(sample1, sample2, alt="two.sided", var.equal=T)+    testTTest "two-sample t-test SamplesDiffer Student"+      (mkPValue 0.03410) (fromJust $ studentTTest SamplesDiffer sample1 sample2)+    -- R: t.test(sample1, sample2, alt="two.sided", var.equal=F)+  , testTTest "two-sample t-test SamplesDiffer Welch"+      (mkPValue 0.03483) (fromJust $ welchTTest SamplesDiffer sample1 sample2)+    -- R: t.test(sample1, sample2, alt="two.sided", paired=T)+  , testTTest "two-sample t-test SamplesDiffer Paired"+      (mkPValue 0.03411) (fromJust $ pairedTTest SamplesDiffer sample12)+    -- R: t.test(sample1, sample2, alt="less", var.equal=T)+  , testTTest "two-sample t-test BGreater Student"+      (mkPValue 0.01705) (fromJust $ studentTTest BGreater sample1 sample2)+    -- R: t.test(sample1, sample2, alt="less", var.equal=F)+  , testTTest "two-sample t-test BGreater Welch"+      (mkPValue 0.01741) (fromJust $ welchTTest BGreater sample1 sample2)+    -- R: t.test(sample1, sample2, alt="less", paired=F)+  , testTTest "two-sample t-test BGreater Paired"+      (mkPValue 0.01705) (fromJust $ pairedTTest BGreater sample12)+  ]+  where sample12 = U.zip sample1 sample2+++------------------------------------------------------------+-- Bartlett's Test+------------------------------------------------------------++bartlettTests :: TestTree+bartlettTests = testGroup "Bartlett's test"+  [ testCase "a,b,c" $ testBartlettTest [a,b,c] 1.8027132567760222   0.40601846976301237+  , testCase "a,b"   $ testBartlettTest [a,b]   0.005221063776321886 0.9423974408021293+  , testCase "a,c"   $ testBartlettTest [a,c]   1.1531619271845452   0.2828882244527482+  , testCase "a,a"   $ testBartlettTest [a,a]   0.0                  1.0+  ]+  where+    a = U.fromList [9.88, 9.12, 9.04, 8.98, 9.00, 9.08, 9.01, 8.85, 9.06, 8.99]+    b = U.fromList [8.88, 8.95, 9.29, 9.44, 9.15, 9.58, 9.36, 9.18, 8.67, 9.05]+    c = U.fromList [8.95, 8.12, 8.95, 8.85, 8.03, 8.84, 8.07, 8.98, 8.86, 8.98]++testBartlettTest+  :: [U.Vector Double]+  -> Double+  -> Double+  -> IO ()+testBartlettTest samples w p = do+  r <- case bartlettTest samples of+    Left  _ -> error "Bartlett's test failed"+    Right r -> pure r+  approxEqual "W" 1e-9 (testStatistics r)            w+  approxEqual "p" 1e-9 (pValue $ testSignificance r) p++------------------------------------------------------------+-- Levene's Test (Trimmed Mean)+------------------------------------------------------------++leveneTests :: TestTree+leveneTests = testGroup "Levene test"+  -- Statistics' value and p-values are computed using +  [ testCase "a,b,c Mean"    $ testLeveneTest [a,b,c] Mean   7.905194483442054 0.001983795817472731+  , testCase "a,b   Mean"    $ testLeveneTest [a,b]   Mean   8.83873787256358  0.008149720958328811+  , testCase "a,a   Mean"    $ testLeveneTest [a,a]   Mean   0.0               1.0+  , testCase "a,b,c Median"  $ testLeveneTest [a,b,c] Median 7.584952754501659 0.002431505967249681+  , testCase "a,b   Median"  $ testLeveneTest [a,b]   Median 8.461374333228711 0.009364737715584399+  , testCase "aL,bL Mean"    $ testLeveneTest [aL,bL] Mean   5.84424549939465  0.01653410652558999+  , testCase "aL,bL Trimmed" $ testLeveneTest [aL,bL] (Trimmed 0.05) 8.368311226366314 0.004294953946529551+  ]+  where+    a = V.fromList [8.88, 9.12, 9.04, 8.98, 9.00, 9.08, 9.01, 8.85, 9.06, 8.99]+    b = V.fromList [8.88, 8.95, 9.29, 9.44, 9.15, 9.58, 8.36, 9.18, 8.67, 9.05]+    c = V.fromList [8.95, 9.12, 8.95, 8.85, 9.03, 8.84, 9.07, 8.98, 8.86, 8.98]+    -- Large samples for testing trimmed+    aL = V.fromList [+      -0.18919252, -1.62837673,  5.21332355, -0.00962043, -0.28417847,+      -0.88128233,  1.49698436,  6.1780359 , -1.22301348,  3.34598245,+       5.33227264, -0.88732069,  0.14487346,  2.61060215,  4.22033907,+       2.53139215, -0.72131061,  0.53063607, -0.60510374, -0.73230842,+       1.54037043, -2.81103963,  3.40763063,  0.49005324,  2.13085513,+       5.68650547,  4.16397279, -0.17325097,  1.12664972,  4.23297516,+       4.15943436, -1.01452078,  2.40391646,  0.83019962,  0.29665879,+      -3.83031046, -1.98576933,  1.5356527 ,  1.30773365,  0.292818  ,+       2.45877828,  1.06482289, -0.63241873,  1.58465379,  1.96577614,+       2.25791943,  4.13769848, -2.38595767, -0.65801423, -2.54007791,+       3.17428087,  4.32096964,  0.92240335, -2.38101319,  1.35692587,+       1.48279101, -0.04438309,  0.50296642,  2.08261495,  1.33181215,+      -1.95427198,  4.95406809,  1.51294898, -2.68536129, -0.2441218 ,+       2.41142613,  4.71051493,  2.66618697,  1.12668301, -0.25732583,+       1.25021838, -1.27523641,  5.01638744,  3.38864442,  0.17979744,+      -0.88481645,  3.89346357, -0.51512217, -1.60542888,  0.88378679,+      -2.12962732, -1.35989539,  5.09215112, -1.37442481,  0.83578405,+       0.13829571,  1.25171481,  3.60552158, -3.24051591, -0.44301834,+       0.78253445,  1.76098254,  1.79677434, -0.19010505,  3.07640466,+       3.02853882,  1.24849063,  4.84505382,  6.82274999,  2.24063474]+    bL = V.fromList [+        2.15584101, -2.74876744, -0.82231894,  1.97518087,  2.59280595,+        1.28703417,  2.40450278,  1.9761031 ,  2.35186598,  1.15611047,+        2.26709318,  1.2832138 , -2.1486074 ,  0.27563011, -0.51816861,+        0.89658424,  3.27069545,  1.72846646,  3.84454277,  5.58301459,+       -0.40878188,  3.41602853,  1.1281526 ,  0.9665913 ,  0.76567084,+        1.69522855,  1.69133014,  0.70529264,  2.65243202, -1.0088019 ,+       -0.62431026,  3.76667396,  3.66225181,  0.73217579,  0.04478736,+        0.4169833 ,  0.77065631, -1.31484093,  1.23858618, -0.08339456,+        3.14154286,  1.84358218, -0.53511423, -3.4919477 ,  0.24076997,+        3.59381684,  1.99497806,  2.95499775,  1.67157731,  0.0214764 ,+        3.32161612, -2.64762427,  0.06486472,  0.19653897,  1.34954235,+        1.18568747, -0.54434597, -3.35544223,  1.41933109,  0.95100195,+        2.7182116 ,  1.1334068 , -0.95297806, -0.05421818,  1.42248799,+       -3.96201277, -3.21309254, -0.21209211,  0.9689551 ,  0.13526401,+       -0.88656198,  0.41331783, -3.18766064,  4.34948246,  1.35656384,+        0.41920101, -0.46578994,  1.55181583,  2.43937014,  2.49040644,+        4.10505494,  1.68856296,  1.31503895,  0.41123368,  0.73242999,+        0.2804349 , -1.83494592, -0.31073195,  2.61185513,  2.91645094,+        1.26097638,  2.64197134,  3.88931972,  0.03783002,  2.55209729,+        3.46869549,  0.96348003,  2.27658242,  2.7613171 , -0.1372434 ]++    +testLeveneTest+  :: [V.Vector Double]+  -> Center+  -> Double+  -> Double+  -> IO ()+testLeveneTest samples center w p = do+  r <- case levenesTest center samples of+    Left  _ -> error "Levene's test failed"+    Right r -> pure r+  approxEqual "W" 1e-9 (testStatistics r)            w+  approxEqual "p" 1e-9 (pValue $ testSignificance r) p+++----------------------------------------------------------------++approxEqual :: String -> Double -> Double -> Double -> IO ()+approxEqual name epsilon actual expected =+  assertBool (name ++ ": expected ≈ " ++ show expected ++ ", got " ++ show actual)+             (diff < epsilon)+  where+    diff = abs (actual - expected)
+ tests/Tests/Quantile.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE ViewPatterns #-}+-- |+-- Tests for quantile+module Tests.Quantile (tests) where++import Control.Exception+import qualified Data.Vector.Unboxed as U+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck hiding (sample)+import Numeric.MathFunctions.Comparison (ulpDelta,ulpDistance)+import Statistics.Quantile++tests :: TestTree+tests = testGroup "Quantiles"+  [ testCase "R alg. 4" $ compareWithR cadpw (0.00, 0.50, 2.50, 8.25, 10.00)+  , testCase "R alg. 5" $ compareWithR hazen (0.00, 1.00, 5.00, 9.00, 10.00)+  , testCase "R alg. 6" $ compareWithR spss  (0.00, 0.75, 5.00, 9.25, 10.00)+  , testCase "R alg. 7" $ compareWithR s     (0.000, 1.375, 5.000, 8.625,10.00)+  , testCase "R alg. 8" $ compareWithR medianUnbiased+      (0.0, 0.9166666666666667, 5.000000000000003, 9.083333333333334, 10.0)+  , testCase "R alg. 9" $ compareWithR normalUnbiased+      (0.0000, 0.9375, 5.0000, 9.0625, 10.0000)+  , testProperty "alg 7." propWeigtedAverage+    -- Test failures+  , testCase "weightedAvg should throw errors" $ do+      let xs  = U.fromList [1,2,3]+          xs0 = U.fromList []+      shouldError "Empty sample" $ weightedAvg 1 4 xs0+      shouldError "N=0"  $ weightedAvg 1 0 xs+      shouldError "N=1"  $ weightedAvg 1 1 xs+      shouldError "k<0"  $ weightedAvg (-1) 4 xs+      shouldError "k>N"  $ weightedAvg 5    4 xs+  , testCase "quantile should throw errors" $ do+      let xs  = U.fromList [1,2,3]+          xs0 = U.fromList []+      shouldError "Empty xs" $ quantile s 1 4 xs0+      shouldError "N=0"  $ quantile s 1 0 xs+      shouldError "N=1"  $ quantile s 1 1 xs+      shouldError "k<0"  $ quantile s (-1) 4 xs+      shouldError "k>N"  $ quantile s 5    4 xs+    --+  , testProperty "quantiles    are OK" propQuantiles+  , testProperty "quantilesVec are OK" propQuantilesVec+  ]++sample :: U.Vector Double+sample = U.fromList [0, 1, 2.5, 7.5, 9, 10]++-- Compare quantiles implementation with reference R implementation+compareWithR :: ContParam -> (Double,Double,Double,Double,Double) -> Assertion+compareWithR p (q0,q1,q2,q3,q4) = do+  assertEqual "Q 0" q0 $ quantile p 0 4 sample+  assertEqual "Q 1" q1 $ quantile p 1 4 sample+  assertEqual "Q 2" q2 $ quantile p 2 4 sample+  assertEqual "Q 3" q3 $ quantile p 3 4 sample+  assertEqual "Q 4" q4 $ quantile p 4 4 sample++propWeigtedAverage :: Positive Int -> Positive Int -> Property+propWeigtedAverage (Positive k) (Positive q) =+  (q >= 2 && k <= q) ==> let q1 = weightedAvg k q sample+                             q2 = quantile s k q sample+                         in counterexample ("weightedAvg   = " ++ show q1)+                          $ counterexample ("quantile      = " ++ show q2)+                          $ counterexample ("delta in ulps = " ++ show (ulpDelta q1 q2))+                          $ ulpDistance q1 q2 <= 16++propQuantiles :: Positive Int -> Int -> Int -> NonEmptyList Double -> Property+propQuantiles (Positive n)+              ((`mod` n) -> k1)+              ((`mod` n) -> k2)+              (NonEmpty xs)+  =   n >= 2+  ==> [x1,x2] == quantiles s [k1,k2] n rndXs+  where+    rndXs = U.fromList xs+    x1 = quantile s k1 n rndXs+    x2 = quantile s k2 n rndXs++propQuantilesVec :: Positive Int -> Int -> Int -> NonEmptyList Double -> Property+propQuantilesVec (Positive n)+                 ((`mod` n) -> k1)+                 ((`mod` n) -> k2)+                 (NonEmpty xs)+  =   n >= 2+  ==> U.fromList [x1,x2] == quantilesVec s (U.fromList [k1,k2]) n rndXs+  where+    rndXs = U.fromList xs+    x1 = quantile s k1 n rndXs+    x2 = quantile s k2 n rndXs+++shouldError :: String -> a -> Assertion+shouldError nm x = do+  r <- try (evaluate x)+  case r of+    Left  (ErrorCall{}) -> return ()+    Right _             -> assertFailure ("Should call error: " ++ nm)
+ tests/Tests/Serialization.hs view
@@ -0,0 +1,96 @@+-- |+-- Tests for data serialization instances+module Tests.Serialization where++import Data.Binary (Binary,decode,encode)+import Data.Aeson  (FromJSON,ToJSON,Result(..),toJSON,fromJSON)+import Data.Typeable++import Statistics.Distribution.Beta           (BetaDistribution)+import Statistics.Distribution.Binomial       (BinomialDistribution)+import Statistics.Distribution.CauchyLorentz+import Statistics.Distribution.ChiSquared     (ChiSquared)+import Statistics.Distribution.Exponential    (ExponentialDistribution)+import Statistics.Distribution.FDistribution  (FDistribution)+import Statistics.Distribution.Gamma          (GammaDistribution)+import Statistics.Distribution.Geometric+import Statistics.Distribution.Hypergeometric+import Statistics.Distribution.Laplace        (LaplaceDistribution)+import Statistics.Distribution.Lognormal      (LognormalDistribution)+import Statistics.Distribution.NegativeBinomial (NegativeBinomialDistribution)+import Statistics.Distribution.Normal         (NormalDistribution)+import Statistics.Distribution.Poisson        (PoissonDistribution)+import Statistics.Distribution.StudentT+import Statistics.Distribution.Transform      (LinearTransform)+import Statistics.Distribution.Uniform        (UniformDistribution)+import Statistics.Distribution.Weibull        (WeibullDistribution)+import Statistics.Types++import Test.Tasty            (TestTree, testGroup)+import Test.Tasty.QuickCheck (testProperty)+import Test.QuickCheck         as QC++import Tests.Helpers+import Tests.Orphanage ()+++tests :: TestTree+tests = testGroup "Test for data serialization"+  [ serializationTests (T :: T (CL Float))+  , serializationTests (T :: T (CL Double))+  , serializationTests (T :: T (PValue Float))+  , serializationTests (T :: T (PValue Double))+  , serializationTests (T :: T (NormalErr Double))+  , serializationTests (T :: T (ConfInt   Double))+  , serializationTests' "T (Estimate NormalErr Double)" (T :: T (Estimate NormalErr Double))+  , serializationTests' "T (Estimate ConfInt Double)" (T :: T (Estimate ConfInt   Double))+  , serializationTests (T :: T (LowerLimit Double))+  , serializationTests (T :: T (UpperLimit Double))+    -- Distributions+  , serializationTests (T :: T BetaDistribution        )+  , serializationTests (T :: T CauchyDistribution      )+  , serializationTests (T :: T ChiSquared              )+  , serializationTests (T :: T ExponentialDistribution )+  , serializationTests (T :: T GammaDistribution       )+  , serializationTests (T :: T LaplaceDistribution     )+  , serializationTests (T :: T LognormalDistribution   )+  , serializationTests (T :: T NegativeBinomialDistribution         )+  , serializationTests (T :: T NormalDistribution      )+  , serializationTests (T :: T UniformDistribution     )+  , serializationTests (T :: T WeibullDistribution     )+  , serializationTests (T :: T StudentT                )+  , serializationTests (T :: T (LinearTransform NormalDistribution))+  , serializationTests (T :: T FDistribution           )+  , serializationTests (T :: T BinomialDistribution       )+  , serializationTests (T :: T GeometricDistribution      )+  , serializationTests (T :: T GeometricDistribution0     )+  , serializationTests (T :: T HypergeometricDistribution )+  , serializationTests (T :: T PoissonDistribution        )+  ]+++serializationTests+  :: (Eq a, Typeable a, Binary a, Show a, Read a, ToJSON a, FromJSON a, Arbitrary a)+  => T a -> TestTree+serializationTests t = serializationTests' (typeName t) t++-- Not all types are Typeable, unfortunately+serializationTests'+  :: (Eq a, Binary a, Show a, Read a, ToJSON a, FromJSON a, Arbitrary a)+  => String -> T a -> TestTree+serializationTests' name t = testGroup ("Tests for: " ++ name)+  [ testProperty "show/read" (p_showRead t)+  , testProperty "binary"    (p_binary   t)+  , testProperty "aeson"     (p_aeson    t)+  ]++++p_binary :: (Eq a, Binary a) => T a -> a -> Bool+p_binary _ a = a == (decode . encode) a++p_showRead :: (Eq a, Read a, Show a) => T a -> a -> Bool+p_showRead _ a = a == (read . show) a++p_aeson :: (Eq a, ToJSON a, FromJSON a) => T a -> a -> Bool+p_aeson _ a = Data.Aeson.Success a == (fromJSON . toJSON) a
+ tests/Tests/Transform.hs view
@@ -0,0 +1,148 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE ViewPatterns      #-}+module Tests.Transform+    (+      tests+    ) where++import Data.Bits ((.&.), shiftL)+import Data.Complex (Complex((:+)))+import Numeric.Sum (kbn, sumVector)+import Statistics.Function (within)+import Statistics.Transform (CD, dct, fft, idct, ifft)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.QuickCheck (testProperty)+import Test.QuickCheck ( Positive(..), Arbitrary(..), Blind(..), (==>), Gen+                       , choose, vectorOf, counterexample, forAll)+import Test.QuickCheck.Property (Property(..))+import Tests.Helpers (testAssertion)+import Text.Printf (printf)+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Unboxed as U+++tests :: TestTree+tests = testGroup "fft" [+          testProperty "t_impulse"        t_impulse+        , testProperty "t_impulse_offset" t_impulse_offset+        , testProperty "ifft . fft = id"  (t_fftInverse $ ifft . fft)+        , testProperty "fft . ifft = id"  (t_fftInverse $ fft . ifft)+        , testProperty "idct . dct = id [up to scale]"+            (t_fftInverse (\v -> U.map (/ (2 * fromIntegral (U.length v))) $ idct $ dct v))+        , testProperty "dct . idct = id [up to scale]"+            (t_fftInverse (\v -> U.map (/ (2 * fromIntegral (U.length v))) $ idct $ dct v))+          -- Exact small size DCT+          -- 1+        , testDCT [1] $ [2]+          -- 2+        , testDCT [1,0] $ map (*2) [1, cos (pi/4)   ]+        , testDCT [0,1] $ map (*2) [1, cos (3*pi/4) ]+          -- 4+        , testDCT [1,0,0,0] $ map (*2) [1, cos(  pi/8), cos( 2*pi/8), cos( 3*pi/8)]+        , testDCT [0,1,0,0] $ map (*2) [1, cos(3*pi/8), cos( 6*pi/8), cos( 9*pi/8)]+        , testDCT [0,0,1,0] $ map (*2) [1, cos(5*pi/8), cos(10*pi/8), cos(15*pi/8)]+        , testDCT [0,0,0,1] $ map (*2) [1, cos(7*pi/8), cos(14*pi/8), cos(21*pi/8)]+          -- Exact small size IDCT+          -- 1+        , testIDCT [1] [1]+          -- 2+        , testIDCT [1,0]            [1,         1          ]+        , testIDCT [0,1] $ map (*2) [cos(pi/4), cos(3*pi/4)]+          -- 4+        , testIDCT [1,0,0,0]            [1,            1,            1,            1            ]+        , testIDCT [0,1,0,0] $ map (*2) [cos(   pi/8), cos( 3*pi/8), cos( 5*pi/8), cos( 7*pi/8) ]+        , testIDCT [0,0,1,0] $ map (*2) [cos( 2*pi/8), cos( 6*pi/8), cos(10*pi/8), cos(14*pi/8) ]+        , testIDCT [0,0,0,1] $ map (*2) [cos( 3*pi/8), cos( 9*pi/8), cos(15*pi/8), cos(21*pi/8) ]+        ]++-- A single real-valued impulse at the beginning of an otherwise zero+-- vector should be replicated in every real component of the result,+-- and all the imaginary components should be zero.+t_impulse :: Double -> Positive Int -> Bool+t_impulse k (Positive m) = U.all (c_near i) (fft v)+  where v = i `G.cons` G.replicate (n-1) 0+        i = k :+ 0+        n = 1 `shiftL` (m .&. 6)++-- If a real-valued impulse is offset from the beginning of an+-- otherwise zero vector, the sum-of-squares of each component of the+-- result should equal the square of the impulse.+t_impulse_offset :: Double -> Positive Int -> Positive Int -> Property+t_impulse_offset k (Positive x) (Positive m)+  -- For numbers smaller than 1e-162 their square underflows and test+  -- fails spuriously+  = abs k >= 1e-100 ==> U.all ok (fft v)+  where v = G.concat [G.replicate xn 0, G.singleton i, G.replicate (n-xn-1) 0]+        ok (re :+ im) = within ulps (re*re + im*im) (k*k)+        i  = k :+ 0+        xn = x `rem` n+        n  = 1 `shiftL` (m .&. 6)++-- Test that (ifft . fft ≈ id)+--+-- Approximate equality here is tricky. Smaller values of vector tend+-- to have large relative error. Thus we should test that vectors as+-- whole are approximate equal.+t_fftInverse :: (HasNorm (U.Vector a), U.Unbox a, Num a, Show a, Arbitrary a)+             => (U.Vector a -> U.Vector a) -> Property+t_fftInverse roundtrip =+  forAll (Blind <$> genFftVector) $ \(Blind x) ->+    let n  = G.length x+        x' = roundtrip x+        d  = G.zipWith (-) x x'+        nd = vectorNorm d+        nx = vectorNorm x+    in counterexample "Original vector"+     $ counterexample (show x )+     $ counterexample "Transformed one"+     $ counterexample (show x')+     $ counterexample (printf "Length = %i" n)+     $ counterexample (printf "|x - x'| / |x| = %.6g" (nd / nx))+     $ nd <= 3e-14 * nx++-- Test discrete cosine transform+testDCT :: [Double] -> [Double] -> TestTree+testDCT (U.fromList -> vec) (U.fromList -> res)+  = testAssertion ("DCT test for " ++ show vec)+  $ vecEqual 3e-14 (dct vec) res++-- Test inverse discrete cosine transform+testIDCT :: [Double] -> [Double] -> TestTree+testIDCT (U.fromList -> vec) (U.fromList -> res)+  = testAssertion ("IDCT test for " ++ show vec)+  $ vecEqual 3e-14 (idct vec) res++++----------------------------------------------------------------++-- With an error tolerance of 8 ULPs, a million QuickCheck tests are+-- likely to all succeed. With a tolerance of 7, we fail around the+-- half million mark.+ulps :: Int+ulps = 8++c_near :: CD -> CD -> Bool+c_near (a :+ b) (c :+ d) = within ulps a c && within ulps b d++-- Arbitrary vector for FFT od DCT+genFftVector :: (U.Unbox a, Arbitrary a) => Gen (U.Vector a)+genFftVector = do+  n <- (2^)  <$> choose (1,9::Int)    -- Size of vector+  G.fromList <$> vectorOf n arbitrary -- Vector to transform++-- Ad-hoc type class for calculation of vector norm+class HasNorm a where+  vectorNorm :: a -> Double++instance HasNorm (U.Vector Double) where+  vectorNorm = sqrt . sumVector kbn . U.map (\x -> x*x)++instance HasNorm (U.Vector CD) where+  vectorNorm = sqrt . sumVector kbn . U.map (\(x :+ y) -> x*x + y*y)++-- Approximate equality for vectors+vecEqual :: Double -> U.Vector Double -> U.Vector Double -> Bool+vecEqual ε v u+  = vectorNorm (U.zipWith (-) v u) < ε * vectorNorm v
+ tests/doctest.hs view
@@ -0,0 +1,5 @@+import Test.DocTest (doctest)++main :: IO ()+main = doctest ["-XHaskell2010", "Statistics"]+
+ tests/tests.hs view
@@ -0,0 +1,26 @@+import Test.Tasty (defaultMain,testGroup)++import qualified Tests.Distribution+import qualified Tests.Function+import qualified Tests.KDE+import qualified Tests.Matrix+import qualified Tests.NonParametric+import qualified Tests.Parametric+import qualified Tests.Transform+import qualified Tests.Correlation+import qualified Tests.Serialization+import qualified Tests.Quantile++main :: IO ()+main = defaultMain $ testGroup "statistics"+  [ Tests.Distribution.tests+  , Tests.Function.tests+  , Tests.KDE.tests+  , Tests.Matrix.tests+  , Tests.NonParametric.tests+  , Tests.Parametric.tests+  , Tests.Transform.tests+  , Tests.Correlation.tests+  , Tests.Serialization.tests+  , Tests.Quantile.tests+  ]
+ tests/utils/Makefile view
@@ -0,0 +1,9 @@+C       = gcc+CFLAGS  = -W -Wall -O2 -std=c99+LDFLAGS = -lfftw3++.PHONY: all clean++all : fftw+clean :+	rm -rf fftw *.o
+ tests/utils/fftw.c view
@@ -0,0 +1,46 @@+/* Generate some test cases using fftw3  */+#include <stdlib.h>+#include <stdio.h>+#include <fftw3.h>++void dump_vector(int n, double* vec) {+    for(int i = 0; i < n; i++)+        printf("%20.15f ", vec[i]);+    printf("\n");+}++void dct(int flag, int n) {+    double* in  = malloc( n * sizeof(double));+    double* out = malloc( n * sizeof(double));+    //+    fftw_plan plan = fftw_plan_r2r_1d(n, in, out, flag, FFTW_ESTIMATE);+    for( int k = 0; k < n; k++) {+        // Init input vector+        for( int i = 0; i < n; i++)+            in[i] = 0;+        in[k] = 1;+        // Perform DFT+        fftw_execute(plan);+        // Print results+        dump_vector(n, in );+        dump_vector(n, out);+        printf("\n");+    }+    //+    free(in);+    free(out);+    fftw_destroy_plan(plan);+}++int main(void)+{+    printf("DCT II (the DCT)\n");+    dct( FFTW_REDFT10, 2);+    dct( FFTW_REDFT10, 4);+    +    printf("DCT III (Inverse DCT)\n");+    dct( FFTW_REDFT01, 2);+    dct( FFTW_REDFT01, 4);+    +    return 0;    +}