packages feed

statistics 0.10.5.2 → 0.16.5.0

raw patch · 88 files changed

Files

− ChangeLog 
@@ -1,139 +0,0 @@--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.--  * Accesors for uniform distribution are added.--  * ContGen instances for all continous distribtuions are added.--  * Beta distribution is added.--  * Constructor for improper gamma distribtuion is added.--  * Binomial distribution allows zero trials.--  * Poisson distribution now accept zero parameter.--  * Integer overflow in caculation 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.---Changed 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 probalities 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 overlow 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 probablity functions for Poisson and-    hypergeometric distributions.--  * Better density functions for gamma and Poisson distributions.--  * Student-T, Fisher-Snedecor F-distributions and Cauchy-Lorentz-    distrbution are added.--  * The function S.Function.create is removed. Use generateM from-    the vector package instead.--  * Function to perform approximate comparion of doubles is added to-    S.Function.Comparison--  * Regularized incomplete beta function and its inverse are added to-    S.Function
README.markdown view
@@ -18,18 +18,11 @@ # Get involved!  Please report bugs via the-[github issue tracker](https://github.com/bos/statistics/issues).--Master [git mirror](https://github.com/bos/statistics):--* `git clone git://github.com/bos/statistics.git`--There's also a [Mercurial mirror](https://bitbucket.org/bos/statistics):--* `hg clone https://bitbucket.org/bos/statistics`+[github issue tracker](https://github.com/haskell/statistics/issues). -(You can create and contribute changes using either Mercurial or git.)+Master [git mirror](https://github.com/haskell/statistics): +* `git clone git://github.com/haskell/statistics.git`  # Authors
− Setup.lhs 
@@ -1,3 +0,0 @@-#!/usr/bin/env runhaskell-> import Distribution.Simple-> main = defaultMain
Statistics/Autocorrelation.hs view
@@ -17,7 +17,10 @@     , autocorrelation     ) where +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@@ -25,7 +28,7 @@ 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 = G.sum (G.zipWith (*) (G.take (l-k) c) (G.slice k (l-k) c))+    f k = sum (G.zipWith (*) (G.take (l-k) c) (G.slice k (l-k) c))           / fromIntegral l     c   = G.map (subtract (mean a)) a     l   = G.length a@@ -44,4 +47,3 @@       where f v = 1.96 * sqrt ((v * 2 + 1) / l)     l           = fromIntegral (G.length a)     ci f        = G.cons 1 . G.tail . G.map (f (-1/l)) $ dllse-    square x    = x * x
+ 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,20 +0,0 @@--- |--- Module    : Statistics.Constants--- Copyright : (c) 2009, 2011 Bryan O'Sullivan--- License   : BSD3------ Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : portable------ Constant values common to much statistics code.------ DEPRECATED: use module 'Numeric.MathFunctions.Constants' from--- math-functions.--module Statistics.Constants-{-# DEPRECATED "use module Numeric.MathFunctions.Constants from math-functions" #-}-    ( module Numeric.MathFunctions.Constants-    ) where--import Numeric.MathFunctions.Constants
+ 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,7 +9,7 @@ -- Stability   : experimental -- Portability : portable ----- Types classes for probability distrubutions+-- Type classes for probability distributions  module Statistics.Distribution     (@@ -23,88 +24,90 @@     , Variance(..)     , MaybeEntropy(..)     , Entropy(..)+    , FromSample(..)       -- ** Random number generation     , ContGen(..)     , DiscreteGen(..)-    , genContinous+    , genContinuous       -- * Helper functions     , findRoot     , sumProbabilities     ) where -import Control.Applicative     ((<$>), Applicative(..))-import Control.Monad.Primitive (PrimMonad,PrimState)-+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 System.Random.MWC-+import qualified Data.Vector.Generic as G   -- | Type class common to all distributions. Only c.d.f. could be--- defined for both discrete and continous distributions.+-- defined for both discrete and continuous distributions. class Distribution d where     -- | Cumulative distribution function.  The probability that a     -- random variable /X/ is less or equal than /x/,-    -- i.e. P(/X/&#8804;/x/). Cumulative should be defined for+    -- i.e. P(/X/≤/x/). Cumulative should be defined for     -- infinities as well:     --     -- > cumulative d +∞ = 1     -- > cumulative d -∞ = 0     cumulative :: d -> Double -> Double--    -- | One's complement of cumulative distibution:+    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+    -- 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) #-} + -- | Discrete probability distribution. class Distribution  d => DiscreteDistr d where     -- | Probability of n-th outcome.     probability :: d -> Int -> Double     probability d = exp . logProbability d-    {-# INLINE probability #-}-     -- | Logarithm of probability of n-th outcome     logProbability :: d -> Int -> Double     logProbability d = log . probability d-    {-# INLINE logProbability #-}-+    {-# MINIMAL (probability | logProbability) #-} --- | Continuous probability distributuion.+-- | 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+/&#948;/x/) equal to /density(x)/&#8901;&#948;/x/+    -- [/x/,/x+/δ/x/) equal to /density(x)/⋅δ/x/     density :: d -> Double -> Double     density d = exp . logDensity d-    {-# INLINE density #-}--    -- | Inverse of the cumulative distribution function. The value-    -- /x/ for which P(/X/&#8804;/x/) = /p/. If probability is outside-    -- of [0,1] range function should call 'error'-    quantile :: d -> Double -> Double-     -- | Natural logarithm of density.     logDensity :: d -> Double -> Double     logDensity d = log . density d-    {-# INLINE logDensity #-}-+    -- | 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) #-}  -- | 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 distribution have+-- | 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@@ -119,21 +122,24 @@ --   Minimal complete definition is 'maybeVariance' or 'maybeStdDev' class MaybeMean d => MaybeVariance d where     maybeVariance :: d -> Maybe Double-    maybeVariance d = (*) <$> x <*> x where x = maybeStdDev d+    maybeVariance = fmap square . maybeStdDev     maybeStdDev   :: d -> Maybe Double-    maybeStdDev = fmap sqrt . maybeVariance+    maybeStdDev   = fmap sqrt . maybeVariance+    {-# MINIMAL (maybeVariance | maybeStdDev) #-} --- | Type class for distributions with variance. If distibution have+-- | 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 = x * x where x = stdDev d+    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@@ -141,7 +147,7 @@ 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@@ -154,21 +160,30 @@ -- | Generate discrete random variates which have given --   distribution. class Distribution d => ContGen d where-  genContVar :: PrimMonad m => d -> Gen (PrimState m) -> m Double+  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 :: PrimMonad m => d -> Gen (PrimState m) -> m Int+  genDiscreteVar :: (StatefulGen g m) => d -> g -> m Int --- | Generate variates from continous distribution using inverse+-- | 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.-genContinous :: (ContDistr d, PrimMonad m) => d -> Gen (PrimState m) -> m Double-genContinous d gen = do-  x <- uniform gen+genContinuous :: (ContDistr d, StatefulGen g m) => d -> g -> m Double+genContinuous d gen = do+  x <- uniformDouble01M gen   return $! quantile d x-{-# INLINE genContinous #-}  data P = P {-# UNPACK #-} !Double {-# UNPACK #-} !Double @@ -178,7 +193,7 @@ -- 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 :: ContDistr d => +findRoot :: ContDistr d =>             d                   -- ^ Distribution          -> Double              -- ^ Probability /p/          -> Double              -- ^ Initial guess@@ -207,7 +222,6 @@ -- | 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 againist roundoff errors. +  -- 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 . U.sum . U.map (probability d) $ U.enumFromTo low hi-{-# INLINE sumProbabilities #-}+  min 1 . sum . U.map (probability d) $ U.enumFromTo low hi
Statistics/Distribution/Beta.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} ----------------------------------------------------------------------------- -- |@@ -14,94 +15,153 @@   ( BetaDistribution     -- * Constructor   , betaDistr+  , betaDistrE   , improperBetaDistr+  , improperBetaDistrE     -- * Accessors   , bdAlpha   , bdBeta   ) where -import Data.Binary (Binary)-import Data.Data (Data, Typeable)-import GHC.Generics (Generic)+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)-import Numeric.MathFunctions.Constants (m_NaN)+  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, Read, Show, Typeable, Data, Generic)+ } deriving (Eq, Typeable, Data, Generic) -instance Binary BetaDistribution+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-  | a > 0 && b > 0 = improperBetaDistr a b-  | otherwise      =-      error $  "Statistics.Distribution.Beta.betaDistr: "-            ++ "shape parameters must be positive. Got a = "-            ++ show a-            ++ " b = "-            ++ show b-{-# INLINE betaDistr #-}+betaDistr a b = maybe (error $ errMsg a b) id $ betaDistrE a b --- | Create beta distribution. This construtor doesn't check parameters.+-- | 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 = BD-{-# INLINE improperBetaDistr #-}+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-  {-# INLINE cumulative #-}+  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)-  {-# INLINE mean #-}  instance D.MaybeMean BetaDistribution where   maybeMean = Just . D.mean-  {-# INLINE maybeMean #-}  instance D.Variance BetaDistribution where   variance (BD a b) = a*b / (apb*apb*(apb+1))     where apb = a + b-  {-# INLINE variance #-}  instance D.MaybeVariance BetaDistribution where   maybeVariance = Just . D.variance-  {-# INLINE maybeVariance #-}  instance D.Entropy BetaDistribution where   entropy (BD a b) =-    logBeta a b +    logBeta a b     - (a-1) * digamma a     - (b-1) * digamma b     + (a+b-2) * digamma (a+b)-  {-# INLINE entropy #-}-    + instance D.MaybeEntropy BetaDistribution where   maybeEntropy = Just . D.entropy-  {-# INLINE maybeEntropy #-}  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)*log (1-x) - logBeta a b-  {-# INLINE density #-}+    | 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@@ -109,7 +169,6 @@     | p > 0 && p < 1 = invIncompleteBeta a b p     | otherwise      =         error $ "Statistics.Distribution.Gamma.quantile: p must be in [0,1] range. Got: "++show p-  {-# INLINE quantile #-}  instance D.ContGen BetaDistribution where-  genContVar = D.genContinous+  genContVar = D.genContinuous
Statistics/Distribution/Binomial.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternGuards     #-} {-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} -- | -- Module    : Statistics.Distribution.Binomial@@ -18,18 +20,23 @@       BinomialDistribution     -- * Constructors     , binomial+    , binomialE     -- * Accessors     , bdTrials     , bdProbability     ) where -import Data.Binary (Binary)-import Data.Data (Data, Typeable)-import GHC.Generics (Generic)+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 qualified Statistics.Distribution.Poisson.Internal as I-import Numeric.SpecFunctions (choose,incompleteBeta)-import Numeric.MathFunctions.Constants (m_epsilon)+import Statistics.Internal   -- | The binomial distribution.@@ -38,15 +45,37 @@     -- ^ Number of trials.     , bdProbability :: {-# UNPACK #-} !Double     -- ^ Probability.-    } deriving (Eq, Read, Show, Typeable, Data, Generic)+    } deriving (Eq, Typeable, Data, Generic) -instance Binary BinomialDistribution+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     cumulative = cumulative+    complCumulative = complCumulative  instance D.DiscreteDistr BinomialDistribution where-    probability = probability+    probability    = probability+    logProbability = logProbability  instance D.Mean BinomialDistribution where     mean = mean@@ -75,10 +104,30 @@ probability (BD n p) k   | k < 0 || k > n = 0   | n == 0         = 1-  | otherwise      = choose n k * p^k * (1-p)^(n-k)-{-# INLINE probability #-}+    -- 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 --- Summation from different sides required to reduce roundoff errors+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"@@ -88,18 +137,25 @@   | otherwise    = incompleteBeta (fromIntegral (n-k)) (fromIntegral (k+1)) (1 - p)   where     k = floor x-{-# INLINE cumulative #-} +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 _) =   +directEntropy d@(BD n _) =   negate . sum $   takeWhile (< negate m_epsilon) $   dropWhile (not . (< negate m_epsilon)) $@@ -110,11 +166,19 @@ binomial :: Int                 -- ^ Number of trials.          -> Double              -- ^ Probability.          -> BinomialDistribution-binomial n p-  | n < 0          =-    error $ msg ++ "number of trials must be non-negative. Got " ++ show n-  | p < 0 || p > 1 =-    error $ msg++"probability must be in [0,1] range. Got " ++ show p-  | otherwise      = BD n p-    where msg = "Statistics.Distribution.Binomial.binomial: "-{-# INLINE binomial #-}+binomial n p = maybe (error $ errMsg n p) id $ binomialE n p++-- | 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
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} -- | -- Module    : Statistics.Distribution.CauchyLorentz@@ -18,13 +19,18 @@   , cauchyDistribScale     -- * Constructors   , cauchyDistribution+  , cauchyDistributionE   , standardCauchy   ) where -import Data.Binary (Binary)-import Data.Data (Data, Typeable)-import GHC.Generics (Generic)+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 {@@ -37,41 +43,100 @@     --   maximum (HWHM).   , cauchyDistribScale  :: {-# UNPACK #-} !Double   }-  deriving (Eq, Show, Read, Typeable, Data, Generic)+  deriving (Eq, Typeable, Data, Generic) -instance Binary CauchyDistribution+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-  | s > 0     = CD m s-  | otherwise =-    error $ "Statistics.Distribution.CauchyLorentz.cauchyDistribution: FWHM must be positive. Got " ++ show 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 = 0.5 + atan( (x - m) / s ) / pi+  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 && p < 1 = m + s * tan( pi * (p - 0.5) )-    | p == 0         = -1 / 0-    | p == 1         =  1 / 0-    | otherwise      =-      error $ "Statistics.Distribution.CauchyLorentz..quantile: p must be in [0,1] range. Got: "++show 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.genContinous+  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
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} -- | -- Module    : Statistics.Distribution.ChiSquared@@ -13,55 +14,93 @@ -- distributions. It's commonly used in statistical tests module Statistics.Distribution.ChiSquared (           ChiSquared-        -- Constructors-        , chiSquared         , chiSquaredNDF+        -- * Constructors+        , chiSquared+        , chiSquaredE         ) where -import Data.Binary (Binary)-import Data.Data (Data, Typeable)-import GHC.Generics (Generic)-import Numeric.SpecFunctions (-  incompleteGamma,invIncompleteGamma,logGamma,digamma)+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 qualified System.Random.MWC.Distributions as MWC+import Statistics.Internal  + -- | Chi-squared distribution-newtype ChiSquared = ChiSquared Int-                     deriving (Eq, Read, Show, Typeable, Data, Generic)+newtype ChiSquared = ChiSquared+  { chiSquaredNDF :: Int+    -- ^ Get number of degrees of freedom+  }+  deriving (Eq, Typeable, Data, Generic) -instance Binary ChiSquared+instance Show ChiSquared where+  showsPrec i (ChiSquared n) = defaultShow1 "chiSquared" n i+instance Read ChiSquared where+  readPrec = defaultReadPrecM1 "chiSquared" chiSquaredE --- | Get number of degrees of freedom-chiSquaredNDF :: ChiSquared -> Int-chiSquaredNDF (ChiSquared ndf) = ndf-{-# INLINE chiSquaredNDF #-}+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-  | n <= 0    = error $-     "Statistics.Distribution.ChiSquared.chiSquared: N.D.F. must be positive. Got " ++ show n-  | otherwise = ChiSquared n-{-# INLINE 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  = density+  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-    {-# INLINE mean #-}  instance D.Variance ChiSquared where     variance (ChiSquared ndf) = fromIntegral (2*ndf)-    {-# INLINE variance #-}  instance D.MaybeMean ChiSquared where     maybeMean = Just . D.mean@@ -69,12 +108,12 @@ 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 +    kHalf+    + log 2     + logGamma kHalf     + (1-kHalf) * digamma kHalf @@ -91,18 +130,7 @@   | otherwise = incompleteGamma (ndf/2) (x/2)   where     ndf = fromIntegral $ chiSquaredNDF chi-{-# INLINE cumulative #-} -density :: ChiSquared -> Double -> Double-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-{-# INLINE density #-}- quantile :: ChiSquared -> Double -> Double quantile (ChiSquared ndf) p   | p == 0         = 0@@ -110,4 +138,3 @@   | 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-{-# INLINE quantile #-}
+ 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,3 +1,5 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} -- | -- Module    : Statistics.Distribution.Exponential@@ -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. @@ -18,27 +20,48 @@       ExponentialDistribution     -- * Constructors     , exponential-    , exponentialFromSample+    , exponentialE     -- * Accessors     , edLambda     ) where -import Data.Binary (Binary)-import Data.Data (Data, Typeable)-import GHC.Generics (Generic)+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 qualified System.Random.MWC.Distributions as MWC-import Statistics.Types (Sample)+import Statistics.Internal  + newtype ExponentialDistribution = ED {       edLambda :: Double-    } deriving (Eq, Read, Show, Typeable, Data, Generic)+    } deriving (Eq, Typeable, Data, Generic) -instance Binary ExponentialDistribution+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     cumulative      = cumulative     complCumulative = complCumulative@@ -50,15 +73,14 @@     logDensity (ED l) x       | x < 0     = m_neg_inf       | otherwise = log l + (-l * x)-    quantile = quantile+    quantile      = quantile+    complQuantile = complQuantile  instance D.Mean ExponentialDistribution where     mean (ED l) = 1 / l-    {-# INLINE mean #-}  instance D.Variance ExponentialDistribution where     variance (ED l) = 1 / (l * l)-    {-# INLINE variance #-}  instance D.MaybeMean ExponentialDistribution where     maybeMean = Just . D.mean@@ -78,34 +100,44 @@  cumulative :: ExponentialDistribution -> Double -> Double cumulative (ED l) x | x <= 0    = 0-                    | otherwise = 1 - exp (-l * x)-{-# INLINE cumulative #-}+                    | otherwise = - expm1 (-l * x)  complCumulative :: ExponentialDistribution -> Double -> Double complCumulative (ED l) x | x <= 0    = 1                          | otherwise = exp (-l * x)-{-# INLINE complCumulative #-}   quantile :: ExponentialDistribution -> Double -> Double quantile (ED l) p-  | p == 1          = 1 / 0-  | p >= 0 && p < 1 = -log (1 - p) / l+  | 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-{-# INLINE quantile #-}  -- | Create an exponential distribution.-exponential :: Double            -- ^ &#955; (scale) parameter.+exponential :: Double            -- ^ Rate parameter.             -> ExponentialDistribution-exponential l-  | l <= 0 =-    error $ "Statistics.Distribution.Exponential.exponential: scale parameter must be positive. Got " ++ show l-  | otherwise = ED l-{-# INLINE exponential #-}+exponential l = maybe (error $ errMsg l) id $ exponentialE l --- | Create exponential distribution from sample. No tests are made to--- check whether it truly is exponential.-exponentialFromSample :: Sample -> ExponentialDistribution-exponentialFromSample = ED . S.mean-{-# INLINE exponentialFromSample #-}+-- | 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
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} -- | -- Module    : Statistics.Distribution.FDistribution@@ -11,19 +12,28 @@ -- Fisher F distribution module Statistics.Distribution.FDistribution (     FDistribution+    -- * Constructors   , fDistribution+  , fDistributionE+  , fDistributionReal+  , fDistributionRealE+    -- * Accessors   , fDistributionNDF1   , fDistributionNDF2   ) where -import Data.Binary (Binary)-import Data.Data (Data, Typeable)-import Numeric.MathFunctions.Constants (m_neg_inf)-import GHC.Generics (Generic)-import qualified Statistics.Distribution as D+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@@ -31,22 +41,61 @@                        , fDistributionNDF2 :: {-# UNPACK #-} !Double                        , _pdfFactor        :: {-# UNPACK #-} !Double                        }-                   deriving (Eq, Show, Read, Typeable, Data, Generic)+                   deriving (Eq, Typeable, Data, Generic) -instance Binary FDistribution+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+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 F n' m' f'-  | otherwise =-    error "Statistics.Distribution.FDistribution.fDistribution: non-positive number of degrees of freedom"+    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+  cumulative      = cumulative+  complCumulative = complCumulative  instance D.ContDistr FDistribution where   density d x@@ -60,9 +109,37 @@ cumulative :: FDistribution -> Double -> Double cumulative (F n m _) x   | x <= 0       = 0-  | isInfinite x = 1            -- Only matches +∞-  | otherwise    = let y = n*x in incompleteBeta (0.5 * n) (0.5 * m) (y / (m + y))+  -- 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)@@ -82,16 +159,16 @@  instance D.MaybeVariance FDistribution where   maybeStdDev (F n m _)-    | m > 4     = Just $ 2 * sqr m * (m + n - 2) / (n * sqr (m - 2) * (m - 4))+    | 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) +    log (n/m)     + logBeta nHalf mHalf-    + (1 - nHalf) * digamma nHalf +    + (1 - nHalf) * digamma nHalf     - (1 + mHalf) * digamma mHalf     + (nHalf + mHalf) * digamma (nHalf + mHalf) @@ -99,8 +176,4 @@   maybeEntropy = Just . D.entropy  instance D.ContGen FDistribution where-  genContVar = D.genContinous--sqr :: Double -> Double-sqr x = x * x-{-# INLINE sqr #-}+  genContVar = D.genContinuous
Statistics/Distribution/Gamma.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} -- | -- Module    : Statistics.Distribution.Gamma@@ -19,50 +20,106 @@       GammaDistribution     -- * Constructors     , gammaDistr+    , gammaDistrE     , improperGammaDistr+    , improperGammaDistrE     -- * Accessors     , gdShape     , gdScale     ) where -import Data.Binary (Binary)-import Data.Data (Data, Typeable)-import GHC.Generics (Generic)+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 Statistics.Distribution.Poisson.Internal  as Poisson-import qualified Statistics.Distribution         as D+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, Data, Generic)+    } deriving (Eq, Typeable, Data, Generic) -instance Binary GammaDistribution+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-  | k     <= 0 = error $ msg ++ "shape must be positive. Got " ++ show k-  | theta <= 0 = error $ msg ++ "scale must be positive. Got " ++ show theta-  | otherwise  = improperGammaDistr k theta-    where msg = "Statistics.Distribution.Gamma.gammaDistr: "-{-# INLINE gammaDistr #-}+  = maybe (error $ errMsg k theta) id $ gammaDistrE k theta --- | Create gamma distribution. This constructor do not check whether---   parameters are valid+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 = GD-{-# INLINE improperGammaDistr #-}+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     cumulative = cumulative @@ -70,16 +127,18 @@     density    = density     logDensity (GD k theta) x       | x <= 0    = m_neg_inf-      | otherwise = log x * (k - 1) - (x / theta) - logGamma k - log theta * k+      | 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 #-}  instance D.Mean GammaDistribution where     mean (GD a l) = a * l-    {-# INLINE mean #-}  instance D.MaybeMean GammaDistribution where     maybeMean = Just . D.mean@@ -90,11 +149,11 @@  instance D.MaybeEntropy GammaDistribution where   maybeEntropy (GD a l)-    | a > 0 && l > 0 = +    | a > 0 && l > 0 =       Just $-      a -      + log l -      + logGamma a +      a+      + log l+      + logGamma a       + (1-a) * digamma a     | otherwise = Nothing @@ -110,13 +169,11 @@   | 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-{-# INLINE density #-}  cumulative :: GammaDistribution -> Double -> Double cumulative (GD k l) x   | x <= 0    = 0   | otherwise = incompleteGamma k (x/l)-{-# INLINE cumulative #-}  quantile :: GammaDistribution -> Double -> Double quantile (GD k l) p@@ -125,4 +182,3 @@   | p > 0 && p < 1 = l * invIncompleteGamma k p   | otherwise      =     error $ "Statistics.Distribution.Gamma.quantile: p must be in [0,1] range. Got: "++show p-{-# INLINE quantile #-}
Statistics/Distribution/Geometric.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} -- | -- Module    : Statistics.Distribution.Geometric@@ -24,48 +25,74 @@     , GeometricDistribution0     -- * Constructors     , geometric+    , geometricE     , geometric0+    , geometric0E     -- ** Accessors     , gdSuccess     , gdSuccess0     ) where -import Control.Monad  (liftM)-import Data.Binary    (Binary)-import Data.Data      (Data, Typeable)-import GHC.Generics   (Generic)-import Numeric.MathFunctions.Constants(m_pos_inf,m_neg_inf)-import qualified Statistics.Distribution         as D+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..] +-- | Distribution over [1..] newtype GeometricDistribution = GD {       gdSuccess :: Double-    } deriving (Eq, Read, Show, Typeable, Data, Generic)+    } deriving (Eq, Typeable, Data, Generic) -instance Binary GeometricDistribution+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-    cumulative = cumulative+    cumulative      = cumulative+    complCumulative = complCumulative  instance D.DiscreteDistr GeometricDistribution where     probability (GD s) n       | n < 1     = 0-      | otherwise = s * (1-s) ** (fromIntegral n - 1)+      | 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 + log (1-s) * (fromIntegral n - 1)+       | otherwise = log s + log1p (-s) * (fromIntegral n - 1)   instance D.Mean GeometricDistribution where     mean (GD s) = 1 / s-    {-# INLINE mean #-}  instance D.Variance GeometricDistribution where     variance (GD s) = (1 - s) / (s * s)-    {-# INLINE variance #-}  instance D.MaybeMean GeometricDistribution where     maybeMean = Just . D.mean@@ -76,49 +103,82 @@  instance D.Entropy GeometricDistribution where   entropy (GD s)-    | s == 0 = m_pos_inf     | s == 1 = 0-    | otherwise = negate $ (s * log s + (1-s) * log (1-s)) / s+    | 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-  {-# INLINE genDiscreteVar #-}+ instance D.ContGen GeometricDistribution where   genContVar d g = fromIntegral `liftM` D.genDiscreteVar d g-  {-# INLINE genContVar #-} --- | Create geometric distribution.-geometric :: Double                -- ^ Success rate-          -> GeometricDistribution-geometric x-  | x >= 0 && x <= 1 = GD x-  | otherwise        =-    error $ "Statistics.Distribution.Geometric.geometric: probability must be in [0,1] range. Got " ++ show x-{-# INLINE geometric #-}- cumulative :: GeometricDistribution -> Double -> Double cumulative (GD s) x   | x < 1        = 0   | isInfinite x = 1   | isNaN      x = error "Statistics.Distribution.Geometric.cumulative: NaN input"-  | otherwise    = 1 - (1-s) ^ (floor x :: Int)-{-# INLINE cumulative #-}+  | s >= 0.5     = 1 - (1 - s)^k+  | otherwise    = negate $ expm1 $ fromIntegral k * log1p (-s)+    where k = floor x :: Int +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..] +-- | Distribution over [0..] newtype GeometricDistribution0 = GD0 {       gdSuccess0 :: Double-    } deriving (Eq, Read, Show, Typeable, Data, Generic)+    } deriving (Eq, Typeable, Data, Generic) -instance Binary GeometricDistribution0+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)+    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)@@ -126,11 +186,9 @@  instance D.Mean GeometricDistribution0 where     mean (GD0 s) = 1 / s - 1-    {-# INLINE mean #-}  instance D.Variance GeometricDistribution0 where     variance (GD0 s) = D.variance (GD s)-    {-# INLINE variance #-}  instance D.MaybeMean GeometricDistribution0 where     maybeMean = Just . D.mean@@ -147,16 +205,22 @@  instance D.DiscreteGen GeometricDistribution0 where   genDiscreteVar (GD0 s) g = MWC.geometric0 s g-  {-# INLINE genDiscreteVar #-}+ instance D.ContGen GeometricDistribution0 where   genContVar d g = fromIntegral `liftM` D.genDiscreteVar d g-  {-# INLINE genContVar #-} + -- | Create geometric distribution. geometric0 :: Double                -- ^ Success rate            -> GeometricDistribution0-geometric0 x-  | x >= 0 && x <= 1 = GD0 x-  | otherwise        =-    error $ "Statistics.Distribution.Geometric.geometric: probability must be in [0,1] range. Got " ++ show x-{-# INLINE geometric0 #-}+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,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} -- | -- Module    : Statistics.Distribution.Hypergeometric@@ -21,32 +22,60 @@       HypergeometricDistribution     -- * Constructors     , hypergeometric+    , hypergeometricE     -- ** Accessors     , hdM     , hdL     , hdK     ) where -import Data.Binary (Binary)-import Data.Data (Data, Typeable)-import GHC.Generics (Generic)-import Numeric.MathFunctions.Constants (m_epsilon)-import Numeric.SpecFunctions (choose)+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, Data, Generic)+    } deriving (Eq, Typeable, Data, Generic) -instance Binary HypergeometricDistribution+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     cumulative = cumulative+    complCumulative = complCumulative  instance D.DiscreteDistr HypergeometricDistribution where-    probability = probability+    probability    = probability+    logProbability = logProbability  instance D.Mean HypergeometricDistribution where     mean = mean@@ -63,7 +92,7 @@  instance D.Entropy HypergeometricDistribution where   entropy = directEntropy-  + instance D.MaybeEntropy HypergeometricDistribution where   maybeEntropy = Just . D.entropy @@ -73,18 +102,16 @@         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 #-}  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]]+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]]   hypergeometric :: Int               -- ^ /m/@@ -92,22 +119,45 @@                -> Int               -- ^ /k/                -> HypergeometricDistribution hypergeometric m l k-  | not (l > 0)            = error $ msg ++ "l must be positive"-  | not (m >= 0 && m <= l) = error $ msg ++ "m must lie in [0,l] range"-  | not (k > 0 && k <= l)  = error $ msg ++ "k must lie in (0,l] range"-  | otherwise = HD m l k-    where-      msg = "Statistics.Distribution.Hypergeometric.hypergeometric: "-{-# INLINE hypergeometric #-}+  = 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-  | otherwise =-      choose mi n * choose (li - mi) (ki - n) / choose li ki-{-# INLINE probability #-}+    -- 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 mi li ki) x   | isNaN x      = error "Statistics.Distribution.Hypergeometric.cumulative: NaN argument"@@ -115,6 +165,18 @@   | n <  minN    = 0   | n >= maxN    = 1   | otherwise    = D.sumProbabilities d minN n+  where+    n    = floor x+    minN = max 0 (mi+ki-li)+    maxN = min mi ki++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)
+ 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 BangPatterns, DeriveDataTypeable, DeriveGeneric #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} -- | -- Module    : Statistics.Distribution.Normal -- Copyright : (c) 2009 Bryan O'Sullivan@@ -16,19 +18,24 @@       NormalDistribution     -- * Constructors     , normalDistr-    , normalFromSample+    , normalDistrE+    , normalDistrErr     , standard     ) where -import Data.Binary (Binary)-import Data.Data (Data, Typeable)-import GHC.Generics (Generic)+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 Statistics.Distribution as D-import qualified Statistics.Sample       as S+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.@@ -37,17 +44,36 @@     , stdDev     :: {-# UNPACK #-} !Double     , ndPdfDenom :: {-# UNPACK #-} !Double     , ndCdfDenom :: {-# UNPACK #-} !Double-    } deriving (Eq, Read, Show, Typeable, Data, Generic)+    } deriving (Eq, Typeable, Data, Generic) -instance Binary NormalDistribution+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     cumulative      = cumulative     complCumulative = complCumulative  instance D.ContDistr NormalDistribution where-    logDensity = logDensity-    quantile   = quantile+    logDensity    = logDensity+    quantile      = quantile+    complQuantile = complQuantile  instance D.MaybeMean NormalDistribution where     maybeMean = Just . D.mean@@ -70,7 +96,6 @@  instance D.ContGen NormalDistribution where     genContVar d = MWC.normal (mean d) (stdDev d)-    {-# INLINE genContVar #-}  -- | Standard normal distribution with mean equal to 0 and variance equal to 1 standard :: NormalDistribution@@ -87,23 +112,45 @@ normalDistr :: Double            -- ^ Mean of distribution             -> Double            -- ^ Standard deviation of distribution             -> NormalDistribution-normalDistr m sd-  | sd > 0    = ND { mean       = m-                   , stdDev     = sd-                   , ndPdfDenom = log $ m_sqrt_2_pi * sd-                   , ndCdfDenom = m_sqrt_2 * sd-                   }-  | otherwise =-    error $ "Statistics.Distribution.Normal.normalDistr: standard deviation must be positive. Got " ++ show sd+normalDistr m sd = either error id $ normalDistrErr m sd --- | Create distribution using parameters estimated from---   sample. Variance is estimated using maximum likelihood method+-- | 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++-- | 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).-normalFromSample :: S.Sample -> NormalDistribution-normalFromSample xs-  = normalDistr m (sqrt v)-  where-    (m,v) = S.meanVariance xs+--+--   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@@ -124,5 +171,16 @@   | 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 * (1 - 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,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} -- | -- Module    : Statistics.Distribution.Poisson@@ -18,49 +19,70 @@       PoissonDistribution     -- * Constructors     , poisson+    , poissonE     -- * Accessors     , poissonLambda     -- * References     -- $references     ) where -import Data.Binary (Binary)-import Data.Data (Data, Typeable)-import GHC.Generics (Generic)-import qualified Statistics.Distribution as D-import qualified Statistics.Distribution.Poisson.Internal as I+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 qualified Statistics.Distribution.Poisson.Internal as I+import Statistics.Internal++ newtype PoissonDistribution = PD {       poissonLambda :: Double-    } deriving (Eq, Read, Show, Typeable, Data, Generic)+    } deriving (Eq, Typeable, Data, Generic) -instance Binary PoissonDistribution+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     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-    {-# INLINE cumulative #-}  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-    {-# INLINE probability #-}  instance D.Variance PoissonDistribution where     variance = poissonLambda-    {-# INLINE variance #-}  instance D.Mean PoissonDistribution where     mean = poissonLambda-    {-# INLINE mean #-}  instance D.MaybeMean PoissonDistribution where     maybeMean = Just . D.mean@@ -74,13 +96,28 @@ 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-  | l >=  0   = PD l-  | otherwise = error $ "Statistics.Distribution.Poisson.poisson:\-                        \ lambda must be non-negative. Got " ++ show l-{-# INLINE poisson #-}+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 --
Statistics/Distribution/Poisson/Internal.hs view
@@ -14,10 +14,10 @@       probability, poissonEntropy     ) where -import Data.List(unfoldr)+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)+import Numeric.SpecFunctions (logGamma, stirlingError {-, choose, logFactorial -})+import Numeric.SpecFunctions.Extra (bd0)  -- | An unchecked, non-integer-valued version of Loader's saddle point -- algorithm.@@ -31,26 +31,25 @@   | 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)-{-# INLINE probability #-} --- | Compute entropy using Theorem 1 from "Sharp Bounds on the Entropy--- of the Poisson Law".  This function is unused because 'directEntorpy'--- 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..] ]+-- -- | 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-                         +-- 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@@ -62,13 +61,13 @@   1.4189385332046727 + 0.5 * log lambda +   zipCoefficients lambda coefficients --- | Returns the average of the upper and lower bounds accounding to+-- | 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 :: Double -> [Double] -> Double zipCoefficients lambda coefficients =   (sum $ map (uncurry (*)) (zip (powers $ recip lambda) coefficients)) @@ -76,12 +75,12 @@ -- -- poissonMoment[0, s_] := 1 -- poissonMoment[1, s_] := 0--- poissonMoment[k_, s_] := +-- poissonMoment[k_, s_] := --   Sum[s * Binomial[k - 1, j] * poissonMoment[j, s], {j, 0, k - 2}] -- -- upperSeries[m_]  := --  Distribute[Integrate[---    Sum[(-1)^(j - 1) * +--    Sum[(-1)^(j - 1) * --      poissonMoment[j, \[Lambda]] / (j * (j - 1)* \[Lambda]^j), --     {j, 3, 2 m - 1}], --    \[Lambda]]]@@ -89,10 +88,10 @@ -- lowerSeries[m_] := --  Distribute[Integrate[ --    poissonMoment[---      2 m + 2, \[Lambda]] / ((2 m + +--      2 m + 2, \[Lambda]] / ((2 m + --         1)*\[Lambda]^(2 m + 2)), \[Lambda]]] ----- upperBound[m_] := upperSeries[m] + (Log[2*Pi*\[Lambda]] + 1)/2 +-- upperBound[m_] := upperSeries[m] + (Log[2*Pi*\[Lambda]] + 1)/2 -- -- lowerBound[m_] := upperBound[m] + lowerSeries[m] @@ -120,7 +119,7 @@ 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,@@ -128,13 +127,13 @@                        -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,@@ -153,19 +152,19 @@                        -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 =   +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+-- | Compute the entropy of a Poisson distribution using the best available -- method. poissonEntropy :: Double -> Double poissonEntropy lambda
Statistics/Distribution/StudentT.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} -- | -- Module    : Statistics.Distribution.StudentT@@ -11,33 +12,66 @@ -- Student-T distribution module Statistics.Distribution.StudentT (     StudentT+    -- * Constructors   , studentT-  , studentTndf+  , studentTE   , studentTUnstandardized+    -- * Accessors+  , studentTndf   ) where -import Data.Binary (Binary)-import Data.Data (Data, Typeable)-import GHC.Generics (Generic)+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 Numeric.SpecFunctions (-  logBeta, incompleteBeta, invIncompleteBeta, digamma)+import Statistics.Internal + -- | Student-T distribution newtype StudentT = StudentT { studentTndf :: Double }-                   deriving (Eq, Show, Read, Typeable, Data, Generic)+                   deriving (Eq, Typeable, Data, Generic) -instance Binary StudentT+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-  | ndf > 0   = StudentT ndf-  | otherwise = modErr "studentT" "non-positive number of degrees of freedom"+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+  cumulative      = cumulative+  complCumulative = complCumulative  instance D.ContDistr StudentT where   density    d@(StudentT ndf) x = exp (logDensityUnscaled d x) / sqrt ndf@@ -51,9 +85,18 @@   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 =-    log (ndf / (ndf + x*x)) * (0.5 * (1 + ndf)) - logBeta 0.5 (0.5 * ndf)+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@@ -76,14 +119,14 @@ instance D.Entropy StudentT where   entropy (StudentT ndf) =     0.5 * (ndf+1) * (digamma ((1+ndf)/2) - digamma(ndf/2))-    + log (sqrt ndf) +    + log (sqrt ndf)     + logBeta (ndf/2) 0.5  instance D.MaybeEntropy StudentT where   maybeEntropy = Just . D.entropy  instance D.ContGen StudentT where-  genContVar = D.genContinous+  genContVar = D.genContinuous  -- | Create an unstandardized Student-t distribution. studentTUnstandardized :: Double -- ^ Number of degrees of freedom
Statistics/Distribution/Transform.hs view
@@ -10,16 +10,18 @@ -- Portability : portable -- -- Transformations over distributions-module Statistics.Distribution.Transform (-    LinearTransform (..)-  , linTransFixedPoint-  , scaleAround-  ) where+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 Data.Functor          ((<$>)) import qualified Statistics.Distribution as D  -- | Linear transformation applied to distribution.@@ -35,8 +37,13 @@     -- ^ Distribution being transformed.   } deriving (Eq, Show, Read, Typeable, Data, Generic) -instance (Binary d) => Binary (LinearTransform d)+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@@ -57,7 +64,8 @@ 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+  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@@ -73,12 +81,10 @@   variance (LinearTransform _ sc dist) = sc * sc * D.variance dist   stdDev   (LinearTransform _ sc dist) = sc * D.stdDev dist -instance (D.MaybeEntropy d, D.DiscreteDistr d) -         => D.MaybeEntropy (LinearTransform d) where+instance (D.MaybeEntropy d) => D.MaybeEntropy (LinearTransform d) where   maybeEntropy (LinearTransform _ _ dist) = D.maybeEntropy dist -instance (D.Entropy d, D.DiscreteDistr d) -         => D.Entropy (LinearTransform d) where+instance (D.Entropy d) => D.Entropy (LinearTransform d) where   entropy (LinearTransform _ _ dist) = D.entropy dist  instance D.ContGen d => D.ContGen (LinearTransform d) where
Statistics/Distribution/Uniform.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} -- | -- Module    : Statistics.Distribution.Uniform@@ -14,34 +15,66 @@       UniformDistribution     -- * Constructors     , uniformDistr+    , uniformDistrE     -- ** Accessors     , uniformA     , uniformB     ) where -import Data.Binary (Binary)-import Data.Data (Data, Typeable)-import GHC.Generics (Generic)+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 qualified System.Random.MWC       as MWC+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, Read, Show, Typeable, Data, Generic)+    } deriving (Eq, Typeable, Data, Generic) -instance Binary UniformDistribution+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-  | b < a     = uniformDistr b a-  | a < b     = UniformDistribution a b-  | otherwise = error "Statistics.Distribution.Uniform.uniform: wrong parameters"--- NOTE: failure is in default branch to guard againist NaNs.+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@@ -57,6 +90,10 @@     | 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)@@ -80,4 +117,4 @@   maybeEntropy = Just . D.entropy  instance D.ContGen UniformDistribution where-    genContVar (UniformDistribution a b) gen = MWC.uniformR (a,b) gen+    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,4 +1,5 @@-{-# LANGUAGE CPP, FlexibleContexts, Rank2Types #-}+{-# LANGUAGE BangPatterns, CPP, FlexibleContexts, Rank2Types #-}+{-# OPTIONS_GHC -fsimpl-tick-factor=200 #-} -- | -- Module    : Statistics.Function -- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan@@ -16,6 +17,7 @@       minMax     -- * Sorting     , sort+    , gsort     , sortBy     , partialSort     -- * Indexing@@ -25,20 +27,35 @@     , nextHighestPowerOfTwo     -- * Comparison     , within+    -- * Arithmetic+    , square+    -- * Vectors+    , unsafeModify+    -- * Combinators+    , for+    , rfor     ) where  #include "MachDeps.h" +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 Statistics.Function.Comparison (within)+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Unboxed.Mutable as M+import Numeric.MathFunctions.Comparison (within)  -- | Sort a vector.-sort :: (Ord e, G.Vector v e) => v e -> v e+sort :: U.Vector Double -> U.Vector Double sort = G.modify I.sort-{-# INLINE 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@@ -51,7 +68,7 @@             -> v e             -> v e partialSort k = G.modify (`I.partialSort` k)-{-# INLINE partialSort #-}+{-# SPECIALIZE partialSort :: Int -> U.Vector Double -> U.Vector Double #-}  -- | Return the indices of a vector. indices :: (G.Vector v a, G.Vector v Int) => v a -> v Int@@ -59,8 +76,8 @@ {-# INLINE indices #-}  -- | Zip a vector with its indices.-indexed :: (G.Vector v e, G.Vector v Int, G.Vector v (Int,e)) => v e -> v (Int,e)-indexed a = G.zip (indices a) a+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@@ -99,3 +116,30 @@ -- 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.++-- | 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/Function/Comparison.hs 
@@ -1,40 +0,0 @@--- |--- Module    : Statistics.Function.Comparison--- Copyright : (c) 2011 Bryan O'Sullivan--- License   : BSD3------ Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : portable------ Approximate floating point comparison, based on Bruce Dawson's--- \"Comparing floating point numbers\":--- <http://www.cygnus-software.com/papers/comparingfloats/comparingfloats.htm>--module Statistics.Function.Comparison-    (-      within-    ) where--import Control.Monad.ST         (runST)-import Data.Primitive.ByteArray (newByteArray, readByteArray, writeByteArray)-import Data.Int                 (Int64)---- | Compare two 'Double' values for approximate equality, using--- Dawson's method.------ The required accuracy is specified in ULPs (units of least--- precision).  If the two numbers differ by the given number of ULPs--- or less, this function returns @True@.-within :: Int                   -- ^ Number of ULPs of accuracy desired.-       -> Double -> Double -> Bool-within ulps a b = runST $ do-  buf <- newByteArray 8-  ai0 <- writeByteArray buf 0 a >> readByteArray buf 0-  bi0 <- writeByteArray buf 0 b >> readByteArray buf 0-  let big  = 0x8000000000000000 :: Int64-      ai | ai0 < 0   = big - ai0-         | otherwise = ai0-      bi | bi0 < 0   = big - bi0-         | otherwise = bi0-  return $ abs (ai - bi) <= fromIntegral ulps
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/Math.hs 
@@ -1,27 +0,0 @@-{-# LANGUAGE BangPatterns, FlexibleContexts #-}--- |--- Module    : Statistics.Math--- Copyright : (c) 2009, 2011 Bryan O'Sullivan--- License   : BSD3------ Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : portable------ Mathematical functions for statistics.------ DEPRECATED. Use package math-functions instead. This module is just--- reexports functions from 'Numeric.SpecFunctions',--- 'Numeric.SpecFunctions.Extra' and 'Numeric.Polynomial.Chebyshev'.--module Statistics.Math-{-# DEPRECATED "Use package math-function" #-} -    ( module Numeric.Polynomial.Chebyshev-    , module Numeric.SpecFunctions-    , module Numeric.SpecFunctions.Extra-    ) where--import Numeric.Polynomial.Chebyshev-import Numeric.SpecFunctions-import Numeric.SpecFunctions.Extra-
− Statistics/Math/RootFinding.hs 
@@ -1,131 +0,0 @@-{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric #-}---- |--- Module    : Statistics.Math.RootFinding--- Copyright : (c) 2011 Bryan O'Sullivan--- License   : BSD3------ Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : portable------ Haskell functions for finding the roots of mathematical functions.--module Statistics.Math.RootFinding-    (-      Root(..)-    , fromRoot-    , ridders-    -- * References-    -- $references-    ) where--import Statistics.Function.Comparison--import Data.Binary (Binary)-import Control.Applicative-import Control.Monad       (MonadPlus(..), ap)-import Data.Data (Data, Typeable)-import GHC.Generics (Generic)----- | The result of searching for a root of a mathematical function.-data Root a = NotBracketed-            -- ^ The function does not have opposite signs when-            -- evaluated at the lower and upper bounds of the search.-            | SearchFailed-            -- ^ The search failed to converge to within the given-            -- error tolerance after the given number of iterations.-            | Root a-            -- ^ A root was successfully found.-              deriving (Eq, Read, Show, Typeable, Data, Generic)--instance (Binary a) => Binary (Root a)--instance Functor Root where-    fmap _ NotBracketed = NotBracketed-    fmap _ SearchFailed = SearchFailed-    fmap f (Root a)     = Root (f a)--instance Monad Root where-    NotBracketed >>= _ = NotBracketed-    SearchFailed >>= _ = SearchFailed-    Root a       >>= m = m a--    return = Root--instance MonadPlus Root where-    mzero = SearchFailed--    r@(Root _) `mplus` _ = r-    _          `mplus` p = p--instance Applicative Root where-    pure  = Root-    (<*>) = ap--instance Alternative Root where-    empty = SearchFailed--    r@(Root _) <|> _ = r-    _          <|> p = p---- | Returns either the result of a search for a root, or the default--- value if the search failed.-fromRoot :: a                   -- ^ Default value.-         -> Root a              -- ^ Result of search for a root.-         -> a-fromRoot _ (Root a) = a-fromRoot a _        = a----- | Use the method of Ridders to compute a root of a function.------ The function must have opposite signs when evaluated at the lower--- and upper bounds of the search (i.e. the root must be bracketed).-ridders :: Double               -- ^ Absolute error tolerance.-        -> (Double,Double)      -- ^ Lower and upper bounds for the search.-        -> (Double -> Double)   -- ^ Function to find the roots of.-        -> Root Double-ridders tol (lo,hi) f-    | flo == 0    = Root lo-    | fhi == 0    = Root hi-    | flo*fhi > 0 = NotBracketed -- root is not bracketed-    | otherwise   = go lo flo hi fhi 0-  where-    go !a !fa !b !fb !i-        -- Root is bracketed within 1 ulp. No improvement could be made-        | within 1 a b       = Root a-        -- Root is found. Check that f(m) == 0 is nessesary to ensure-        -- that root is never passed to 'go'-        | fm == 0            = Root m-        | fn == 0            = Root n-        | d < tol            = Root n-        -- Too many iterations performed. Fail-        | i >= (100 :: Int)  = SearchFailed-        -- Ridder's approximation coincide with one of old-        -- bounds. Revert to bisection-        | n == a || n == b   = case () of-          _| fm*fa < 0 -> go a fa m fm (i+1)-           | otherwise -> go m fm b fb (i+1)-        -- Proceed as usual-        | fn*fm < 0          = go n fn m fm (i+1)-        | fn*fa < 0          = go a fa n fn (i+1)-        | otherwise          = go n fn b fb (i+1)-      where-        d    = abs (b - a)-        dm   = (b - a) * 0.5-        !m   = a + dm-        !fm  = f m-        !dn  = signum (fb - fa) * dm * fm / sqrt(fm*fm - fa*fb)-        !n   = m - signum dn * min (abs dn) (abs dm - 0.5 * tol)-        !fn  = f n-    !flo = f lo-    !fhi = f hi----- $references------ * Ridders, C.F.J. (1979) A new algorithm for computing a single---   root of a real continuous function.---   /IEEE Transactions on Circuits and Systems/ 26:979&#8211;980.
Statistics/Quantile.hs view
@@ -1,4 +1,9 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFoldable     #-}+{-# LANGUAGE DeriveFunctor      #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE FlexibleContexts   #-}+{-# LANGUAGE ViewPatterns       #-} -- | -- Module    : Statistics.Quantile -- Copyright : (c) 2009 Bryan O'Sullivan@@ -15,46 +20,79 @@ -- 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 Data.Vector.Generic             ((!))-import Numeric.MathFunctions.Constants (m_epsilon)-import Statistics.Function             (partialSort)-import qualified Data.Vector.Generic as G+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) --- | O(/n/ log /n/). Estimate the /k/th /q/-quantile of a sample,--- using the weighted average method.-weightedAvg :: G.Vector v Double => +import Statistics.Function (partialSort)+++----------------------------------------------------------------+-- 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   | 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 < 0 || k >= q = modErr "weightedAvg" "Wrong quantile number"-  | otherwise       = xj + g * (xj1 - xj)+  | 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 (n - 1) * fromIntegral k / fromIntegral q@@ -63,127 +101,300 @@     xj1 = sx ! (j+1)     sx  = partialSort (j+2) x     n   = G.length x-{-# INLINE weightedAvg #-}+{-# 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 :: G.Vector v Double =>-                ContParam  -- ^ Parameters /a/ and /b/.-             -> Int        -- ^ /k/, the desired quantile.-             -> Int        -- ^ /q/, the number of quantiles.-             -> v Double   -- ^ /x/, the sample data.-             -> Double-continuousBy (ContParam a b) k q x-  | q < 2          = modErr "continuousBy" "At least 2 quantiles is needed"-  | k < 0 || k > q = modErr "continuousBy" "Wrong quantile number"-  | G.any isNaN x  = modErr "continuousBy" "Sample contains NaNs"-  | otherwise      = (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               = G.length x-    item            = (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 (U.fromList [1,1,2,2,3])--- > ==> 1.333333-midspread :: G.Vector v Double =>-             ContParam  -- ^ Parameters /a/ and /b/.-          -> Int        -- ^ /q/, the number of quantiles.-          -> v Double   -- ^ /x/, the sample data.-          -> Double-midspread (ContParam a b) k x-  | G.any isNaN x = modErr "midspread" "Sample contains NaNs"-  | k <= 0        = modErr "midspread" "Nonpositive number of quantiles"-  | otherwise     = 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                 = G.length x-    item              = (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/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,4 +1,11 @@-{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric #-}+{-# LANGUAGE BangPatterns       #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFoldable     #-}+{-# LANGUAGE DeriveFunctor      #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE DeriveTraversable  #-}+{-# LANGUAGE FlexibleContexts   #-}+{-# LANGUAGE TypeFamilies       #-}  -- | -- Module    : Statistics.Resampling@@ -12,29 +19,54 @@ -- 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.Concurrent (forkIO, newChan, readChan, writeChan)-import Control.Monad (forM_, liftM, replicateM_)-import Control.Monad.Primitive (PrimMonad, PrimState)+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)+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.Types (Estimator, Sample)-import System.Random.MWC (Gen, initialize, uniform, uniformVector)-import qualified Data.Vector.Unboxed as U-import qualified Data.Vector.Unboxed.Mutable as MU+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.@@ -42,8 +74,73 @@       fromResample :: U.Vector Double     } deriving (Eq, Read, Show, Typeable, Data, Generic) -instance Binary 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. --@@ -56,42 +153,124 @@ -- available CPUs.  At least with GHC 7.0, parallel performance seems -- best if the parallel garbage collector is disabled (RTS option -- @-qg@).-resample :: Gen (PrimState IO)+resample :: GenIO          -> [Estimator]         -- ^ Estimation functions.          -> Int                 -- ^ Number of resamples to compute.-         -> Sample              -- ^ Original sample.-         -> IO [Resample]+         -> U.Vector Double     -- ^ Original sample.+         -> IO [(Estimator, Bootstrap U.Vector Double)] resample gen ests numResamples samples = do-  let !numSamples = U.length samples-      ixs = scanl (+) 0 $+  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-  done <- newChan-  forM_ (zip ixs (tail ixs)) $ \ (start,!end) -> do-    gen' <- initialize =<< (uniformVector gen 256 :: IO (U.Vector Word32))-    forkIO $ do-      let loop k ers | k >= end = writeChan done ()+  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 <- U.replicateM numSamples $ do-                    r <- uniform gen'-                    return (U.unsafeIndex samples (r `mod` numSamples))+            re <- resampleVector gen' samples             forM_ ers $ \(est,arr) ->                 MU.write arr k . est $ re             loop (k+1) ers-      loop start (zip ests results)-  replicateM_ numCapabilities $ readChan done+      loop start (zip ests' results)   mapM_ sort results-  mapM (liftM Resample . unsafeFreeze) results+  -- Build resamples+  res <- mapM unsafeFreeze results+  return $ zip ests+         $ zipWith Bootstrap [estimate e samples | e <- ests]+                             res+ where+  ests' = map estimate ests --- | Compute a statistical estimate repeatedly over a sample, each--- time omitting a successive element.+-- | 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 est sample = U.map f . indices $ sample-    where f i = est (dropAt i sample)-{- INLINE jackknife #-}+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 :: 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,3 @@-{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, OverloadedStrings,-    RecordWildCards #-}- -- | -- Module    : Statistics.Resampling.Bootstrap -- Copyright : (c) 2009, 2011 Bryan O'Sullivan@@ -13,99 +10,67 @@ -- The bootstrap method for statistical inference.  module Statistics.Resampling.Bootstrap-    (-      Estimate(..)-    , bootstrapBCA-    , scale+    ( bootstrapBCA+    , basicBootstrap     -- * References     -- $references     ) where -import Control.DeepSeq (NFData)-import Control.Exception (assert)-import Control.Monad.Par               (parMap,runPar)-import Data.Binary (Binary)-import Data.Data (Data)-import Data.Typeable (Typeable)-import Data.Vector.Unboxed ((!))-import GHC.Generics+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.Distribution.Normal-import Statistics.Resampling (Resample(..), jackknife)+import Statistics.Resampling (Bootstrap(..), jackknife) import Statistics.Sample (mean)-import Statistics.Types (Estimator, Sample)-import qualified Data.Vector.Unboxed as U---- | 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, Read, Show, Typeable, Data, Generic)--instance Binary Estimate-instance NFData Estimate+import Statistics.Types (Sample, CL, Estimate, ConfInt, estimateFromInterval,+                         estimateFromErr, CL, significanceLevel)+import Statistics.Function (gsort) --- | Multiply the point, lower bound, and upper bound in an 'Estimate'--- by the given value.-scale :: Double                 -- ^ Value to multiply by.-      -> Estimate -> Estimate-scale f e@Estimate{..} = e {-                           estPoint = f * estPoint-                         , estLowerBound = f * estLowerBound-                         , estUpperBound = f * estUpperBound-                         }+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 estimators resamples-  | confidenceLevel > 0 && confidenceLevel < 1-      = runPar $ parMap (uncurry e) (zip estimators resamples)-  | otherwise = error "Statistics.Resampling.Bootstrap.bootstrapBCA: confidence level outside (0,1) range"+--   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)-      | U.length sample == 1 = estimate pt pt pt confidenceLevel+    e (est, Bootstrap pt resample)+      | U.length sample == 1 || isInfinite bias =+          estimateFromErr      pt (0,0) confidenceLevel       | otherwise =-          estimate pt (resample ! lo) (resample ! hi) confidenceLevel+          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 . U.length . U.filter (<pt) $ resample-        ni    = U.length resample-        n     = fromIntegral ni         accel = sumCubes / (6 * (sumSquares ** 1.5))           where (sumSquares :< sumCubes) = U.foldl' f (0 :< 0) jack                 f (s :< c) j = s + d2 :< c + d2 * d@@ -113,6 +78,29 @@                           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 FlexibleContexts #-}+{-# LANGUAGE BangPatterns #-} -- | -- Module    : Statistics.Sample -- Copyright : (c) 2008 Don Stewart, 2009 Bryan O'Sullivan@@ -20,7 +21,9 @@     , range      -- * Statistics of location+    , expectation     , mean+    , welfordMean     , meanWeighted     , harmonicMean     , geometricMean@@ -42,6 +45,7 @@     , meanVarianceUnb     , stdDev     , varianceWeighted+    , stdErrMean      -- ** Single-pass functions (faster, less safe)     -- $cancellation@@ -49,16 +53,26 @@     , fastVarianceUnbiased     , fastStdDev +    -- * Joint distributions+    , covariance+    , correlation+    , covariance2+    , correlation2+    , pair     -- * References     -- $references     ) where -import Statistics.Function (minMax)-import Statistics.Types (Sample,WeightedSample)+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)) --- Operator ^ will be overriden-import Prelude hiding ((^))+-- Operator ^ will be overridden+import Prelude hiding ((^), sum)  -- | /O(n)/ Range. The difference between the largest and smallest -- elements of a sample.@@ -67,19 +81,39 @@     where (lo , hi) = minMax s {-# INLINE range #-} +-- | /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 :: (G.Vector v Double) => v Double -> Double-mean = fini . G.foldl' 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 #-}  -- | /O(n)/ Arithmetic mean for weighted sample. It uses a single-pass--- algorithm analogous to the one used by 'mean'.+-- 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@@ -101,7 +135,7 @@  -- | /O(n)/ Geometric mean of a sample containing no negative values. geometricMean :: (G.Vector v Double) => v Double -> Double-geometricMean = exp . mean . G.map log+geometricMean = exp . expectation log {-# INLINE geometricMean #-}  -- | Compute the /k/th central moment of a sample.  The central moment@@ -117,11 +151,12 @@     | a < 0  = error "Statistics.Sample.centralMoment: negative input"     | a == 0 = 1     | a == 1 = 0-    | otherwise = G.sum (G.map go xs) / fromIntegral (G.length 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. --@@ -139,7 +174,10 @@         fini (V i j) = (i / n , j / n)         m            = mean xs         n            = fromIntegral (G.length xs)-{-# INLINE centralMoments #-}+{-# 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.@@ -166,7 +204,8 @@ skewness :: (G.Vector v Double) => v Double -> Double skewness xs = c3 * c2 ** (-1.5)     where (c3 , c2) = centralMoments 3 2 xs-{-# INLINE skewness #-}+{-# 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@@ -184,11 +223,12 @@ kurtosis :: (G.Vector v Double) => v Double -> Double kurtosis xs = c4 / (c2 * c2) - 3     where (c4 , c2) = centralMoments 4 2 xs-{-# INLINE kurtosis #-}+{-# 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@@ -202,11 +242,6 @@  data V = V {-# UNPACK #-} !Double {-# UNPACK #-} !Double -robustSumVar :: (G.Vector v Double) => Double -> v Double -> Double-robustSumVar m = G.sum . G.map (square . subtract m)-  where square x = x * x-{-# INLINE robustSumVar #-}- -- | Maximum likelihood estimate of a sample's variance.  Also known -- as the population variance, where the denominator is /n/. variance :: (G.Vector v Double) => v Double -> Double@@ -215,8 +250,10 @@     | otherwise = 0     where       n = G.length samp-{-# INLINE variance #-}+{-# 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 :: (G.Vector v Double) => v Double -> Double@@ -225,7 +262,8 @@     | otherwise = 0     where       n = G.length samp-{-# INLINE varianceUnbiased #-}+{-# 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@@ -237,26 +275,36 @@     where       n = G.length samp       m = mean samp-{-# INLINE meanVariance #-}+{-# 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 :: (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-{-# INLINE meanVarianceUnb #-}+{-# SPECIALIZE meanVarianceUnb :: U.Vector Double -> (Double,Double) #-}+{-# SPECIALIZE meanVarianceUnb :: V.Vector Double -> (Double,Double) #-}  -- | Standard deviation.  This is simply the square root of the -- unbiased estimate of the variance. stdDev :: (G.Vector v Double) => v Double -> Double stdDev = sqrt . varianceUnbiased-{-# INLINE stdDev #-}+{-# 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@@ -272,7 +320,8 @@     | otherwise         = 0     where       fini (V s w) = s / w-{-# INLINE varianceWeighted #-}+{-# SPECIALIZE varianceWeighted :: U.Vector (Double,Double) -> Double #-}+{-# SPECIALIZE varianceWeighted :: V.Vector (Double,Double) -> Double #-}  -- $cancellation --@@ -316,13 +365,97 @@ 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-x ^ 1 = x-x ^ n = x * (x ^ (n-1))+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.
Statistics/Sample/Histogram.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleContexts, BangPatterns, ScopedTypeVariables #-}  -- | -- Module    : Statistics.Sample.Histogram@@ -19,6 +19,7 @@     , 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@@ -49,7 +50,7 @@ -- -- Interval (bin) sizes are uniform, based on the supplied upper -- and lower bounds.-histogram_ :: (Num b, RealFrac a, G.Vector v0 a, G.Vector v1 b) =>+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.@@ -65,16 +66,18 @@            -> 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-         GM.write bins b . (+1) =<< GM.read bins b+         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) * (1 + realToFrac m_epsilon)) / fromIntegral numBins+       d = ((hi - lo) / fromIntegral numBins) * (1 + realToFrac m_epsilon) {-# INLINE histogram_ #-}  -- | /O(n)/ Compute decent defaults for the lower and upper bounds of
+ 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
@@ -25,15 +25,17 @@     -- $references     ) where -import Prelude hiding (const,min,max)+import Data.Default.Class import Numeric.MathFunctions.Constants (m_sqrt_2_pi)-import Statistics.Function             (minMax, nextHighestPowerOfTwo)-import Statistics.Math.RootFinding     (fromRoot, ridders)-import Statistics.Sample.Histogram     (histogram_)-import Statistics.Transform            (dct, idct)-import qualified Data.Vector.Generic as G-import qualified Data.Vector.Unboxed as U-+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@@ -46,18 +48,23 @@ --   mesh interval, use 'kde_'.) -- -- * Density estimates at each mesh point.-kde :: Int+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.-    -> U.Vector Double -> (U.Vector Double, U.Vector Double)+    -> v Double -> (v Double, v Double) kde n0 xs = kde_ n0 (lo - range / 10) (hi + range / 10) xs   where     (lo,hi) = minMax xs-    range   | U.length xs <= 1 = 1       -- Unreasonable guess+    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. --@@ -66,7 +73,8 @@ -- * The coordinates of each mesh point. -- -- * Density estimates at each mesh point.-kde_ :: Int+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.@@ -74,9 +82,10 @@      -- ^ Lower bound (@min@) of the mesh range.      -> Double      -- ^ Upper bound (@max@) of the mesh range.-     -> U.Vector Double -> (U.Vector Double, U.Vector Double)+     -> v Double+     -> (v Double, v Double) kde_ n0 min max xs-  | U.null xs = error "Statistics.KernelDensity.kde: empty sample"+  | G.null xs = error "Statistics.KernelDensity.kde: empty sample"   | n0 <= 1   = error "Statistics.KernelDensity.kde: invalid number of points"   | otherwise = (mesh, density)   where@@ -87,13 +96,13 @@     !n  = fromIntegral ni     !ni = nextHighestPowerOfTwo n0     !r  = max - min-    a   = dct . G.map (/ G.sum h) $ h+    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 1e-14 (0,0.1) $ \x ->-              x - (len * (2 * sqrt pi) * go 6 (f 7 x)) ** (-0.4)+    !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) * G.sum (G.zipWith g iv a2v)+        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)@@ -103,6 +112,10 @@                 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 --
Statistics/Sample/KernelDensity/Simple.hs view
@@ -46,23 +46,31 @@     -- $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 qualified Data.Vector.Unboxed as U+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 Binary Points+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@@ -148,7 +156,7 @@     | n < 2     = errorShort "estimatePDF"     | otherwise = U.map k . fromPoints   where-    k p = G.sum . G.map (kernel f h p) $ sample+    k p = sum . G.map (kernel f h p) $ sample     f   = 1 / (h * fromIntegral n)     n   = G.length sample {-# INLINE estimatePDF #-}
+ 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
@@ -47,26 +47,33 @@     -- $references     ) where -import Data.Binary (Binary(..))-import Data.Data (Data, Typeable)-import Data.Vector.Binary ()-import Data.Vector.Generic   (unsafeFreeze)+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 GHC.Generics          (Generic)+import Numeric.SpecFunctions (choose) import Prelude hiding (sum) import Statistics.Function   (indexed)-import Statistics.Internal   (inlinePerformIO)-import Numeric.SpecFunctions (choose)-import System.IO.Unsafe      (unsafePerformIO)-import qualified Data.Vector.Unboxed as U-import qualified Data.Vector.Generic as G+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 (U.Vector Double)     deriving (Eq, Read, Show, Typeable, Data, Generic) -instance Binary Powers+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@@ -86,23 +93,26 @@           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 . G.foldl' go (unsafePerformIO $ MU.replicate l 0)+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 $ loop 0 1-        where loop !i !xk | i == l = return ms-                          | otherwise = do-                MU.read ms i >>= MU.write ms i . (+ xk)-                loop (i+1) (xk*x)-    fini = Powers . unsafePerformIO . unsafeFreeze-    l    = k + 1-{-# INLINE powers #-}+    l = k + 1+{-# 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'. order :: Powers -> Int order (Powers pa) = U.length pa - 1-{-# INLINE order #-}  -- | Compute the /k/th central moment of a sample.  The central -- moment is also known as the moment about the mean.@@ -112,12 +122,11 @@                   error ("Statistics.Sample.Powers.centralMoment: "                          ++ "invalid argument")     | k == 0    = 1-    | otherwise = (/n) . U.sum . U.map go . indexed . U.take (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 = 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@@ -130,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.@@ -147,7 +154,6 @@     | n > 1     = variance p * n / (n-1)     | otherwise = 0   where n = U.head pa-{-# INLINE varianceUnbiased #-}  -- | Compute the skewness of a sample. This is a measure of the -- asymmetry of its distribution.@@ -169,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@@ -183,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 $ U.head pa-{-# INLINE count #-}  -- | The sum of elements in the original 'Sample'.  This is the -- sample's first simple power. sum :: Powers -> Double sum (Powers pa) = pa ! 1-{-# INLINE sum #-}  -- | The arithmetic mean of elements in the original 'Sample'. --@@ -207,7 +209,6 @@     | n == 0    = 0     | otherwise = sum p / n     where n     = U.head pa-{-# INLINE mean #-}  -- $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
@@ -2,38 +2,80 @@ -- | Pearson's chi squared test. module Statistics.Test.ChiSquared (     chi2test-    -- * Data types-  , TestType(..)-  , TestResult(..)+  , chi2testCont+  , module Statistics.Test.Types   ) where -import qualified Data.Vector.Generic as G+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.-chi2test :: (G.Vector v (Int,Double), G.Vector v Double)-         => Double              -- ^ p-value-         -> Int                 -- ^ Number of additional degrees of+--+--   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.-         -> TestResult-chi2test p ndf vec-  | ndf < 0        = error $ "Statistics.Test.ChiSquare.chi2test: negative NDF " ++ show ndf-  | n   < 0        = error $ "Statistics.Test.ChiSquare.chi2test: too short data sample"-  | p > 0 && p < 1 = significant $ complCumulative d chi2 < p-  | otherwise      = error $ "Statistics.Test.ChiSquare.chi2test: bad p-value: " ++ show p+         -> 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  = G.sum $ G.map (\(o,e) -> sqr (fromIntegral o - e) / e) vec+    chi2  = Sum.kbn+          $ F.foldl' Sum.add Sum.zero+          $ F.map (\(o,e) -> square (fromIntegral o - e) / e)+          $ G.stream vec     d     = chiSquared n-    sqr x = x * x-{-# INLINE chi2test #-}+{-# 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
@@ -1,11 +1,16 @@ {-# LANGUAGE FlexibleContexts #-} module Statistics.Test.Internal (     rank+  , rankUnsorted     , splitByTags     ) where -import qualified Data.Vector.Generic as G-+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@@ -16,11 +21,23 @@     , rankVec :: v a                        -- Remaining vector     } --- | Calculate rank of sample. Sample should be already sorted.-rank :: (G.Vector v a, G.Vector v Double)+-- | 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-     -> v Double+     -> U.Vector Double rank eq vec = G.unfoldr go (Rank 0 (-1) 1 vec)   where     go (Rank 0 _ r v)@@ -37,6 +54,34 @@             (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)
Statistics/Test/KolmogorovSmirnov.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleContexts #-} -- | -- Module    : Statistics.Test.KolmogorovSmirnov -- Copyright : (c) 2011 Aleksey Khudyakov@@ -7,10 +8,10 @@ -- Stability   : experimental -- Portability : portable ----- Kolmogov-Smirnov tests are non-parametric tests for assesing+-- 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--- continous distributions.+-- continuous distributions. module Statistics.Test.KolmogorovSmirnov (     -- * Kolmogorov-Smirnov test     kolmogorovSmirnovTest@@ -20,87 +21,102 @@   , kolmogorovSmirnovCdfD   , kolmogorovSmirnovD   , kolmogorovSmirnov2D-    -- * Probablities+    -- * Probabilities   , kolmogorovSmirnovProbability-    -- * Data types-  , TestType(..)-  , TestResult(..)     -- * References     -- $references+  , module Statistics.Test.Types   ) where -import Control.Monad-import Control.Monad.ST  (ST)--import qualified Data.Vector.Unboxed         as U-import qualified Data.Vector.Unboxed.Mutable as M--import Statistics.Distribution        (Distribution(..))-import Statistics.Types               (Sample)-import Statistics.Function            (sort)+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 Text.Printf-+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. 'Significant' means distribution is not compatible---   with data for given p-value.+-- | Check that sample could be described by distribution. Returns+--   @Nothing@ is sample is empty -----   This test uses Marsaglia-Tsang-Wang exact alogorithm for+--   This test uses Marsaglia-Tsang-Wang exact algorithm for --   calculation of p-value.-kolmogorovSmirnovTest :: Distribution d-                      => d      -- ^ Distribution-                      -> Double -- ^ p-value-                      -> Sample -- ^ Data sample-                      -> TestResult-kolmogorovSmirnovTest d = kolmogorovSmirnovTestCdf (cumulative d)+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 CFD in form of++-- | Variant of 'kolmogorovSmirnovTest' which uses CDF in form of --   function.-kolmogorovSmirnovTestCdf :: (Double -> Double) -- ^ CDF of distribution-                         -> Double             -- ^ p-value-                         -> Sample             -- ^ Data sample-                         -> TestResult-kolmogorovSmirnovTestCdf cdf p sample-  | p > 0 && p < 1 = significant $ 1 - prob < p-  | otherwise      = error "Statistics.Test.KolmogorovSmirnov.kolmogorovSmirnovTestCdf:bad p-value"+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 (U.length sample) d+    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.+--   making any assumptions about it. If either of samples is empty+--   returns Nothing. -----   This test uses approxmate formula for computing p-value.-kolmogorovSmirnovTest2 :: Double -- ^ p-value-                       -> Sample -- ^ Sample 1-                       -> Sample -- ^ Sample 2-                       -> TestResult-kolmogorovSmirnovTest2 p xs1 xs2-  | p > 0 && p < 1 = significant $ 1 - prob( d*(en + 0.12 + 0.11/en) ) < p-  | otherwise      = error "Statistics.Test.KolmogorovSmirnov.kolmogorovSmirnovTest2:bad p-value"+--   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 (U.length xs1)-    n2   = fromIntegral (U.length xs2)+    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    = 1+      | 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)+                    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  @@ -112,65 +128,76 @@ -- | Calculate Kolmogorov's statistic /D/ for given cumulative --   distribution function (CDF) and data sample. If sample is empty --   returns 0.-kolmogorovSmirnovCdfD :: (Double -> Double) -- ^ CDF function-                      -> Sample             -- ^ Sample+kolmogorovSmirnovCdfD :: G.Vector v Double+                      => (Double -> Double) -- ^ CDF function+                      -> v Double           -- ^ Sample                       -> Double kolmogorovSmirnovCdfD cdf sample-  | U.null xs = 0-  | otherwise = U.maximum-              $ U.zipWith3 (\p a b -> abs (p-a) `max` abs (p-b))-                  ps steps (U.tail steps)+  | 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 = sort sample-    n  = U.length xs+    xs = gsort sample+    n  = G.length xs     ---    ps    = U.map cdf xs-    steps = U.map ((/ fromIntegral n) . fromIntegral)-          $ U.generate (n+1) id+    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)+kolmogorovSmirnovD :: (Distribution d, G.Vector v Double)                    => d         -- ^ Distribution-                   -> Sample    -- ^ Sample+                   -> 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 :: Sample   -- ^ First sample-                    -> Sample   -- ^ Second sample+kolmogorovSmirnov2D :: (G.Vector v Double)+                    => v Double   -- ^ First sample+                    -> v Double   -- ^ Second sample                     -> Double kolmogorovSmirnov2D sample1 sample2-  | U.null sample1 || U.null sample2 = 0+  | G.null sample1 || G.null sample2 = 0   | otherwise                        = worker 0 0 0   where-    xs1 = sort sample1-    xs2 = sort sample2-    n1  = U.length xs1-    n2  = U.length xs2+    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 >= U.length xs = n-                 | xs U.! n == x    = go (n+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 U.! i1-        d2  = xs2 U.! i2+        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 #-}   @@ -184,10 +211,10 @@                              -> Double -- ^ D value                              -> Double kolmogorovSmirnovProbability n d-  -- Avoid potencially lengthy calculations for large N and D > 0.999+  -- 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 $ matrixPower matrix n+  | otherwise = fini $ KSMatrix 0 matrix `power` n   where     s  = n' * d * d     n' = fromIntegral n@@ -208,22 +235,22 @@             -- Correct left column/bottom row             for 0 size $ \i -> do               let delta = h ^^ (i + 1)-              modify mat (i    * size)         (subtract delta)-              modify mat (size * size - 1 - i) (subtract delta)+              unsafeModify mat (i    * size)         (subtract delta)+              unsafeModify mat (size * size - 1 - i) (subtract delta)             -- Correct corner element if needed             when (2*h > 1) $ do-              modify mat ((size - 1) * size) (+ ((2*h - 1) ^ size))+              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 ->-                                       modify mat (i * (size + 1) - num) (/ g)+                                       unsafeModify mat (i * (size + 1) - num) (/ g)                                      divide (g * fromIntegral (num+2)) (num+1)             divide 2 1             return mat-      in Matrix size m 0+      in fromVector size size m     -- Last calculation-    fini m@(Matrix _ _ e) = loop 1 (matrixCenter m) e+    fini (KSMatrix e m) = loop 1 (center m) e       where         loop i ss eQ           | i  > n       = ss * 10 ^^ eQ@@ -231,74 +258,26 @@           | otherwise    = loop (i+1)  ss'           eQ           where ss' = ss * fromIntegral i / fromIntegral n ---------------------------------------------------------------------- Maxtrix operations.------ There isn't the matrix package for haskell yet so nessesary minimum--- is implemented here.---- Square matrix stored in row-major order-data Matrix = Matrix-              {-# UNPACK #-} !Int -- Size of matrix-              !(U.Vector Double)  -- Matrix data-              {-# UNPACK #-} !Int -- In order to avoid overflows-                                  -- during matrix multiplication large-                                  -- exponent is stored seprately---- Show instance useful mostly for debugging-instance Show Matrix where-  show (Matrix n vs _) = unlines $ map (unwords . map (printf "%.4f")) $ split $ U.toList vs-    where-      split [] = []-      split xs = row : split rest where (row, rest) = splitAt n xs+data KSMatrix = KSMatrix Int Mat.Matrix  --- Avoid overflow in the matrix-avoidOverflow :: Matrix -> Matrix-avoidOverflow m@(Matrix n xs e)-  | matrixCenter m > 1e140 = Matrix n (U.map (* 1e-140) xs) (e + 140)-  | otherwise              = m---- Unsafe matrix-matrix multiplication. Matrices must be of the same--- size. This is not checked.-matrixMultiply :: Matrix -> Matrix -> Matrix-matrixMultiply (Matrix n xs e1) (Matrix _ ys e2) =-  Matrix n (U.generate (n*n) go) (e1 + e2)-  where-    go i = U.sum $ U.zipWith (*) row col-      where-        nCol = i `rem` n-        row  = U.slice (i - nCol) n xs-        col  = U.backpermute ys $ U.enumFromStepN nCol n n+multiply :: KSMatrix -> KSMatrix -> KSMatrix+multiply (KSMatrix e1 m1) (KSMatrix e2 m2) = KSMatrix (e1+e2) (Mat.multiply m1 m2) --- Raise matrix to power N. power must be positive it's not checked-matrixPower :: Matrix -> Int -> Matrix-matrixPower mat 1 = mat-matrixPower mat n = avoidOverflow res+power :: KSMatrix -> Int -> KSMatrix+power mat 1 = mat+power mat n = avoidOverflow res   where-    mat2 = matrixPower mat (n `quot` 2)-    pow  = matrixMultiply mat2 mat2-    res | odd n     = matrixMultiply pow mat+    mat2 = power mat (n `quot` 2)+    pow  = multiply mat2 mat2+    res | odd n     = multiply pow mat         | otherwise = pow --- Element in the center of matrix (Not corrected for exponent)-matrixCenter :: Matrix -> Double-matrixCenter (Matrix n xs _) = (U.!) xs (k*n + k) where k = n `quot` 2---- Simple for loop-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)+avoidOverflow :: KSMatrix -> KSMatrix+avoidOverflow ksm@(KSMatrix e m)+  | center m > 1e140 = KSMatrix (e + 140) (Mat.map (* 1e-140) m)+  | otherwise        = ksm --- Modify element in the vector-modify :: U.Unbox a => M.MVector s a -> Int -> (a -> a) -> ST s ()-modify arr i f = do x <- M.read arr i-                    M.write arr i (f x)-{-# INLINE modify #-}  ----------------------------------------------------------------
+ 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
@@ -8,7 +8,7 @@ -- Portability : portable -- -- Mann-Whitney U test (also know as Mann-Whitney-Wilcoxon and--- Wilcoxon rank sum test) is a non-parametric test for assesing+-- Wilcoxon rank sum test) is a non-parametric test for assessing -- whether two samples of independent observations have different -- mean. module Statistics.Test.MannWhitneyU (@@ -19,43 +19,37 @@   , mannWhitneyUSignificant     -- ** Wilcoxon rank sum test   , wilcoxonRankSums-    -- * Data types-  , TestType(..)-  , TestResult(..)+  , module Statistics.Test.Types     -- * References     -- $references   ) where -import Control.Applicative ((<$>))-import Data.List           (findIndex)-import Data.Ord            (comparing)-import qualified Data.Vector.Unboxed as U--import Numeric.SpecFunctions          (choose)--import Statistics.Distribution        (quantile)+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.Types               (Sample)-import Statistics.Function            (sortBy)-import Statistics.Test.Types-import Statistics.Test.Internal--+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.+-- 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&#8321;, W&#8322;) where W&#8321; is the sum of ranks of the first sample--- and W&#8322; is the sum of ranks of the second sample.  This test is trivially transformed+-- 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 :: Sample -> Sample -> (Double, Double)-wilcoxonRankSums xs1 xs2 = ( U.sum ranks1 , U.sum ranks2-                           )+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)@@ -64,7 +58,7 @@                       $ sortBy (comparing snd)                       $ tagSample True xs1 U.++ tagSample False xs2     -- Add tag to a sample-    tagSample t = U.map ((,) t)+    tagSample t = U.map (\x -> (t,x))   @@ -75,19 +69,19 @@ -- 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&#8321;--- and U&#8322;, so it is worth being explicit about what this function returns.--- Given two samples, the first, xs&#8321;, of size n&#8321; and the second, xs&#8322;,--- of size n&#8322;, this function returns (U&#8321;, U&#8322;)--- where U&#8321; = W&#8321; - (n&#8321;(n&#8321;+1))\/2--- and U&#8322; = W&#8322; - (n&#8322;(n&#8322;+1))\/2,--- where (W&#8321;, W&#8322;) is the return value of @wilcoxonRankSums xs1 xs2@.+-- 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&#8321; and U&#8322; should be the other way round, often--- expressing this using U&#8321;' = n&#8321;n&#8322; - U&#8321; (since U&#8321; + U&#8322; = n&#8321;n&#8322;).+-- 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 :: Sample -> Sample -> (Double, Double)+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)@@ -108,20 +102,20 @@ -- 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-                          -> Double     -- ^ The p-value (e.g. 0.05) for which you want the critical value.-                          -> Maybe Int  -- ^ The critical value (of U).+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    -- Nonsensical p-value-  | p' <= 1        = Nothing    -- p-value is too small. Null hypothesys couln't be disproved+  | 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 * p+    p'   = mnCn * pValue p   {-@@ -138,13 +132,13 @@     n = bigN - m -} --- Memoised version of the original a function, above. +-- 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@@ -184,31 +178,34 @@ -- -- 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&#8321;, U&#8322;) pairs.-mannWhitneyUSignificant ::-     TestType         -- ^ Perform one-tailed test (see description above).-  -> (Int, Int)       -- ^ The samples' size from which the (U&#8321;,U&#8322;) values were derived.-  -> Double           -- ^ The p-value at which to test (e.g. 0.05)-  -> (Double, Double) -- ^ The (U&#8321;, U&#8322;) values from 'mannWhitneyU'.+-- 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) p (u1, u2)-   --Use normal approximation+mannWhitneyUSignificant test (in1, in2) pVal (u1, u2)+  -- Use normal approximation   | in1 > 20 || in2 > 20 =-    let mean  = n1 * n2 / 2+    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-                OneTailed -> significant $ z     < quantile standard  p-                TwoTailed -> significant $ abs z > abs (quantile standard (p/2))+                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) p+  | otherwise = do crit <- fromIntegral <$> mannWhitneyUCriticalValue (in1, in2) pVal                    return $ case test of-                              OneTailed -> significant $ u2        <= crit-                              TwoTailed -> significant $ min u1 u2 <= crit+                              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@@ -218,13 +215,14 @@ -- -- One-tailed test checks whether first sample is significantly larger -- than second. Two-tailed whether they are significantly different.-mannWhitneyUtest :: TestType    -- ^ Perform one-tailed test (see description above).-                 -> Double      -- ^ The p-value at which to test (e.g. 0.05)-                 -> Sample      -- ^ First sample-                 -> Sample      -- ^ Second sample-                 -> Maybe TestResult-                 -- ^ Return 'Nothing' if the sample was too small to-                 --   make a decision.+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
− Statistics/Test/NonParametric.hs 
@@ -1,24 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}--- |--- Module    : Statistics.Test.NonParametric--- Copyright : (c) 2010 Neil Brown--- License   : BSD3------ Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : portable------ Functions for performing non-parametric tests (i.e. tests without an assumption--- of underlying distribution).---- HADDOCK NOTE---   &#8321; is 1 subscript---   &#8322; is 2 subscript-module Statistics.Test.NonParametric-{-# DEPRECATED "Use S.Test.MannWhitneyU and S.Test.WilcoxonT instead" #-}-  ( module Statistics.Test.MannWhitneyU-  , module Statistics.Test.WilcoxonT-  ) where--import Statistics.Test.MannWhitneyU-import Statistics.Test.WilcoxonT
+ 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
@@ -1,27 +1,93 @@-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFunctor, DeriveDataTypeable,DeriveGeneric  #-} module Statistics.Test.Types (-    TestType(..)+    Test(..)+  , isSignificant   , TestResult(..)   , significant+  , PositionTest(..)   ) where -import Data.Typeable (Typeable)+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) --- | Test type. Exact meaning depends on a specific test. But--- generally it's tested whether some statistics is too big (small)--- for 'OneTailed' or whether it too big or too small for 'TwoTailed'-data TestType = OneTailed-              | TwoTailed-              deriving (Eq,Ord,Show,Typeable)  -- | Result of hypothesis testing data TestResult = Significant    -- ^ Null hypothesis should be rejected                 | NotSignificant -- ^ Data is compatible with hypothesis-                  deriving (Eq,Ord,Show,Typeable)+                  deriving (Eq,Ord,Show,Typeable,Data,Generic) --- | Significant if parameter is 'True', not significant otherwiser+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-{-# INLINE significant #-}
Statistics/Test/WilcoxonT.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE ViewPatterns #-} -- | -- Module    : Statistics.Test.WilcoxonT -- Copyright : (c) 2010 Neil Brown@@ -8,61 +9,71 @@ -- Portability : portable -- -- The Wilcoxon matched-pairs signed-rank test is non-parametric test--- which could be used to whether two related samples have different--- means.------ WARNING: current implementation contain critical bugs--- <https://github.com/bos/statistics/issues/18>+-- 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-    -- * Data types-  , TestType(..)-  , TestResult(..)+  , module Statistics.Test.Types+    -- * References+    -- $references   ) where -import Control.Applicative ((<$>))-import Data.Function       (on)-import Data.List           (findIndex)-import Data.Ord            (comparing)-import qualified Data.Vector.Unboxed as U -import Statistics.Types               (Sample)-import Statistics.Function            (sortBy)-import Statistics.Test.Types-import Statistics.Test.Internal ---- | The Wilcoxon matched-pairs signed-rank test. ----- The value returned is the pair (T+, T-).  T+ is the sum of positive ranks (the--- 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).--- These values mean little by themselves, and should be combined with the 'wilcoxonSignificant'--- function in this module to get a meaningful result. ----- The samples are zipped together: if one is longer than the other, both are truncated--- to the the length of the shorter sample. -- -- Note that: wilcoxonMatchedPairSignedRank == (\(x, y) -> (y, x)) . flip wilcoxonMatchedPairSignedRank-wilcoxonMatchedPairSignedRank :: Sample -> Sample -> (Double, Double)-wilcoxonMatchedPairSignedRank a b = (          U.sum ranks1-                                    , negate $ U.sum ranks2-                                    )+-- 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))   -- Attack tags to distribution elements-                 $ U.filter  (/= 0.0)        -- Remove equal elements-                 $ sortBy (comparing abs)    -- Sort the differences by absolute difference-                 $ U.zipWith (-) a b         -- Work out differences+                 $ 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. --@@ -91,6 +102,8 @@   | 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. --@@ -104,24 +117,33 @@ -- 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 ::-     TestType            -- ^ Perform one- or two-tailed test (see description below).-  -> Int                 -- ^ The sample size from which the (T+,T-) values were derived.-  -> Double              -- ^ The p-value at which to test (e.g. 0.05)-  -> (Double, Double)    -- ^ The (T+, T-) values from 'wilcoxonMatchedPairSignedRank'.-  -> Maybe TestResult    -- ^ Return 'Nothing' if the sample was too-                         --   small to make a decision.-wilcoxonMatchedPairSignificant test sampleSize p (tPlus, tMinus) =+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:-    OneTailed -> (significant . (abs tMinus <=) . fromIntegral) <$> wilcoxonMatchedPairCriticalValue sampleSize p+    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:-    TwoTailed -> (significant . (t <=) . fromIntegral) <$> wilcoxonMatchedPairCriticalValue sampleSize (p/2)+    --+    -- 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@@ -133,39 +155,58 @@ --  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 paper \"Critical Values for the Wilcoxon Signed Rank Statistic\", Peter--- Mitic, The Mathematica Journal, volume 6, issue 3, 1996, which can be found--- here: <http://www.mathematica-journal.com/issue/v6i3/article/mitic/contents/63mitic.pdf>.--- 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.+-- 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-  -> Double             -- ^ The p-value (e.g. 0.05) for which you want the critical value.+  -> 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 sampleSize p-  = case critical of-      Just n | n < 0 -> Nothing-             | otherwise -> Just n-      Nothing -> Just maxBound -- shouldn't happen: beyond end of list+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-    m = (2 ** fromIntegral sampleSize) * p-    critical = subtract 1 <$> findIndex (> m) (summedCoefficients sampleSize)+    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.-                                -> Double -- ^ The significance (p-value).-wilcoxonMatchedPairSignificance sampleSize rnk-  = (summedCoefficients sampleSize !! floor rnk) / 2 ** fromIntegral sampleSize+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 the length of the shorter sample.+-- 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@@ -173,16 +214,32 @@ -- -- Check 'wilcoxonMatchedPairSignedRank' and -- 'wilcoxonMatchedPairSignificant' for additional information.-wilcoxonMatchedPairTest :: TestType   -- ^ Perform one-tailed test.-                        -> Double     -- ^ The p-value at which to test (e.g. 0.05)-                        -> Sample     -- ^ First sample-                        -> Sample     -- ^ Second sample-                        -> Maybe TestResult-                        -- ^ Return 'Nothing' if the sample was too-                        --   small to make a decision.-wilcoxonMatchedPairTest test p smp1 smp2 =-    wilcoxonMatchedPairSignificant test (min n1 n2) p-  $ wilcoxonMatchedPairSignedRank smp1 smp2+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-    n1 = U.length smp1-    n2 = U.length smp2+    (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
@@ -29,30 +29,35 @@     , ifft     ) where -import Control.Monad         (when)-import Control.Monad.ST      (ST)-import Data.Bits             (shiftL, shiftR)-import Data.Complex          (Complex(..), conjugate, realPart)+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 :: U.Vector Double -> U.Vector Double-{-# INLINE dct #-}+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_ :: U.Vector CD -> U.Vector Double-{-# INLINE dct_ #-}+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 :: U.Vector CD -> U.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@@ -72,17 +77,22 @@ -- 'dct' only up to scale parameter: -- -- > (idct . dct) x = (* length x)-idct :: U.Vector Double -> U.Vector Double-{-# INLINE idct #-}+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_ :: U.Vector CD -> U.Vector Double-{-# INLINE idct_ #-}+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 :: U.Vector CD -> U.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"@@ -90,28 +100,36 @@     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 +    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 :: U.Vector CD -> U.Vector CD+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 :: U.Vector CD -> U.Vector CD+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@@ -142,13 +160,17 @@   len = M.length vec   m   = log2 len ++----------------------------------------------------------------+-- Helpers+----------------------------------------------------------------+ fi :: Int -> CD fi = fromIntegral  halve :: Int -> Int halve = (`shiftR` 1) --vectorOK :: U.Unbox a => U.Vector a -> Bool+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,27 +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 qualified Data.Vector.Unboxed as U (Vector)+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 = U.Vector Double --- | Sample with weights. First element of sample is data, second is weight-type WeightedSample = U.Vector (Double,Double)+----------------------------------------------------------------+-- Data type for confidence level+---------------------------------------------------------------- --- | A function that estimates a property of a sample, such as its--- 'mean'.-type Estimator = Sample -> 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) --- | Weights for affecting the importance of elements of a sample.-type Weights = U.Vector Double+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]
− benchmark/bench.hs 
@@ -1,68 +0,0 @@-import Control.Monad.ST (runST)-import Data.Complex-import qualified Data.Vector.Unboxed as U--import System.Random.MWC-import Criterion.Main--import Statistics.Sample-import Statistics.Transform----- Test sample-sample :: U.Vector Double-sample = runST $ flip uniformVector 10000 =<< create---- Weighted test sample-sampleW :: U.Vector (Double,Double)-sampleW = U.zip sample (U.reverse sample)---- Comlex vector for FFT tests-sampleC :: U.Vector (Complex Double)-sampleC = U.zipWith (:+) sample (U.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-      -- 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   (U.take n sampleC) | n <- fftSizes ]-    , bgroup "ifft"-      [ bench  (show n) $ whnf ifft  (U.take n sampleC) | n <- fftSizes ]-    , bgroup "dct"-      [ bench  (show n) $ whnf dct   (U.take n sample)  | n <- fftSizes ]-    , bgroup "dct_"-      [ bench  (show n) $ whnf dct_  (U.take n sampleC) | n <- fftSizes ]-    , bgroup "idct"-      [ bench  (show n) $ whnf idct  (U.take n sample)  | n <- fftSizes ]-    , bgroup "idct_"-      [ bench  (show n) $ whnf idct_ (U.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
@@ -4,11 +4,12 @@ import Statistics.Sample.KernelDensity (kde) import Text.Hastache (MuType(..), defaultConfig, hastacheFile) import Text.Hastache.Context (mkStrContext)-import qualified Data.Attoparsec as B-import qualified Data.Attoparsec.Char8 as A+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@@ -20,4 +21,4 @@   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)-  L.writeFile "kde.html" s+  TL.writeFile "kde.html" s
statistics.cabal view
@@ -1,5 +1,8 @@+cabal-version:  3.0+build-type:     Simple+ name:           statistics-version:        0.10.5.2+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@@ -15,141 +18,224 @@   .   * Computing with sample data: quantile estimation, kernel density     estimation, histograms, bootstrap methods, significance testing,-    and autocorrelation analysis.+    and regression and autocorrelation analysis.   .   * Random variate generation under several different distributions.   .   * Common statistical tests for significant differences between     samples. -license:        BSD3+license:        BSD-2-Clause license-file:   LICENSE-homepage:       https://github.com/bos/statistics-bug-reports:    https://github.com/bos/statistics/issues-author:         Bryan O'Sullivan <bos@serpentine.com>-maintainer:     Bryan O'Sullivan <bos@serpentine.com>-copyright:      2009, 2010, 2011 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.8+ extra-source-files:-  ChangeLog   README.markdown-  benchmark/bench.hs   examples/kde/KDE.hs   examples/kde/data/faithful.csv   examples/kde/kde.html   examples/kde/kde.tpl-  tests/Tests/Math/gen.py-  tests/Tests/Math/Tables.hs   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.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.Math-    Statistics.Math.RootFinding     Statistics.Quantile+    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.NonParametric+    Statistics.Test.Bartlett+    Statistics.Test.Levene     Statistics.Test.ChiSquared     Statistics.Test.KolmogorovSmirnov+    Statistics.Test.KruskalWallis     Statistics.Test.MannWhitneyU-    Statistics.Test.WilcoxonT+--    Statistics.Test.Runs+    Statistics.Test.StudentT     Statistics.Test.Types+    Statistics.Test.WilcoxonT     Statistics.Transform     Statistics.Types   other-modules:     Statistics.Distribution.Poisson.Internal-    Statistics.Function.Comparison     Statistics.Internal     Statistics.Test.Internal-  build-depends:-    base < 5,-    binary >= 0.6.3.0,-    deepseq >= 1.1.0.2,-    erf,-    monad-par         >= 0.3.4,-    mwc-random        >= 0.13.0.0,-    math-functions    >= 0.1.2,-    primitive         >= 0.3,-    vector            >= 0.7.1,-    vector-algorithms >= 0.4,-    vector-binary-instances >= 0.2.1+    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:       ghc-prim-  if impl(ghc >= 6.10)-    build-depends:-      base >= 4--  -- gather extensive profiling data for now-  ghc-prof-options: -auto-all--  ghc-options: -O2 -Wall -funbox-strict-fields-  if impl(ghc >= 6.8)-    ghc-options: -fwarn-tabs+  ghc-options: -O2 -Wall -fwarn-tabs -funbox-strict-fields -test-suite tests+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.Helpers+    Tests.ExactDistribution     Tests.Function-    Tests.NonparametricTest-    Tests.NonparametricTest.Table-    Tests.Transform+    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+    -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 +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,-    ieee754 >= 0.7.3,-    HUnit,-    QuickCheck >= 2,-    test-framework,-    test-framework-quickcheck2,-    test-framework-hunit,-    math-functions,-    mwc-random,-    statistics,-    primitive,-    vector,-    vector-algorithms,-    erf+            base       -any+          , statistics -any+          , doctest    >=0.15 && <0.25 -source-repository head-  type:     git-  location: https://github.com/bos/statistics+-- 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 -source-repository head-  type:     mercurial-  location: https://bitbucket.org/bos/statistics+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
@@ -1,68 +1,72 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE ScopedTypeVariables  #-}--- Required for Param-{-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE OverlappingInstances #-}-{-# LANGUAGE ViewPatterns #-}-module Tests.Distribution (-    distributionTests-  ) where--import Control.Applicative-import Control.Exception+{-# LANGUAGE FlexibleInstances, ScopedTypeVariables,+    ViewPatterns #-}+module Tests.Distribution (tests) where -import Data.List     (find)+import qualified Control.Exception as E+import Data.List (find) import Data.Typeable (Typeable)--import qualified Numeric.IEEE    as IEEE--import Test.Framework                       (Test,testGroup)-import Test.Framework.Providers.QuickCheck2 (testProperty)-import Test.QuickCheck         as QC-import Test.QuickCheck.Monadic as QC-import Text.Printf-+import Data.Word+import Numeric.MathFunctions.Constants (m_tiny,m_huge,m_epsilon)+import Numeric.MathFunctions.Comparison import Statistics.Distribution-import Statistics.Distribution.Beta-import Statistics.Distribution.Binomial-import Statistics.Distribution.ChiSquared+import Statistics.Distribution.Beta           (BetaDistribution)+import Statistics.Distribution.Binomial       (BinomialDistribution) import Statistics.Distribution.CauchyLorentz-import Statistics.Distribution.Exponential-import Statistics.Distribution.FDistribution-import Statistics.Distribution.Gamma+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.Normal-import Statistics.Distribution.Poisson+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-import Statistics.Distribution.Uniform--import Prelude hiding (catch)--import Tests.Helpers+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-distributionTests :: Test-distributionTests = testGroup "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 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   ] @@ -70,42 +74,47 @@ -- Tests ---------------------------------------------------------------- --- Tests for continous distribution-contDistrTests :: (Param d, ContDistr d, QC.Arbitrary d, Typeable d, Show d) => T d -> Test+-- 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-  , testProperty "Quantile is CDF inverse" $ quantileIsInvCDF   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 -> Test+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 probabilty check" $ logProbabilityCheck   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 -> [Test]+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-  , testProperty "CDF limit at -inf"    $ cdfLimitAtNegInfinity  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 +cdfSanityCheck _ d x = c >= 0 && c <= 1   where c = cumulative d x  -- CDF never decreases@@ -113,116 +122,168 @@ cdfIsNondecreasing _ d = monotonicallyIncreasesIEEE $ cumulative d  -- cumulative d +∞ = 1-cdfAtPosInfinity :: (Param d, Distribution d) => T d -> d -> Bool+cdfAtPosInfinity :: (Distribution d) => T d -> d -> Bool cdfAtPosInfinity _ d   = cumulative d (1/0) == 1  -- cumulative d - ∞ = 0-cdfAtNegInfinity :: (Param d, Distribution d) => T d -> d -> Bool+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 -> Property-cdfLimitAtPosInfinity _ d =-  okForInfLimit d ==> printTestCase ("Last elements: " ++ show (drop 990 probs))-                    $ Just 1.0 == (find (>=1) probs)+cdfLimitAtPosInfinity :: (Param d, Distribution d) => T d -> d -> Bool+cdfLimitAtPosInfinity _ d+  = Just 1.0 == find (>=1) probs   where-    probs = take 1000 $ map (cumulative d) $ iterate (*1.4) 1000+    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 -> Property-cdfLimitAtNegInfinity _ d =-  okForInfLimit d ==> printTestCase ("Last elements: " ++ show (drop 990 probs))-                    $ case find (< IEEE.epsilon) probs of-                        Nothing -> False-                        Just p  -> p >= 0+cdfLimitAtNegInfinity :: (Param d, Distribution d) => T d -> d -> Bool+cdfLimitAtNegInfinity _ d+  = Just 0 == find (<=0) probs   where-    probs = take 1000 $ map (cumulative d) $ iterate (*1.4) (-1)+    probs = map (cumulative d)+          $ takeWhile (> (-m_huge/2))+          $ iterate (*1.4) (-1) + -- CDF's complement is implemented correctly-cdfComplementIsCorrect :: (Distribution d) => T d -> d -> Double -> Bool-cdfComplementIsCorrect _ d x = (eq 1e-14) 1 (cumulative d x + complCumulative d x)+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 :: (DiscreteDistr d) => T d -> d -> Property+cdfDiscreteIsCorrect :: (Param d, DiscreteDistr d) => T d -> d -> Property cdfDiscreteIsCorrect _ d-  = printTestCase (unlines badN)-  $ null badN  +  = counterexample (unlines badN)+  $ null badN   where     -- We are checking that:     --     -- > CDF(i) - CDF(i-e) = P(i)     ---    -- Apporixmate equality is tricky here. Scale is set by maximum-    -- value of CDF and probability. Case when all proabilities are-    -- zero should be trated specially.+    -- 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-           ,  not (p == 0 && p1 == 0 && dp == 0)-           && relerr > 1e-14+           , p  > m_tiny || p == 0+           , p1 > m_tiny+           , dp > m_tiny+           , relerr > tol            ]+    tol = prec_discreteCDF d -logDensityCheck :: (ContDistr d) => T d -> d -> Double -> Property+logDensityCheck :: (Param d, ContDistr d) => T d -> d -> Double -> Property logDensityCheck _ d x-  = printTestCase (printf "density    = %g" p)-  $ printTestCase (printf "logDensity = %g" logP)-  $ printTestCase (printf "log p      = %g" (log p))-  $ printTestCase (printf "eps        = %g" (abs (logP - log p) / max (abs (log p)) (abs logP)))-  $ or [ p == 0     && logP == (-1/0)-       , p < 1e-308 && logP < 609-       , eq 1e-14 (log p) logP-       ]+  = 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+    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 -> Double -> Property-quantileIsInvCDF _ d (snd . properFraction -> p) =-  p > 0 && p < 1  ==> ( printTestCase (printf "Quantile     = %g" q )-                      $ printTestCase (printf "Probability  = %g" p )-                      $ printTestCase (printf "Probability' = %g" p')-                      $ printTestCase (printf "Error        = %e" (abs $ p - p'))-                      $ abs (p - p') < invQuantilePrec d-                      )+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-    q  = quantile   d p-    p' = cumulative d q+    -- 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 $ catch-                                              (do { return $! quantile d p; return False })-                                              (\(e :: SomeException) -> return True)+  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 +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-  = printTestCase (printf "CDF   = %g" p1)-  $ printTestCase (printf "Sum   = %g" p2)-  $ printTestCase (printf "Delta = %g" (abs (p1 - p2)))+  = 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 differeneces. Otherwise there is to much to sum+  -- Avoid too large differences. Otherwise there is to much to sum   ---  -- Absolute difference is used guard againist precision loss when+  -- Absolute difference is used guard against precision loss when   -- close values of CDF are subtracted   where     n  = min a b@@ -230,105 +291,106 @@     p1 = cumulative d (fromIntegral m + 0.5) - cumulative d (fromIntegral n - 0.5)     p2 = sum $ map (probability d) [n .. m] -logProbabilityCheck :: (DiscreteDistr d) => T d -> d -> Int -> Property+logProbabilityCheck :: (Param d, DiscreteDistr d) => T d -> d -> Int -> Property logProbabilityCheck _ d x-  = printTestCase (printf "probability    = %g" p)-  $ printTestCase (printf "logProbability = %g" logP)-  $ printTestCase (printf "log p          = %g" (log p))-  $ printTestCase (printf "eps            = %g" (abs (logP - log p) / max (abs (log p)) (abs logP)))+  = 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-       , eq 1e-14 (log p) logP+         -- 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---    -------------------------------------------------------------------- Arbitrary instances for ditributions-------------------------------------------------------------------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 GammaDistribution where-  arbitrary = gammaDistr <$> QC.choose (0.1,10) <*> QC.choose (0.1,10)-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 (0,1)-instance QC.Arbitrary GeometricDistribution0 where-  arbitrary = geometric0 <$> QC.choose (0,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 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 CauchyDistribution where-  arbitrary = cauchyDistribution-                <$> arbitrary-                <*> ((abs <$> arbitrary) `suchThat` (> 0))-instance QC.Arbitrary StudentT where-  arbitrary = studentT <$> ((abs <$> arbitrary) `suchThat` (>0))-instance QC.Arbitrary (LinearTransform StudentT) where-  arbitrary = studentTUnstandardized-           <$> ((abs <$> arbitrary) `suchThat` (>0))-           <*> ((abs <$> arbitrary))-           <*> ((abs <$> arbitrary) `suchThat` (>0))-instance QC.Arbitrary FDistribution where-  arbitrary =  fDistribution -           <$> ((abs <$> arbitrary) `suchThat` (>0))-           <*> ((abs <$> arbitrary) `suchThat` (>0))-+    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+-- | Parameters for distribution testing. Some distribution require+--   relaxing parameters a bit class Param a where-  -- Precision for quantileIsInvCDF-  invQuantilePrec :: a -> Double-  invQuantilePrec _ = 1e-14-  -- Distribution is OK for testing limits-  okForInfLimit :: a -> Bool-  okForInfLimit _ = True---instance Param a+  -- | 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-  invQuantilePrec _ = 1e-13-  okForInfLimit   d = studentTndf d > 0.75+  -- FIXME: disabled unless incompleteBeta troubles are sorted out+  quantileIsInvCDF_enabled _ = False -instance Param (LinearTransform StudentT) where-  invQuantilePrec _ = 1e-13-  okForInfLimit   d = (studentTndf . linTransDistr) d > 0.75+instance Param BetaDistribution where+  -- FIXME: See https://github.com/haskell/statistics/issues/161 for details+  quantileIsInvCDF_enabled _ = False  instance Param FDistribution where-  invQuantilePrec _ = 1e-12+  -- 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 :: Test+unitTests :: TestTree unitTests = testGroup "Unit tests"   [ testAssertion "density (gammaDistr 150 1/150) 1 == 4.883311" $-      4.883311418525483 =~ (density (gammaDistr 150 (1/150)) 1)+      4.883311418525483 =~ density (gammaDistr 150 (1/150)) 1     -- Student-T   , testStudentPDF 0.3  1.34  0.0648215  -- PDF   , testStudentPDF 1    0.42  0.27058
+ 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
@@ -1,18 +1,14 @@ module Tests.Function ( tests ) where -import qualified Data.Vector.Unboxed as U-import           Data.Vector.Unboxed   ((!))-+import Statistics.Function+import Test.Tasty+import Test.Tasty.QuickCheck import Test.QuickCheck-import Test.Framework-import Test.Framework.Providers.QuickCheck2- import Tests.Helpers-import Statistics.Function-+import qualified Data.Vector.Unboxed as U  -tests :: Test+tests :: TestTree tests = testGroup "S.Function"   [ testProperty  "Sort is sort"                p_sort   , testAssertion "nextHighestPowerOfTwo is OK" p_nextHighestPowerOfTwo@@ -29,5 +25,5 @@ p_nextHighestPowerOfTwo   = all (\(good, is) -> all ((==good) . nextHighestPowerOfTwo) is) lists   where-    pows  = [1 .. 17]+    pows  = [1 .. 17 :: Int]     lists = [ (2^m, [2^n+1 .. 2^m]) | (n,m) <- pows `zip` tail pows ]
tests/Tests/Helpers.hs view
@@ -1,35 +1,31 @@+{-# LANGUAGE ScopedTypeVariables #-} -- | Helpers for testing module Tests.Helpers (     -- * helpers     T(..)   , typeName-  , eq-  , eqC-  , (=~)+  , Double01(..)+    -- * IEEE 754+  , isDenorm     -- * Generic QC tests   , monotonicallyIncreases   , monotonicallyIncreasesIEEE     -- * HUnit helpers   , testAssertion   , testEquality+    -- * QC helpers+  , small+  , unsquare+  , shrinkFixedList   ) where -import Data.Complex import Data.Typeable--import qualified Numeric.IEEE    as IEEE--import qualified Test.HUnit      as HU-import Test.Framework-import Test.Framework.Providers.HUnit--import Numeric.MathFunctions.Constants----------------------------------------------------------------------- Helpers-----------------------------------------------------------------+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@@ -41,31 +37,17 @@     typeParam :: T a -> a     typeParam _ = undefined --- | Approximate equality for 'Double'. Doesn't work well for numbers---   which are almost zero.-eq :: Double                    -- ^ Relative error-   -> Double -> Double -> Bool-eq eps a b -  | a == 0 && b == 0 = True-  | otherwise        = abs (a - b) <= eps * max (abs a) (abs b)---- | Approximate equality for 'Complex Double'-eqC :: Double                   -- ^ Relative error-    -> Complex Double-    -> Complex Double-    -> Bool-eqC 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)----- | Approximately equal up to 1 ulp-(=~) :: Double -> Double -> Bool-(=~) = eq m_epsilon+-- | 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@@ -78,8 +60,8 @@ -- Check that function is nondecreasing taking rounding errors into -- account. ----- In fact funstion is allowed to decrease less than one ulp in order--- to guard againist problems with excess precision. On x86 FPU works+-- 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@@ -93,8 +75,19 @@ -- HUnit helpers ---------------------------------------------------------------- -testAssertion :: String -> Bool -> Test+testAssertion :: String -> Bool -> TestTree testAssertion str cont = testCase str $ HU.assertBool str cont -testEquality :: (Show a, Eq a) => String -> a -> a -> Test+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
@@ -1,41 +1,39 @@ -- | Tests for Kernel density estimates.-module Tests.KDE ( -  tests +module Tests.KDE (+  tests   )where -import Data.Vector.Unboxed ((!))-import qualified Data.Vector.Unboxed as U--import Test.Framework                       (Test, testGroup)-import Test.Framework.Providers.QuickCheck2 (testProperty)-import Test.QuickCheck                      -import Text.Printf-+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 :: Test+tests :: TestTree tests = testGroup "KDE"   [ testProperty "integral(PDF) == 1" t_densityIsPDF   ]  t_densityIsPDF :: [Double] -> Property-t_densityIsPDF vec +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 = printTestCase (printf "Integral %f" integral)+    test = counterexample (printf "Integral %f" integral)          $ abs (1 - integral) <= 1e-3 -           + integratePDF :: Double -> U.Vector Double -> Double-integratePDF step vec -  = step * U.sum (U.zipWith (*) vec weights)+integratePDF step vec+  = step * sumVector kbn (U.zipWith (*) vec weights)   where     n       = U.length vec     weights = U.generate n go
− tests/Tests/Math/Tables.hs 
@@ -1,47 +0,0 @@-module Tests.Math.Tables where--tableLogGamma :: [(Double,Double)]-tableLogGamma =-  [(0.000001250000000, 13.592366285131769033)-  , (0.000068200000000, 9.5930266308318756785)-  , (0.000246000000000, 8.3100370767447966358)-  , (0.000880000000000, 7.03508133735248542)-  , (0.003120000000000, 5.768129358365567505)-  , (0.026700000000000, 3.6082588918892977148)-  , (0.077700000000000, 2.5148371858768232556)-  , (0.234000000000000, 1.3579557559432759994)-  , (0.860000000000000, 0.098146578027685615897)-  , (1.340000000000000, -0.11404757557207759189)-  , (1.890000000000000, -0.0425116422978701336)-  , (2.450000000000000, 0.25014296569217625565)-  , (3.650000000000000, 1.3701041997380685178)-  , (4.560000000000000, 2.5375143317949580002)-  , (6.660000000000000, 5.9515377269550207018)-  , (8.250000000000000, 9.0331869196051233217)-  , (11.300000000000001, 15.814180681373947834)-  , (25.600000000000001, 56.711261598328121636)-  , (50.399999999999999, 146.12815158702164808)-  , (123.299999999999997, 468.85500075897556371)-  , (487.399999999999977, 2526.9846647543727158)-  , (853.399999999999977, 4903.9359135978220365)-  , (2923.300000000000182, 20402.93198938705973)-  , (8764.299999999999272, 70798.268343590112636)-  , (12630.000000000000000, 106641.77264982508495)-  , (34500.000000000000000, 325976.34838781820145)-  , (82340.000000000000000, 849629.79603036714252)-  , (234800.000000000000000, 2668846.4390507959761)-  , (834300.000000000000000, 10540830.912557534873)-  , (1230000.000000000000000, 16017699.322315014899)-  ]-tableIncompleteBeta :: [(Double,Double,Double,Double)]-tableIncompleteBeta =-  [(2.000000000000000, 3.000000000000000, 0.030000000000000, 0.0051864299999999996862)-  , (2.000000000000000, 3.000000000000000, 0.230000000000000, 0.22845923000000001313)-  , (2.000000000000000, 3.000000000000000, 0.760000000000000, 0.95465728000000005249)-  , (4.000000000000000, 2.300000000000000, 0.890000000000000, 0.93829812158347802864)-  , (1.000000000000000, 1.000000000000000, 0.550000000000000, 0.55000000000000004441)-  , (0.300000000000000, 12.199999999999999, 0.110000000000000, 0.95063000053947077639)-  , (13.100000000000000, 9.800000000000001, 0.120000000000000, 1.3483109941962659385e-07)-  , (13.100000000000000, 9.800000000000001, 0.420000000000000, 0.071321857831804780226)-  , (13.100000000000000, 9.800000000000001, 0.920000000000000, 0.99999578339197081611)-  ]
− tests/Tests/Math/gen.py 
@@ -1,51 +0,0 @@-#!/usr/bin/python-"""-"""--from mpmath import *--def printListLiteral(lines) :-    print "  [" + "\n  , ".join(lines) + "\n  ]"--################################################################-# Generate header-print "module Tests.Math.Tables where"-print--################################################################-## Generate table for logGamma-print "tableLogGamma :: [(Double,Double)]"-print "tableLogGamma ="--gammaArg = [ 1.25e-6, 6.82e-5, 2.46e-4, 8.8e-4,  3.12e-3, 2.67e-2,-             7.77e-2, 0.234,   0.86,    1.34,    1.89,    2.45,-             3.65,    4.56,    6.66,    8.25,    11.3,    25.6,-             50.4,    123.3,   487.4,   853.4,   2923.3,  8764.3,-             1.263e4, 3.45e4,  8.234e4, 2.348e5, 8.343e5, 1.23e6,-             ]-printListLiteral(-    [ '(%.15f, %.20g)' % (x, log(gamma(x))) for x in gammaArg ]-    )---################################################################-## Generate table for incompleteBeta--print "tableIncompleteBeta :: [(Double,Double,Double,Double)]"-print "tableIncompleteBeta ="--incompleteBetaArg = [-    (2,    3,    0.03),-    (2,    3,    0.23),-    (2,    3,    0.76),-    (4,    2.3,  0.89),-    (1,    1,    0.55),-    (0.3,  12.2, 0.11),-    (13.1, 9.8,  0.12),-    (13.1, 9.8,  0.42),-    (13.1, 9.8,  0.92),-    ]-printListLiteral(-    [ '(%.15f, %.15f, %.15f, %.20g)' % (p,q,x, betainc(p,q,0,x, regularized=True))-      for (p,q,x) in incompleteBetaArg-      ])
+ 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/NonparametricTest.hs 
@@ -1,233 +0,0 @@--- Tests for Statistics.Test.NonParametric-module Tests.NonparametricTest (-  nonparametricTests-  ) where---import qualified Data.Vector.Unboxed as U-import Test.HUnit                     (assertEqual)-import Test.Framework-import Test.Framework.Providers.HUnit--import Statistics.Test.MannWhitneyU-import Statistics.Test.WilcoxonT--import Tests.Helpers-import Tests.NonparametricTest.Table--import Statistics.Test.KolmogorovSmirnov-import Statistics.Distribution.Normal    (standard)----nonparametricTests :: Test-nonparametricTests = testGroup "Nonparametric tests"-                   $ concat [ mannWhitneyTests-                            , wilcoxonSumTests-                            , wilcoxonPairTests-                            , kolmogorovSmirnovDTest-                            ]--------------------------------------------------------------------mannWhitneyTests :: [Test]-mannWhitneyTests = zipWith test [(0::Int)..] testData ++-  [ testEquality "Mann-Whitney U Critical Values, m=1"-      (replicate (20*3) Nothing)-      [mannWhitneyUCriticalValue (1,x) 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) 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) 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) 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 TwoTailed (length a, length b) 0.05 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 :: [Test]-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 :: [Test]-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 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 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 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 0.005 | x <- [1..27]]-  ]-  where-    test n (a, b, c) = testEquality ("Wilcoxon Paired " ++ show n) c res-      where res = (wilcoxonMatchedPairSignedRank (U.fromList a) (U.fromList b))--    -- List of (Sample A, Sample B, (Positive Rank, Negative Rank))-    testData :: [([Double], [Double], (Double, Double))]-    testData = [ ([1..10], [1..10], (0, 0     ))-               , ([1..5],  [6..10], (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]-                 , ( 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]-                 , (18, -3)-                 )-               , ( [130,170,125,170,130,130,145,160]-                 , [120,163,120,135,143,136,144,120]-                 , (27, -9)-                 )-               , ( [540,580,600,680,430,740,600,690,605,520]-                 , [760,710,1105,880,500,990,1050,640,595,520]-                 , (3, -42)-                 )-               ]-    to4dp tgt x = x >= tgt - 0.00005 && x < tgt + 0.00005----------------------------------------------------------------------- K-S test--------------------------------------------------------------------kolmogorovSmirnovDTest :: [Test]-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   )-      ]
− tests/Tests/NonparametricTest/Table.hs 
@@ -1,36 +0,0 @@-module Tests.NonparametricTest.Table 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
@@ -6,27 +6,23 @@       tests     ) where -import Data.Bits             ((.&.), shiftL)-import Data.Complex          (Complex((:+)))-import Data.Functor          ((<$>))-import Statistics.Function   (within)-import Statistics.Transform--import Test.Framework                       (Test, testGroup)-import Test.Framework.Providers.QuickCheck2 (testProperty)-import Test.QuickCheck                      (Positive(..),Property,Arbitrary(..),Gen,choose,vectorOf,-                                             printTestCase, quickCheck)--import Text.Printf-+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 -import Tests.Helpers ---tests :: Test+tests :: TestTree tests = testGroup "fft" [           testProperty "t_impulse"        t_impulse         , testProperty "t_impulse_offset" t_impulse_offset@@ -64,7 +60,7 @@ -- 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) = G.all (c_near i) (fft v)+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)@@ -72,8 +68,11 @@ -- 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 -> Bool-t_impulse_offset k (Positive x) (Positive m) = G.all ok (fft v)+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@@ -87,29 +86,29 @@ -- 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 = do-  x <- genFftVector-  let n  = G.length x-      x' = roundtrip x-      d  = G.zipWith (-) x x'-      nd = vectorNorm d-      nx = vectorNorm x-  id $ printTestCase "Original vector"-     $ printTestCase (show x )-     $ printTestCase "Transformed one"-     $ printTestCase (show x')-     $ printTestCase (printf "Length = %i" n)-     $ printTestCase (printf "|x - x'| / |x| = %.6g" (nd / nx))+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] -> Test+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] -> Test+testIDCT :: [Double] -> [Double] -> TestTree testIDCT (U.fromList -> vec) (U.fromList -> res)   = testAssertion ("IDCT test for " ++ show vec)   $ vecEqual 3e-14 (idct vec) res@@ -138,10 +137,10 @@   vectorNorm :: a -> Double  instance HasNorm (U.Vector Double) where-  vectorNorm = sqrt . U.sum . U.map (\x -> x*x)+  vectorNorm = sqrt . sumVector kbn . U.map (\x -> x*x)  instance HasNorm (U.Vector CD) where-  vectorNorm = sqrt . U.sum . U.map (\(x :+ y) -> x*x + y*y)+  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
+ tests/doctest.hs view
@@ -0,0 +1,5 @@+import Test.DocTest (doctest)++main :: IO ()+main = doctest ["-XHaskell2010", "Statistics"]+
tests/tests.hs view
@@ -1,15 +1,26 @@-import Test.Framework       (defaultMain)+import Test.Tasty (defaultMain,testGroup) -import Tests.Distribution-import Tests.NonparametricTest-import qualified Tests.Transform+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 [ distributionTests -                   , nonparametricTests-                   , Tests.Transform.tests-                   , Tests.Function.tests-                   , Tests.KDE.tests-                   ]+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+  ]