packages feed

statistics 0.13.3.0 → 0.16.5.0

raw patch · 82 files changed

Files

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/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
@@ -6,9 +6,11 @@ module Statistics.Correlation     ( -- * Pearson correlation       pearson+    , pearson2     , pearsonMatByRow       -- * Spearman correlation     , spearman+    , spearman2     , spearmanMatByRow     ) where @@ -23,13 +25,21 @@ -- Pearson ---------------------------------------------------------------- --- | Pearson correlation for sample of pairs.-pearson :: (G.Vector v (Double, Double), G.Vector v Double)+-- | 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 #-} --- | Compute pairwise pearson correlation between rows of a matrix+-- | 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)@@ -42,15 +52,13 @@ -- Spearman ---------------------------------------------------------------- --- | compute spearman correlation between two samples+-- | 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 Double-            , G.Vector v (Double, Double)             , G.Vector v (Int, a)             , G.Vector v (Int, b)             )@@ -63,7 +71,28 @@     (x, y) = G.unzip xy {-# INLINE spearman #-} --- | compute pairwise spearman correlation between rows of a matrix+-- | 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
Statistics/Correlation/Kendall.hs view
@@ -1,11 +1,11 @@-{-# LANGUAGE BangPatterns, CPP, FlexibleContexts #-}+{-# 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 implementes Kendall's tau form b which allows ties in the data.+-- 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)}}@@ -130,11 +130,6 @@         _  -> do GM.unsafeWrite src iIns eLow                  wroteLow low (iLow+1) high iHigh eHigh (iIns+1) {-# INLINE merge #-}--#if !MIN_VERSION_base(4,6,0)-modifySTRef' :: STRef s a -> (a -> a) -> ST s ()-modifySTRef' = modifySTRef-#endif  -- $references --
Statistics/Distribution.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE BangPatterns, ScopedTypeVariables #-} -- | -- Module    : Statistics.Distribution@@ -23,37 +24,37 @@     , 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.Function        (square) import Statistics.Sample.Internal (sum)-import System.Random.MWC (Gen, uniform)+import System.Random.Stateful     (StatefulGen, uniformDouble01M) import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Generic as G   -- | Type class common to all distributions. Only c.d.f. could be--- defined for both discrete and 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     --@@ -63,45 +64,50 @@     -- 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-     -- | Logarithm of probability of n-th outcome     logProbability :: d -> Int -> Double     logProbability d = log . probability d-+    {-# 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--    -- | 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-+    -- | 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@@ -116,11 +122,12 @@ --   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. --@@ -130,7 +137,9 @@     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@@ -151,19 +160,29 @@ -- | 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  data P = P {-# UNPACK #-} !Double {-# UNPACK #-} !Double@@ -203,6 +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 . sum . U.map (probability d) $ U.enumFromTo low hi
Statistics/Distribution/Beta.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} ----------------------------------------------------------------------------- -- |@@ -14,62 +15,118 @@   ( BetaDistribution     -- * Constructor   , betaDistr+  , betaDistrE   , improperBetaDistr+  , improperBetaDistrE     -- * Accessors   , bdAlpha   , bdBeta   ) where -import Data.Aeson (FromJSON, ToJSON)-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 Data.Binary (put, get)-import Control.Applicative ((<$>), (<*>))+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 FromJSON 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 x y) = put x >> put y-    get = BD <$> get <*> get+  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+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+improperBetaDistr a b+  = maybe (error $ errMsgI a b) id $ improperBetaDistrE a b +-- | Create beta distribution. Both shape parameters must be+-- non-negative. So it allows to construct improper beta distribution+-- which could be used as improper prior.+improperBetaDistrE :: Double             -- ^ Shape parameter alpha+                   -> Double             -- ^ Shape parameter beta+                   -> Maybe BetaDistribution+improperBetaDistrE a b+  | a >= 0 && b >= 0 = Just (BD a b)+  | otherwise        = Nothing++errMsgI :: Double -> Double -> String+errMsgI a b+  =  "Statistics.Distribution.Beta.betaDistr: "+  ++ "shape parameters must be non-negative. Got a = " ++ show a+  ++ " b = " ++ show b+++ instance D.Distribution BetaDistribution where   cumulative (BD a b) x     | x <= 0    = 0     | x >= 1    = 1     | otherwise = incompleteBeta a b x+  complCumulative (BD a b) x+    | x <= 0    = 1+    | x >= 1    = 0+    -- For small x we use direct computation to avoid precision loss+    -- when computing (1-x)+    | x <  0.5  = 1 - incompleteBeta a b x+    -- Otherwise we use property of incomplete beta:+    --  > I(x,a,b) = 1 - I(1-x,b,a)+    | otherwise = incompleteBeta b a (1-x)  instance D.Mean BetaDistribution where   mean (BD a b) = a / (a + b)@@ -96,10 +153,15 @@  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+    | 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,4 +171,4 @@         error $ "Statistics.Distribution.Gamma.quantile: p must be in [0,1] range. Got: "++show p  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,21 +20,23 @@       BinomialDistribution     -- * Constructors     , binomial+    , binomialE     -- * Accessors     , bdTrials     , bdProbability     ) where -import Data.Aeson (FromJSON, ToJSON)-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 Data.Binary (put, get)-import Control.Applicative ((<$>), (<*>))+import Statistics.Internal   -- | The binomial distribution.@@ -41,20 +45,37 @@     -- ^ Number of trials.     , bdProbability :: {-# UNPACK #-} !Double     -- ^ Probability.-    } deriving (Eq, Read, Show, Typeable, Data, Generic)+    } deriving (Eq, Typeable, Data, Generic) -instance FromJSON 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 = BD <$> get <*> get+  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@@ -83,9 +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)+    -- 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"@@ -96,6 +138,16 @@   where     k = floor x +complCumulative :: BinomialDistribution -> Double -> Double+complCumulative (BD n p) x+  | isNaN x      = error "Statistics.Distribution.Binomial.complCumulative: NaN input"+  | isInfinite x = if x > 0 then 0 else 1+  | k <  0       = 1+  | k >= n       = 0+  | otherwise    = incompleteBeta (fromIntegral (k+1)) (fromIntegral (n-k)) p+  where+    k = floor x+ mean :: BinomialDistribution -> Double mean (BD n p) = fromIntegral n * p @@ -114,10 +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: "+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,16 +19,18 @@   , cauchyDistribScale     -- * Constructors   , cauchyDistribution+  , cauchyDistributionE   , standardCauchy   ) where -import Data.Aeson (FromJSON, ToJSON)-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 Data.Binary (put, get)-import Control.Applicative ((<$>), (<*>))+import Statistics.Internal  -- | Cauchy-Lorentz distribution. data CauchyDistribution = CD {@@ -40,43 +43,97 @@     --   maximum (HWHM).   , cauchyDistribScale  :: {-# UNPACK #-} !Double   }-  deriving (Eq, Show, Read, Typeable, Data, Generic)+  deriving (Eq, Typeable, Data, Generic) -instance FromJSON CauchyDistribution-instance ToJSON 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 x y) = put x >> put y-    get = CD <$> get <*> get+    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)
Statistics/Distribution/ChiSquared.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} -- | -- Module    : Statistics.Distribution.ChiSquared@@ -13,51 +14,86 @@ -- distributions. It's commonly used in statistical tests module Statistics.Distribution.ChiSquared (           ChiSquared-        -- Constructors-        , chiSquared         , chiSquaredNDF+        -- * Constructors+        , chiSquared+        , chiSquaredE         ) where -import Data.Aeson (FromJSON, ToJSON)-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 Data.Binary (put, get)+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 FromJSON ChiSquared+instance Show ChiSquared where+  showsPrec i (ChiSquared n) = defaultShow1 "chiSquared" n i+instance Read ChiSquared where+  readPrec = defaultReadPrecM1 "chiSquared" chiSquaredE+ instance ToJSON ChiSquared+instance FromJSON ChiSquared where+  parseJSON (Object v) = do+    n <- v .: "chiSquaredNDF"+    maybe (fail $ errMsg n) return $ chiSquaredE n+  parseJSON _ = empty  instance Binary ChiSquared where-    get = fmap ChiSquared get-    put (ChiSquared x) = put x+  put (ChiSquared x) = put x+  get = do n <- get+           maybe (fail $ errMsg n) return $ chiSquaredE n --- | Get number of degrees of freedom-chiSquaredNDF :: ChiSquared -> Int-chiSquaredNDF (ChiSquared ndf) = ndf  -- | 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+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@@ -94,15 +130,6 @@   | otherwise = incompleteGamma (ndf/2) (x/2)   where     ndf = fromIntegral $ chiSquaredNDF chi--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  quantile :: ChiSquared -> Double -> Double quantile (ChiSquared ndf) p
+ Statistics/Distribution/DiscreteUniform.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, OverloadedStrings #-}+-- |+-- Module    : Statistics.Distribution.DiscreteUniform+-- Copyright : (c) 2016 André Szabolcs Szelp+-- License   : BSD3+--+-- Maintainer  : a.sz.szelp@gmail.com+-- Stability   : experimental+-- Portability : portable+--+-- The discrete uniform distribution. There are two parametrizations of+-- this distribution. First is the probability distribution on an+-- inclusive interval {1, ..., n}. This is parametrized with n only,+-- where p_1, ..., p_n = 1/n. ('discreteUniform').+--+-- The second parametrization is the uniform distribution on {a, ..., b} with+-- probabilities p_a, ..., p_b = 1/(a-b+1). This is parametrized with+-- /a/ and /b/. ('discreteUniformAB')++module Statistics.Distribution.DiscreteUniform+    (+      DiscreteUniform+    -- * Constructors+    , discreteUniform+    , discreteUniformAB+    -- * Accessors+    , rangeFrom+    , rangeTo+    ) where++import Control.Applicative (empty)+import Data.Aeson   (FromJSON(..), ToJSON, Value(..), (.:))+import Data.Binary  (Binary(..))+import Data.Data    (Data, Typeable)+import System.Random.Stateful (uniformRM)+import GHC.Generics (Generic)++import qualified Statistics.Distribution as D+import Statistics.Internal++++-- | The discrete uniform distribution.+data DiscreteUniform = U {+      rangeFrom  :: {-# UNPACK #-} !Int+    -- ^ /a/, the lower bound of the support {a, ..., b}+    , rangeTo    :: {-# UNPACK #-} !Int+    -- ^ /b/, the upper bound of the support {a, ..., b}+    } deriving (Eq, Typeable, Data, Generic)++instance Show DiscreteUniform where+  showsPrec i (U a b) = defaultShow2 "discreteUniformAB" a b i+instance Read DiscreteUniform where+  readPrec = defaultReadPrecM2 "discreteUniformAB" (\a b -> Just (discreteUniformAB a b))++instance ToJSON   DiscreteUniform+instance FromJSON DiscreteUniform where+  parseJSON (Object v) = do+    a <- v .: "uniformA"+    b <- v .: "uniformB"+    return $ discreteUniformAB a b+  parseJSON _ = empty++instance Binary DiscreteUniform where+  put (U a b) = put a >> put b+  get         = discreteUniformAB <$> get <*> get++instance D.Distribution DiscreteUniform where+  cumulative (U a b) x+    | x < fromIntegral a = 0+    | x > fromIntegral b = 1+    | otherwise = fromIntegral (floor x - a + 1) / fromIntegral (b - a + 1)++instance D.DiscreteDistr DiscreteUniform where+  probability (U a b) k+    | k >= a && k <= b = 1 / fromIntegral (b - a + 1)+    | otherwise        = 0++instance D.Mean DiscreteUniform where+  mean (U a b) = fromIntegral (a+b)/2++instance D.Variance DiscreteUniform where+  variance (U a b) = (fromIntegral (b - a + 1)^(2::Int) - 1) / 12++instance D.MaybeMean DiscreteUniform where+  maybeMean = Just . D.mean++instance D.MaybeVariance DiscreteUniform where+  maybeStdDev   = Just . D.stdDev+  maybeVariance = Just . D.variance++instance D.Entropy DiscreteUniform where+  entropy (U a b) = log $ fromIntegral $ b - a + 1++instance D.MaybeEntropy DiscreteUniform where+  maybeEntropy = Just . D.entropy++instance D.ContGen DiscreteUniform where+  genContVar d = fmap fromIntegral . D.genDiscreteVar d++instance D.DiscreteGen DiscreteUniform where+  genDiscreteVar (U a b) = uniformRM (a,b)++-- | Construct discrete uniform distribution on support {1, ..., n}.+--   Range /n/ must be >0.+discreteUniform :: Int             -- ^ Range+                -> DiscreteUniform+discreteUniform n+  | n < 1     = error $ msg ++ "range must be > 0. Got " ++ show n+  | otherwise = U 1 n+  where msg = "Statistics.Distribution.DiscreteUniform.discreteUniform: "++-- | Construct discrete uniform distribution on support {a, ..., b}.+discreteUniformAB :: Int             -- ^ Lower boundary (inclusive)+                  -> Int             -- ^ Upper boundary (inclusive)+                  -> DiscreteUniform+discreteUniformAB a b+  | b < a     = U b a+  | otherwise = U a b
Statistics/Distribution/Exponential.hs view
@@ -1,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,33 +20,47 @@       ExponentialDistribution     -- * Constructors     , exponential-    , exponentialFromSample+    , exponentialE     -- * Accessors     , edLambda     ) where -import Data.Aeson (FromJSON, ToJSON)-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 Data.Binary (put, get)+import Statistics.Internal  + newtype ExponentialDistribution = ED {       edLambda :: Double-    } deriving (Eq, Read, Show, Typeable, Data, Generic)+    } deriving (Eq, Typeable, Data, Generic) -instance FromJSON 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 = fmap ED get+  put = put . edLambda+  get = do+    l <- get+    maybe (fail $ errMsg l) return $ exponentialE l  instance D.Distribution ExponentialDistribution where     cumulative      = cumulative@@ -57,7 +73,8 @@     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@@ -83,7 +100,7 @@  cumulative :: ExponentialDistribution -> Double -> Double cumulative (ED l) x | x <= 0    = 0-                    | otherwise = 1 - exp (-l * x)+                    | otherwise = - expm1 (-l * x)  complCumulative :: ExponentialDistribution -> Double -> Double complCumulative (ED l) x | x <= 0    = 1@@ -92,20 +109,35 @@  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  -- | Create an exponential distribution. 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+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+-- | 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,49 +12,90 @@ -- Fisher F distribution module Statistics.Distribution.FDistribution (     FDistribution+    -- * Constructors   , fDistribution+  , fDistributionE+  , fDistributionReal+  , fDistributionRealE+    -- * Accessors   , fDistributionNDF1   , fDistributionNDF2   ) where -import Data.Aeson (FromJSON, ToJSON)-import Data.Binary (Binary)-import Data.Data (Data, Typeable)+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 GHC.Generics (Generic)+ import qualified Statistics.Distribution as D import Statistics.Function (square)-import Numeric.SpecFunctions (-  logBeta, incompleteBeta, invIncompleteBeta, digamma)-import Data.Binary (put, get)-import Control.Applicative ((<$>), (<*>))+import Statistics.Internal + -- | F distribution data FDistribution = F { fDistributionNDF1 :: {-# UNPACK #-} !Double                        , fDistributionNDF2 :: {-# UNPACK #-} !Double                        , _pdfFactor        :: {-# UNPACK #-} !Double                        }-                   deriving (Eq, Show, Read, Typeable, Data, Generic)+                   deriving (Eq, Typeable, Data, Generic) -instance FromJSON 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-    get = F <$> get <*> get <*> get-    put (F x y z) = put x >> put y >> put z+  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@@ -67,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)@@ -106,4 +176,4 @@   maybeEntropy = Just . D.entropy  instance D.ContGen FDistribution where-  genContVar = D.genContinous+  genContVar = D.genContinuous
Statistics/Distribution/Gamma.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} -- | -- Module    : Statistics.Distribution.Gamma@@ -19,55 +20,106 @@       GammaDistribution     -- * Constructors     , gammaDistr+    , gammaDistrE     , improperGammaDistr+    , improperGammaDistrE     -- * Accessors     , gdShape     , gdScale     ) where -import Data.Aeson (FromJSON, ToJSON)-import Control.Applicative ((<$>), (<*>))-import Data.Binary (Binary)-import Data.Binary (put, get)-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 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 qualified System.Random.MWC.Distributions as MWC+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 FromJSON 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 = GD <$> get <*> get+  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: "+  = 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+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 @@ -75,7 +127,11 @@     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
Statistics/Distribution/Geometric.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} -- | -- Module    : Statistics.Distribution.Geometric@@ -24,47 +25,67 @@     , GeometricDistribution0     -- * Constructors     , geometric+    , geometricE     , geometric0+    , geometric0E     -- ** Accessors     , gdSuccess     , gdSuccess0     ) where -import Data.Aeson (FromJSON, ToJSON)-import Control.Applicative ((<$>))-import Control.Monad (liftM)-import Data.Binary (Binary)-import Data.Binary (put, get)-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 FromJSON 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-    get = GD <$> get-    put (GD x) = put x+  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@@ -82,9 +103,8 @@  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@@ -95,38 +115,70 @@ instance D.ContGen GeometricDistribution where   genContVar d g = fromIntegral `liftM` D.genDiscreteVar d g --- | 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- 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)+  | 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 FromJSON 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-    get = GD0 <$> get-    put (GD0 x) = put x+  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)@@ -157,10 +209,18 @@ instance D.ContGen GeometricDistribution0 where   genContVar d g = fromIntegral `liftM` D.genDiscreteVar d g + -- | 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+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,40 +22,60 @@       HypergeometricDistribution     -- * Constructors     , hypergeometric+    , hypergeometricE     -- ** Accessors     , hdM     , hdL     , hdK     ) where -import Data.Aeson (FromJSON, ToJSON)-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 Data.Binary (put, get)-import Control.Applicative ((<$>), (<*>))+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 FromJSON 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-    get = HD <$> get <*> get <*> get-    put (HD x y z) = put x >> put y >> put z+  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@@ -86,11 +107,11 @@ mean (HD m l k) = fromIntegral k * fromIntegral m / fromIntegral l  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/@@ -98,20 +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: "+  = 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+    -- 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"@@ -119,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
@@ -1,3 +1,5 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} -- | -- Module    : Statistics.Distribution.Laplace@@ -15,28 +17,27 @@ -- recognition and least absolute deviations method (Laplace's first -- law of errors, giving a robust regression method) --- module Statistics.Distribution.Laplace     (       LaplaceDistribution     -- * Constructors     , laplace-    , laplaceFromSample+    , laplaceE     -- * Accessors     , ldLocation     , ldScale     ) where -import Data.Aeson (FromJSON, ToJSON)-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 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.Types (Sample)-import Control.Applicative ((<$>), (<*>))+import Statistics.Internal   data LaplaceDistribution = LD {@@ -44,14 +45,27 @@     -- ^ Location.     , ldScale    :: {-# UNPACK #-} !Double     -- ^ Scale.-    } deriving (Eq, Read, Show, Typeable, Data, Generic)+    } deriving (Eq, Typeable, Data, Generic) -instance FromJSON LaplaceDistribution+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 = LD <$> get <*> get+  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@@ -60,7 +74,8 @@ 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+    quantile      = quantile+    complQuantile = complQuantile  instance D.Mean LaplaceDistribution where     mean (LD l _) = l@@ -82,7 +97,7 @@   maybeEntropy = Just . D.entropy  instance D.ContGen LaplaceDistribution where-  genContVar = D.genContinous+  genContVar = D.genContinuous  cumulative :: LaplaceDistribution -> Double -> Double cumulative (LD l s) x@@ -106,20 +121,43 @@   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-  | s <= 0 =-    error $ "Statistics.Distribution.Laplace.laplace: scale parameter must be positive. Got " ++ show s-  | otherwise = LD l s+laplace l s = maybe (error $ errMsg l s) id $ laplaceE l s --- | Create Laplace distribution from sample. No tests are made to---   check whether it truly is Laplace. Location of distribution---   estimated as median of sample.-laplaceFromSample :: Sample -> LaplaceDistribution-laplaceFromSample xs = LD s l-  where-    s = Q.continuousBy Q.medianUnbiased 1 2 xs-    l = S.mean $ G.map (\x -> abs $ x - s) xs+-- | 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,44 +18,62 @@       NormalDistribution     -- * Constructors     , normalDistr-    , normalFromSample+    , normalDistrE+    , normalDistrErr     , standard     ) where -import Data.Aeson (FromJSON, ToJSON)-import Control.Applicative ((<$>), (<*>))-import Data.Binary (Binary)-import Data.Binary (put, get)-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 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 qualified System.Random.MWC.Distributions as MWC+import Statistics.Internal + -- | The normal distribution. data NormalDistribution = ND {       mean       :: {-# UNPACK #-} !Double     , stdDev     :: {-# UNPACK #-} !Double     , ndPdfDenom :: {-# UNPACK #-} !Double     , ndCdfDenom :: {-# UNPACK #-} !Double-    } deriving (Eq, Read, Show, Typeable, Data, Generic)+    } deriving (Eq, Typeable, Data, Generic) -instance FromJSON 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 w x y z) = put w >> put x >> put y >> put z-    get = ND <$> get <*> get <*> get <*> get+    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@@ -92,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@@ -130,4 +172,15 @@   | otherwise      =     error $ "Statistics.Distribution.Normal.quantile: p must be in [0,1] range. Got: "++show p   where x          = - invErfc (2 * p)+        inf        = 1/0++complQuantile :: NormalDistribution -> Double -> Double+complQuantile d p+  | p == 0         = inf+  | p == 1         = -inf+  | p == 0.5       = mean d+  | p > 0 && p < 1 = x * ndCdfDenom d + mean d+  | otherwise      =+    error $ "Statistics.Distribution.Normal.complQuantile: p must be in [0,1] range. Got: "++show p+  where x          = invErfc (2 * p)         inf        = 1/0
Statistics/Distribution/Poisson.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} -- | -- Module    : Statistics.Distribution.Poisson@@ -18,33 +19,51 @@       PoissonDistribution     -- * Constructors     , poisson+    , poissonE     -- * Accessors     , poissonLambda     -- * References     -- $references     ) where -import Data.Aeson (FromJSON, ToJSON)-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 Data.Binary (put, get)  +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 FromJSON 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-    get = fmap PD get-    put = put . poissonLambda+  put = put . poissonLambda+  get = do+    l <- get+    maybe (fail $ errMsg l) return $ poissonE l  instance D.Distribution PoissonDistribution where     cumulative (PD lambda) x@@ -77,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+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
@@ -16,7 +16,7 @@  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 (logGamma, stirlingError {-, choose, logFactorial -}) import Numeric.SpecFunctions.Extra (bd0)  -- | An unchecked, non-integer-valued version of Loader's saddle point@@ -32,23 +32,23 @@   | otherwise            = exp (-(stirlingError x) - bd0 x lambda) /                            (m_sqrt_2_pi * sqrt x) --- | Compute entropy using Theorem 1 from "Sharp Bounds on the Entropy--- of the Poisson Law".  This function is unused because '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]@@ -61,7 +61,7 @@   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 =@@ -164,7 +164,7 @@   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,40 +12,66 @@ -- Student-T distribution module Statistics.Distribution.StudentT (     StudentT+    -- * Constructors   , studentT-  , studentTndf+  , studentTE   , studentTUnstandardized+    -- * Accessors+  , studentTndf   ) where -import Data.Aeson (FromJSON, ToJSON)-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 Data.Binary (put, get)+import Statistics.Internal + -- | Student-T distribution newtype StudentT = StudentT { studentTndf :: Double }-                   deriving (Eq, Show, Read, Typeable, Data, Generic)+                   deriving (Eq, Typeable, Data, Generic) -instance FromJSON 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 = fmap StudentT get+  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@@ -58,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@@ -90,7 +126,7 @@   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
@@ -18,11 +18,9 @@     ) where  import Data.Aeson (FromJSON, ToJSON)-import Control.Applicative ((<*>)) import Data.Binary (Binary) import Data.Binary (put, get) import Data.Data (Data, Typeable)-import Data.Functor ((<$>)) import GHC.Generics (Generic) import qualified Statistics.Distribution as D @@ -66,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@@ -82,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,42 +15,66 @@       UniformDistribution     -- * Constructors     , uniformDistr+    , uniformDistrE     -- ** Accessors     , uniformA     , uniformB     ) where -import Data.Aeson (FromJSON, ToJSON)-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 Data.Binary (put, get)-import Control.Applicative ((<$>), (<*>))+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 FromJSON 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 = UniformDistribution <$> get <*> get+  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@@ -65,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)@@ -88,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,8 +1,5 @@ {-# LANGUAGE BangPatterns, CPP, FlexibleContexts, Rank2Types #-}-#if __GLASGOW_HASKELL__ >= 704 {-# OPTIONS_GHC -fsimpl-tick-factor=200 #-}-#endif- -- | -- Module    : Statistics.Function -- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan@@ -47,7 +44,7 @@ import qualified Data.Vector.Generic as G import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as M-import Statistics.Function.Comparison (within)+import Numeric.MathFunctions.Comparison (within)  -- | Sort a vector. sort :: U.Vector Double -> U.Vector Double@@ -79,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
− 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.Word (Word64)---- | 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 :: Word64-      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/RootFinding.hs 
@@ -1,148 +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 Data.Aeson (FromJSON, ToJSON)-import Control.Applicative (Alternative(..), Applicative(..))-import Control.Monad (MonadPlus(..), ap)-import Data.Binary (Binary)-import Data.Binary (put, get)-import Data.Binary.Get (getWord8)-import Data.Binary.Put (putWord8)-import Data.Data (Data, Typeable)-import GHC.Generics (Generic)-import Statistics.Function.Comparison (within)----- | 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 (FromJSON a) => FromJSON (Root a)-instance (ToJSON a) => ToJSON (Root a)--instance (Binary a) => Binary (Root a) where-    put NotBracketed = putWord8 0-    put SearchFailed = putWord8 1-    put (Root a) = putWord8 2 >> put a--    get = do-        i <- getWord8-        case i of-            0 -> return NotBracketed-            1 -> return SearchFailed-            2 -> fmap Root get-            _ -> fail $ "Root.get: Invalid value: " ++ show i--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/Matrix.hs 
@@ -1,270 +0,0 @@-{-# LANGUAGE PatternGuards #-}--- |--- Module    : Statistics.Matrix--- Copyright : 2011 Aleksey Khudyakov, 2014 Bryan O'Sullivan--- License   : BSD3------ Basic matrix operations.------ There isn't a widely used matrix package for Haskell yet, so--- we implement the necessary minimum here.--module Statistics.Matrix-    ( -- * Data types-      Matrix(..)-    , Vector-      -- * Conversion from/to lists/vectors-    , fromVector-    , fromList-    , fromRowLists-    , fromRows-    , fromColumns-    , toVector-    , toList-    , toRows-    , toColumns-    , toRowLists-      -- * Other-    , generate-    , generateSym-    , ident-    , diag-    , dimension-    , center-    , multiply-    , multiplyV-    , transpose-    , power-    , norm-    , column-    , row-    , map-    , for-    , unsafeIndex-    , hasNaN-    , bounds-    , unsafeBounds-    ) where--import Prelude hiding (exponent, map, sum)-import Control.Applicative ((<$>))-import Control.Monad.ST-import qualified Data.Vector.Unboxed as U-import           Data.Vector.Unboxed   ((!))-import qualified Data.Vector.Unboxed.Mutable as UM--import Statistics.Function (for, square)-import Statistics.Matrix.Types-import Statistics.Matrix.Mutable  (unsafeNew,unsafeWrite,unsafeFreeze)-import Statistics.Sample.Internal (sum)---------------------------------------------------------------------- Conversion to/from vectors/lists--------------------------------------------------------------------- | Convert from a row-major list.-fromList :: Int                 -- ^ Number of rows.-         -> Int                 -- ^ Number of columns.-         -> [Double]            -- ^ Flat list of values, in row-major order.-         -> Matrix-fromList r c = fromVector r c . U.fromList---- | create a matrix from a list of lists, as rows-fromRowLists :: [[Double]] -> Matrix-fromRowLists = fromRows . fmap U.fromList---- | Convert from a row-major vector.-fromVector :: Int               -- ^ Number of rows.-           -> Int               -- ^ Number of columns.-           -> U.Vector Double   -- ^ Flat list of values, in row-major order.-           -> Matrix-fromVector r c v-  | r*c /= len = error "input size mismatch"-  | otherwise  = Matrix r c 0 v-  where len    = U.length v---- | create a matrix from a list of vectors, as rows-fromRows :: [Vector] -> Matrix-fromRows xs-  | [] <- xs        = error "Statistics.Matrix.fromRows: empty list of rows!"-  | any (/=nCol) ns = error "Statistics.Matrix.fromRows: row sizes do not match"-  | nCol == 0       = error "Statistics.Matrix.fromRows: zero columns in matrix"-  | otherwise       = fromVector nRow nCol (U.concat xs)-  where-    nCol:ns = U.length <$> xs-    nRow    = length xs----- | create a matrix from a list of vectors, as columns-fromColumns :: [Vector] -> Matrix-fromColumns = transpose . fromRows---- | Convert to a row-major flat vector.-toVector :: Matrix -> U.Vector Double-toVector (Matrix _ _ _ v) = v---- | Convert to a row-major flat list.-toList :: Matrix -> [Double]-toList = U.toList . toVector---- | Convert to a list of lists, as rows-toRowLists :: Matrix -> [[Double]]-toRowLists (Matrix _ nCol _ v)-  = chunks $ U.toList v-  where-    chunks [] = []-    chunks xs = case splitAt nCol xs of-      (rowE,rest) -> rowE : chunks rest----- | Convert to a list of vectors, as rows-toRows :: Matrix -> [Vector]-toRows (Matrix _ nCol _ v) = chunks v-  where-    chunks xs-      | U.null xs = []-      | otherwise = case U.splitAt nCol xs of-          (rowE,rest) -> rowE : chunks rest---- | Convert to a list of vectors, as columns-toColumns :: Matrix -> [Vector]-toColumns = toRows . transpose----------------------------------------------------------------------- Other--------------------------------------------------------------------- | Generate matrix using function-generate :: Int                 -- ^ Number of rows-         -> Int                 -- ^ Number of columns-         -> (Int -> Int -> Double)-            -- ^ Function which takes /row/ and /column/ as argument.-         -> Matrix-generate nRow nCol f-  = Matrix nRow nCol 0 $ U.generate (nRow*nCol) $ \i ->-      let (r,c) = i `quotRem` nCol in f r c---- | Generate symmetric square matrix using function-generateSym-  :: Int                 -- ^ Number of rows and columns-  -> (Int -> Int -> Double)-     -- ^ Function which takes /row/ and /column/ as argument. It must-     --   be symmetric in arguments: @f i j == f j i@-  -> Matrix-generateSym n f = runST $ do-  m <- unsafeNew n n-  for 0 n $ \r -> do-    unsafeWrite m r r (f r r)-    for (r+1) n $ \c -> do-      let x = f r c-      unsafeWrite m r c x-      unsafeWrite m c r x-  unsafeFreeze m----- | Create the square identity matrix with given dimensions.-ident :: Int -> Matrix-ident n = diag $ U.replicate n 1.0---- | Create a square matrix with given diagonal, other entries default to 0-diag :: Vector -> Matrix-diag v-  = Matrix n n 0 $ U.create $ do-      arr <- UM.replicate (n*n) 0-      for 0 n $ \i ->-        UM.unsafeWrite arr (i*n + i) (v ! i)-      return arr-  where-    n = U.length v---- | Return the dimensions of this matrix, as a (row,column) pair.-dimension :: Matrix -> (Int, Int)-dimension (Matrix r c _ _) = (r, c)---- | Avoid overflow in the matrix.-avoidOverflow :: Matrix -> Matrix-avoidOverflow m@(Matrix r c e v)-  | center m > 1e140 = Matrix r c (e + 140) (U.map (* 1e-140) v)-  | otherwise        = m---- | Matrix-matrix multiplication. Matrices must be of compatible--- sizes (/note: not checked/).-multiply :: Matrix -> Matrix -> Matrix-multiply m1@(Matrix r1 _ e1 _) m2@(Matrix _ c2 e2 _) =-  Matrix r1 c2 (e1 + e2) $ U.generate (r1*c2) go-  where-    go t = sum $ U.zipWith (*) (row m1 i) (column m2 j)-      where (i,j) = t `quotRem` c2---- | Matrix-vector multiplication.-multiplyV :: Matrix -> Vector -> Vector-multiplyV m v-  | cols m == c = U.generate (rows m) (sum . U.zipWith (*) v . row m)-  | otherwise   = error $ "matrix/vector unconformable " ++ show (cols m,c)-  where c = U.length v---- | Raise matrix to /n/th power. Power must be positive--- (/note: not checked).-power :: Matrix -> Int -> Matrix-power mat 1 = mat-power mat n = avoidOverflow res-  where-    mat2 = power mat (n `quot` 2)-    pow  = multiply mat2 mat2-    res | odd n     = multiply pow mat-        | otherwise = pow---- | Element in the center of matrix (not corrected for exponent).-center :: Matrix -> Double-center mat@(Matrix r c _ _) =-    unsafeBounds U.unsafeIndex mat (r `quot` 2) (c `quot` 2)---- | Calculate the Euclidean norm of a vector.-norm :: Vector -> Double-norm = sqrt . sum . U.map square---- | Return the given column.-column :: Matrix -> Int -> Vector-column (Matrix r c _ v) i = U.backpermute v $ U.enumFromStepN i c r-{-# INLINE column #-}---- | Return the given row.-row :: Matrix -> Int -> Vector-row (Matrix _ c _ v) i = U.slice (c*i) c v--unsafeIndex :: Matrix-            -> Int              -- ^ Row.-            -> Int              -- ^ Column.-            -> Double-unsafeIndex = unsafeBounds U.unsafeIndex---- | Apply function to every element of matrix-map :: (Double -> Double) -> Matrix -> Matrix-map f (Matrix r c e v) = Matrix r c e (U.map f v)---- | Indicate whether any element of the matrix is @NaN@.-hasNaN :: Matrix -> Bool-hasNaN = U.any isNaN . toVector---- | Given row and column numbers, calculate the offset into the flat--- row-major vector.-bounds :: (Vector -> Int -> r) -> Matrix -> Int -> Int -> r-bounds k (Matrix rs cs _ v) r c-  | r < 0 || r >= rs = error "row out of bounds"-  | c < 0 || c >= cs = error "column out of bounds"-  | otherwise        = k v $! r * cs + c-{-# INLINE bounds #-}---- | Given row and column numbers, calculate the offset into the flat--- row-major vector, without checking.-unsafeBounds :: (Vector -> Int -> r) -> Matrix -> Int -> Int -> r-unsafeBounds k (Matrix _ cs _ v) r c = k v $! r * cs + c-{-# INLINE unsafeBounds #-}--transpose :: Matrix -> Matrix-transpose m@(Matrix r0 c0 e _) = Matrix c0 r0 e . U.generate (r0*c0) $ \i ->-  let (r,c) = i `quotRem` r0-  in unsafeIndex m c r
− Statistics/Matrix/Algorithms.hs 
@@ -1,42 +0,0 @@--- |--- Module    : Statistics.Matrix.Algorithms--- Copyright : 2014 Bryan O'Sullivan--- License   : BSD3------ Useful matrix functions.--module Statistics.Matrix.Algorithms-    (-      qr-    ) where--import Control.Applicative ((<$>), (<*>))-import Control.Monad.ST (ST, runST)-import Prelude hiding (sum, replicate)-import Statistics.Matrix (Matrix, column, dimension, for, norm)-import qualified Statistics.Matrix.Mutable as M-import Statistics.Sample.Internal (sum)-import qualified Data.Vector.Unboxed as U---- | /O(r*c)/ Compute the QR decomposition of a matrix.--- The result returned is the matrices (/q/,/r/).-qr :: Matrix -> (Matrix, Matrix)-qr mat = runST $ do-  let (m,n) = dimension mat-  r <- M.replicate n n 0-  a <- M.thaw mat-  for 0 n $ \j -> do-    cn <- M.immutably a $ \aa -> norm (column aa j)-    M.unsafeWrite r j j cn-    for 0 m $ \i -> M.unsafeModify a i j (/ cn)-    for (j+1) n $ \jj -> do-      p <- innerProduct a j jj-      M.unsafeWrite r j jj p-      for 0 m $ \i -> do-        aij <- M.unsafeRead a i j-        M.unsafeModify a i jj $ subtract (p * aij)-  (,) <$> M.unsafeFreeze a <*> M.unsafeFreeze r--innerProduct :: M.MMatrix s -> Int -> Int -> ST s Double-innerProduct mmat j k = M.immutably mmat $ \mat ->-  sum $ U.zipWith (*) (column mat j) (column mat k)
− Statistics/Matrix/Mutable.hs 
@@ -1,86 +0,0 @@--- |--- Module    : Statistics.Matrix.Mutable--- Copyright : (c) 2014 Bryan O'Sullivan--- License   : BSD3------ Basic mutable matrix operations.--module Statistics.Matrix.Mutable-    (-      MMatrix(..)-    , MVector-    , replicate-    , thaw-    , bounds-    , unsafeNew-    , unsafeFreeze-    , unsafeRead-    , unsafeWrite-    , unsafeModify-    , immutably-    , unsafeBounds-    ) where--import Control.Applicative ((<$>))-import Control.DeepSeq (NFData(..))-import Control.Monad.ST (ST)-import Statistics.Matrix.Types (Matrix(..), MMatrix(..), MVector)-import qualified Data.Vector.Unboxed as U-import qualified Data.Vector.Unboxed.Mutable as M-import Prelude hiding (replicate)--replicate :: Int -> Int -> Double -> ST s (MMatrix s)-replicate r c k = MMatrix r c 0 <$> M.replicate (r*c) k--thaw :: Matrix -> ST s (MMatrix s)-thaw (Matrix r c e v) = MMatrix r c e <$> U.thaw v--unsafeFreeze :: MMatrix s -> ST s Matrix-unsafeFreeze (MMatrix r c e mv) = Matrix r c e <$> U.unsafeFreeze mv---- | Allocate new matrix. Matrix content is not initialized hence unsafe.-unsafeNew :: Int                -- ^ Number of row-          -> Int                -- ^ Number of columns-          -> ST s (MMatrix s)-unsafeNew r c-  | r < 0     = error "Statistics.Matrix.Mutable.unsafeNew: negative number of rows"-  | c < 0     = error "Statistics.Matrix.Mutable.unsafeNew: negative number of columns"-  | otherwise = do-      vec <- M.new (r*c)-      return $ MMatrix r c 0 vec--unsafeRead :: MMatrix s -> Int -> Int -> ST s Double-unsafeRead mat r c = unsafeBounds mat r c M.unsafeRead-{-# INLINE unsafeRead #-}--unsafeWrite :: MMatrix s -> Int -> Int -> Double -> ST s ()-unsafeWrite mat row col k = unsafeBounds mat row col $ \v i ->-  M.unsafeWrite v i k-{-# INLINE unsafeWrite #-}--unsafeModify :: MMatrix s -> Int -> Int -> (Double -> Double) -> ST s ()-unsafeModify mat row col f = unsafeBounds mat row col $ \v i -> do-  k <- M.unsafeRead v i-  M.unsafeWrite v i (f k)-{-# INLINE unsafeModify #-}---- | Given row and column numbers, calculate the offset into the flat--- row-major vector.-bounds :: MMatrix s -> Int -> Int -> (MVector s -> Int -> r) -> r-bounds (MMatrix rs cs _ mv) r c k-  | r < 0 || r >= rs = error "row out of bounds"-  | c < 0 || c >= cs = error "column out of bounds"-  | otherwise        = k mv $! r * cs + c-{-# INLINE bounds #-}---- | Given row and column numbers, calculate the offset into the flat--- row-major vector, without checking.-unsafeBounds :: MMatrix s -> Int -> Int -> (MVector s -> Int -> r) -> r-unsafeBounds (MMatrix _ cs _ mv) r c k = k mv $! r * cs + c-{-# INLINE unsafeBounds #-}--immutably :: NFData a => MMatrix s -> (Matrix -> a) -> ST s a-immutably mmat f = do-  k <- f <$> unsafeFreeze mmat-  rnf k `seq` return k-{-# INLINE immutably #-}
− Statistics/Matrix/Types.hs 
@@ -1,64 +0,0 @@--- |--- Module    : Statistics.Matrix.Types--- Copyright : 2014 Bryan O'Sullivan--- License   : BSD3------ Basic matrix operations.------ There isn't a widely used matrix package for Haskell yet, so--- we implement the necessary minimum here.--module Statistics.Matrix.Types-    (-      Vector-    , MVector-    , Matrix(..)-    , MMatrix(..)-    , debug-    ) where--import Data.Char (isSpace)-import Numeric (showFFloat)-import qualified Data.Vector.Unboxed as U-import qualified Data.Vector.Unboxed.Mutable as M--type Vector = U.Vector Double-type MVector s = M.MVector s Double---- | Two-dimensional matrix, stored in row-major order.-data Matrix = Matrix {-      rows     :: {-# UNPACK #-} !Int -- ^ Rows of matrix.-    , cols     :: {-# UNPACK #-} !Int -- ^ Columns of matrix.-    , exponent :: {-# UNPACK #-} !Int-      -- ^ In order to avoid overflows during matrix multiplication, a-      -- large exponent is stored separately.-    , _vector  :: !Vector  -- ^ Matrix data.-    } deriving (Eq)---- | Two-dimensional mutable matrix, stored in row-major order.-data MMatrix s = MMatrix-                 {-# UNPACK #-} !Int-                 {-# UNPACK #-} !Int-                 {-# UNPACK #-} !Int-                 !(MVector s)---- The Show instance is useful only for debugging.-instance Show Matrix where-    show = debug--debug :: Matrix -> String-debug (Matrix r c _ vs) = unlines $ zipWith (++) (hdr0 : repeat hdr) rrows-  where-    rrows         = map (cleanEnd . unwords) . split $ zipWith (++) ldone tdone-    hdr0          = show (r,c) ++ " "-    hdr           = replicate (length hdr0) ' '-    pad plus k xs = replicate (k - length xs) ' ' `plus` xs-    ldone         = map (pad (++) (longest lstr)) lstr-    tdone         = map (pad (flip (++)) (longest tstr)) tstr-    (lstr, tstr)  = unzip . map (break (=='.') . render) . U.toList $ vs-    longest       = maximum . map length-    render k      = reverse . dropWhile (=='.') . dropWhile (=='0') . reverse .-                    showFFloat (Just 4) k $ ""-    split []      = []-    split xs      = i : split rest where (i, rest) = splitAt c xs-    cleanEnd      = reverse . dropWhile isSpace . reverse
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,37 +20,66 @@ -- 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           Data.Binary            (Binary)+import           Data.Aeson             (ToJSON,FromJSON)+import           Data.Data              (Data,Typeable)+import           Data.Default.Class+import qualified Data.Foldable        as F+import           Data.Vector.Generic ((!))+import qualified Data.Vector          as V+import qualified Data.Vector.Generic  as G+import qualified Data.Vector.Unboxed  as U+import qualified Data.Vector.Storable as S+import GHC.Generics (Generic)+ import Statistics.Function (partialSort)-import qualified Data.Vector as V-import qualified Data.Vector.Generic as G-import qualified Data.Vector.Unboxed as U --- | O(/n/ log /n/). Estimate the /k/th /q/-quantile of a sample,--- using the weighted average method.++----------------------------------------------------------------+-- 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.@@ -53,10 +87,12 @@             -> 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@@ -67,101 +103,200 @@     n   = G.length x {-# SPECIALIZE weightedAvg :: Int -> Int -> U.Vector Double -> Double #-} {-# SPECIALIZE weightedAvg :: Int -> Int -> V.Vector Double -> Double #-}+{-# SPECIALIZE weightedAvg :: Int -> Int -> S.Vector Double -> Double #-} --- | Parameters /a/ and /b/ to the 'continuousBy' function.-data ContParam = ContParam {-# UNPACK #-} !Double {-# UNPACK #-} !Double --- | O(/n/ log /n/). Estimate the /k/th /q/-quantile of a sample /x/,--- using the continuous sample method with the given parameters.  This--- is the method used by most statistical software, such as R,+----------------------------------------------------------------+-- Quantiles continuous algorithm+----------------------------------------------------------------++-- $cont_quantiles+--+-- Below is family of functions which use same algorithm for estimation+-- of sample quantiles. It approximates empirical CDF as continuous+-- piecewise function which interpolates linearly between points+-- \((X_k,p_k)\) where \(X_k\) is k-th order statistics (k-th smallest+-- element) and \(p_k\) is probability corresponding to+-- it. 'ContParam' determines how \(p_k\) is chosen. For more detailed+-- explanation see [Hyndman1996].+--+-- This is the method used by most statistical software, such as R, -- Mathematica, SPSS, and S.-continuousBy :: 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)+    pk       = toPk param n q nQ+    sortedXs = psort xs $ floor pk + 1+    n        = G.length xs+{-# INLINABLE quantile #-} {-# SPECIALIZE-    continuousBy :: ContParam -> Int -> Int -> U.Vector Double -> Double #-}+    quantile :: ContParam -> Int -> Int -> U.Vector Double -> Double #-} {-# SPECIALIZE-    continuousBy :: ContParam -> Int -> Int -> V.Vector Double -> Double #-}+    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-{-# SPECIALIZE midspread :: ContParam -> Int -> U.Vector Double -> Double #-}-{-# SPECIALIZE midspread :: ContParam -> Int -> V.Vector Double -> Double #-}+    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 --- | 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 --- | 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 --- | 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 --- | 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.@@ -169,7 +304,7 @@ medianUnbiased = ContParam third third     where third = 1/3 --- | 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.@@ -180,11 +315,86 @@ 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
@@ -13,18 +13,17 @@     , bootstrapRegress     ) where -import Control.Applicative ((<$>))-import Control.Concurrent (forkIO)-import Control.Concurrent.Chan (newChan, readChan, writeChan)+import Control.Concurrent.Async (forConcurrently) import Control.DeepSeq (rnf)-import Control.Monad (forM_, replicateM)+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.Resampling.Bootstrap (Estimate(..))+import Statistics.Types      (Estimate(..),ConfInt,CL,estimateFromInterval,significanceLevel) import Statistics.Sample (mean) import Statistics.Sample.Internal (sum) import System.Random.MWC (GenIO, uniformR)@@ -42,8 +41,15 @@ --   element than the list of predictors; the last element is the --   /y/-intercept value. ----- * /R&#0178;/, the coefficient of determination (see 'rSquare' for+-- * /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@@ -66,7 +72,30 @@     lss@(n:ls) = map G.length preds olsRegress _ _ = error "no predictors given" --- | Compute the ordinary least-squares solution to /A x = b/.+-- | 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@@ -88,12 +117,12 @@   rfor n 0 $ \i -> do     si <- (/ unsafeIndex r i i) <$> M.unsafeRead s i     M.unsafeWrite s i si-    for 0 i $ \j -> F.unsafeModify s j $ subtract ((unsafeIndex r j 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&#0178;/, the coefficient of determination that+-- | 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@@ -102,51 +131,71 @@         -> Vector               -- ^ Responders.         -> Vector               -- ^ Regression coefficients.         -> Double-rSquare pred resp coeff = 1 - r / t+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-    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 -> (* unsafeIndex pred i j)+    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.-                 -> Double      -- ^ Confidence interval.-                 -> ([Vector] -> Vector -> (Vector, Double))-                 -- ^ Regression function.-                 -> [Vector]    -- ^ Predictor vectors.-                 -> Vector      -- ^ Responder vector.-                 -> IO (V.Vector Estimate, Estimate)-bootstrapRegress gen0 numResamples ci rgrss preds0 resp0+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"-  | ci <= 0 || ci >= 1 = error $ "bootstrapRegress: confidence interval " ++-                                 "must lie between 0 and 1"   | 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-  done <- newChan-  forM_ (zip gens (balance caps numResamples)) $ \(gen,count) -> do-    forkIO $ do+  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` writeChan done v-  (coeffsv, r2v) <- (G.unzip . V.concat) <$> replicateM caps (readChan done)+      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)+                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 = Estimate s (w G.! lo) (w G.! hi) ci+      est s v = estimateFromInterval s (w G.! lo, w G.! hi) cl         where w  = F.sort v-              lo = round c-              hi = truncate (n - c)+              bounded i = min (U.length w - 1) (max 0 i)+              lo = bounded $ round c+              hi = bounded $ truncate (n - c)               n  = fromIntegral numResamples-              c  = n * ((1 - ci) / 2)+              c  = n * (significanceLevel cl / 2)   return (coeffs, r2)  -- | Balance units of work across workers.
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,38 +19,54 @@ -- Resampling statistics.  module Statistics.Resampling-    (+    ( -- * Data types       Resample(..)+    , Bootstrap(..)+    , Estimator(..)+    , estimate+      -- * Resampling+    , resampleST+    , resample+    , resampleVector+      -- * Jackknife     , jackknife     , jackknifeMean     , jackknifeVariance     , jackknifeVarianceUnb     , jackknifeStdDev-    , resample-    , estimate+      -- * Helper functions     , splitGen     ) where  import Data.Aeson (FromJSON, ToJSON)-import Control.Concurrent (forkIO, newChan, readChan, writeChan)-import Control.Monad (forM_, liftM, replicateM, replicateM_)+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.Sample (mean, stdDev, variance, varianceUnbiased)-import Statistics.Types (Estimator(..), Sample)-import System.Random.MWC (GenIO, initialize, uniform, uniformVector)-import qualified Data.Vector.Generic as G-import qualified Data.Vector.Unboxed as U-import qualified Data.Vector.Unboxed.Mutable as MU+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.@@ -58,6 +81,66 @@     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. --@@ -73,42 +156,48 @@ 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   gens <- splitGen numCapabilities gen-  forM_ (zip3 ixs (tail ixs) gens) $ \ (start,!end,gen') -> do-    forkIO $ do-      let loop k ers | k >= end = writeChan done ()+  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   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 --- | 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+-- | 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@@ -152,7 +241,9 @@  -- | /O(n)/ Compute the unbiased jackknife variance of a sample. jackknifeVarianceUnb :: Sample -> U.Vector Double-jackknifeVarianceUnb = jackknifeVariance_ 1+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@@ -174,7 +265,7 @@  singletonErr :: String -> a singletonErr func = error $-                    "Statistics.Resampling." ++ func ++ ": singleton input"+                    "Statistics.Resampling." ++ func ++ ": not enough elements in sample"  -- | Split a generator into several that can run independently. splitGen :: Int -> GenIO -> IO [GenIO]
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,109 +10,67 @@ -- The bootstrap method for statistical inference.  module Statistics.Resampling.Bootstrap-    (-      Estimate(..)-    , bootstrapBCA-    , scale+    ( bootstrapBCA+    , basicBootstrap     -- * References     -- $references     ) where -import Control.Applicative ((<$>), (<*>))-import Control.DeepSeq (NFData)-import Control.Exception (assert)-import Control.Monad.Par (parMap, runPar)-import Data.Aeson (FromJSON, ToJSON)-import Data.Binary (Binary)-import Data.Binary (put, get)-import Data.Data (Data)-import Data.Typeable (Typeable)-import Data.Vector.Unboxed ((!))-import GHC.Generics (Generic)+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-import qualified Statistics.Resampling as R---- | 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 FromJSON Estimate-instance ToJSON Estimate--instance Binary Estimate where-    put (Estimate w x y z) = put w >> put x >> put y >> put z-    get = Estimate <$> get <*> get <*> get <*> get-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)+    e (est, Bootstrap pt resample)       | U.length sample == 1 || isInfinite bias =-          estimate pt pt pt confidenceLevel+          estimateFromErr      pt (0,0) confidenceLevel       | otherwise =-          estimate pt (resample ! lo) (resample ! hi) confidenceLevel+          estimateFromInterval pt (resample ! lo, resample ! hi) confidenceLevel       where-        pt    = R.estimate 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@@ -123,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,6 +21,7 @@     , range      -- * Statistics of location+    , expectation     , mean     , welfordMean     , meanWeighted@@ -43,6 +45,7 @@     , meanVarianceUnb     , stdDev     , varianceWeighted+    , stdErrMean      -- ** Single-pass functions (faster, less safe)     -- $cancellation@@ -50,22 +53,25 @@     , fastVarianceUnbiased     , fastStdDev -    -- * Joint distirbutions+    -- * Joint distributions     , covariance     , correlation+    , covariance2+    , correlation2     , pair     -- * References     -- $references     ) where -import Statistics.Function (minMax)+import Statistics.Function (minMax,square) import Statistics.Sample.Internal (robustSumVar, sum)-import Statistics.Types (Sample,WeightedSample)+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+-- Operator ^ will be overridden import Prelude hiding ((^), sum)  -- | /O(n)/ Range. The difference between the largest and smallest@@ -75,9 +81,17 @@     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.+-- 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 #-}@@ -121,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@@ -137,7 +151,7 @@     | a < 0  = error "Statistics.Sample.centralMoment: negative input"     | a == 0 = 1     | a == 1 = 0-    | otherwise = sum (G.map go xs) / fromIntegral (G.length xs)+    | otherwise = expectation go xs   where     go x = (x-m) ^ a     m    = mean xs@@ -214,7 +228,7 @@  -- $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@@ -284,6 +298,13 @@ {-# 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@@ -346,42 +367,79 @@  -- | Covariance of sample of pairs. For empty sample it's set to --   zero-covariance :: (G.Vector v (Double,Double), G.Vector v Double)+covariance :: (G.Vector v (Double,Double))            => v (Double,Double)            -> Double covariance xy   | n == 0    = 0-  | otherwise = mean $ G.zipWith (*)-                         (G.map (\x -> x - muX) xs)-                         (G.map (\y -> y - muY) ys)+  | otherwise = expectation (\(x,y) -> (x - muX)*(y - muY)) xy   where-    n       = G.length xy-    (xs,ys) = G.unzip xy-    muX     = mean xs-    muY     = mean ys+    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), G.Vector v Double)+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-    (xs,ys) = G.unzip xy-    (muX,varX) = meanVariance xs-    (muY,varY) = meanVariance ys-    cov = mean $ G.zipWith (*)-            (G.map (\x -> x - muX) xs)-            (G.map (\y -> y - muY) ys)+    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)@@ -395,8 +453,9 @@  -- (^) 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
@@ -14,9 +14,10 @@     (       robustSumVar     , sum+    , sumF     ) where -import Numeric.Sum (kbn, sumVector)+import qualified Numeric.Sum as Sum import Prelude hiding (sum) import Statistics.Function (square) import qualified Data.Vector.Generic as G@@ -26,5 +27,9 @@ {-# INLINE robustSumVar #-}  sum :: (G.Vector v Double) => v Double -> Double-sum = sumVector kbn+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,10 +25,11 @@     -- $references     ) where +import Data.Default.Class import Numeric.MathFunctions.Constants (m_sqrt_2_pi)+import Numeric.RootFinding             (fromRoot, ridders, RiddersParam(..), Tolerance(..)) import Prelude hiding (const, min, max, sum) import Statistics.Function (minMax, nextHighestPowerOfTwo)-import Statistics.Math.RootFinding (fromRoot, ridders) import Statistics.Sample.Histogram (histogram_) import Statistics.Sample.Internal (sum) import Statistics.Transform (CD, dct, idct)@@ -98,8 +99,8 @@     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) * sum (G.zipWith g iv a2v)           where g i a2 = i ** q * a2 * exp ((-i) * sqr pi * t)
+ 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,23 +47,22 @@     -- $references     ) where -import Data.Aeson (FromJSON, ToJSON)-import Data.Binary (Binary(..))-import Data.Data (Data, Typeable)-import Data.Vector.Binary ()-import Data.Vector.Generic (unsafeFreeze)-import Data.Vector.Unboxed ((!))-import GHC.Generics (Generic)+import Control.Monad.ST+import Data.Aeson            (FromJSON, ToJSON)+import Data.Binary           (Binary(..))+import Data.Data             (Data, Typeable)+import Data.Vector.Binary    ()+import Data.Vector.Unboxed   ((!))+import GHC.Generics          (Generic) import Numeric.SpecFunctions (choose) import Prelude hiding (sum)-import Statistics.Function (indexed)-import Statistics.Internal (inlinePerformIO)-import System.IO.Unsafe (unsafePerformIO)-import qualified Data.Vector as V-import qualified Data.Vector.Generic as G-import qualified Data.Vector.Unboxed as U+import Statistics.Function   (indexed)+import qualified Data.Vector          as V+import qualified Data.Vector.Generic  as G+import qualified Data.Vector.Storable as SV+import qualified Data.Vector.Unboxed  as U import qualified Data.Vector.Unboxed.Mutable as MU-import qualified Statistics.Sample.Internal as S+import qualified Statistics.Sample.Internal  as S  newtype Powers = Powers (U.Vector Double)     deriving (Eq, Read, Show, Typeable, Data, Generic)@@ -94,19 +93,22 @@           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-{-# SPECIALIZE powers :: Int -> U.Vector Double -> Powers #-}-{-# SPECIALIZE powers :: Int -> V.Vector Double -> 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
+ 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,44 +2,80 @@ -- | Pearson's chi squared test. module Statistics.Test.ChiSquared (     chi2test-    -- * Data types-  , TestType(..)-  , TestResult(..)+  , chi2testCont+  , module Statistics.Test.Types   ) where  import Prelude hiding (sum)+ import Statistics.Distribution import Statistics.Distribution.ChiSquared-import Statistics.Function (square)+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  = sum $ G.map (\(o,e) -> square (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+{-# INLINABLE  chi2test #-} {-# SPECIALIZE-    chi2test :: Double -> Int -> U.Vector (Int,Double) -> TestResult #-}+    chi2test :: Int -> U.Vector (Int,Double) -> Maybe (Test ChiSquared) #-} {-# SPECIALIZE-    chi2test :: Double -> Int -> V.Vector (Int,Double) -> TestResult #-}+    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
@@ -8,6 +8,7 @@ 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 @@ -23,15 +24,20 @@ -- | Calculate rank of every element of sample. In case of ties ranks --   are averaged. Sample should be already sorted in ascending order. ----- >>> rank (==) (fromList [10,20,30::Int])--- > fromList [1.0,2.0,3.0]+--   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 ----- >>> rank (==) (fromList [10,10,10,30::Int])--- > fromList [2.0,2.0,2.0,4.0]-rank :: (G.Vector v a, G.Vector v Double)+-- >>> 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)@@ -54,11 +60,10 @@ rankUnsorted :: ( Ord a                 , G.Vector v a                 , G.Vector v Int-                , G.Vector v Double                 , G.Vector v (Int, a)                 )              => v a-             -> v Double+             -> U.Vector Double rankUnsorted xs = G.create $ do     -- Put ranks into their original positions     -- NOTE: backpermute will do wrong thing
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,23 +21,26 @@   , kolmogorovSmirnovCdfD   , kolmogorovSmirnovD   , kolmogorovSmirnov2D-    -- * Probablities+    -- * Probabilities   , kolmogorovSmirnovProbability-    -- * Data types-  , TestType(..)-  , TestResult(..)     -- * References     -- $references+  , module Statistics.Test.Types   ) where  import Control.Monad (when) import Prelude hiding (exponent, sum) import Statistics.Distribution (Distribution(..))-import Statistics.Function (sort, unsafeModify)-import Statistics.Matrix (center, exponent, for, fromVector, power)-import Statistics.Test.Types (TestResult(..), TestType(..), significant)-import Statistics.Types (Sample)-import qualified Data.Vector.Unboxed as U+import Statistics.Function (gsort, unsafeModify)+import Statistics.Matrix (center, for, fromVector)+import qualified Statistics.Matrix as Mat+import Statistics.Test.Types+import Statistics.Types (mkPValue)+import qualified Data.Vector          as V+import qualified Data.Vector.Storable as S+import qualified Data.Vector.Unboxed  as U+import qualified Data.Vector.Generic  as G+import           Data.Vector.Generic    ((!)) import qualified Data.Vector.Unboxed.Mutable as M  @@ -44,58 +48,75 @@ -- 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  @@ -107,64 +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 sample = 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 #-}   @@ -178,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 $ matrix `power` n+  | otherwise = fini $ KSMatrix 0 matrix `power` n   where     s  = n' * d * d     n' = fromIntegral n@@ -217,13 +250,34 @@             return mat       in fromVector size size m     -- Last calculation-    fini m = loop 1 (center m) (exponent m)+    fini (KSMatrix e m) = loop 1 (center m) e       where         loop i ss eQ           | i  > n       = ss * 10 ^^ eQ           | ss' < 1e-140 = loop (i+1) (ss' * 1e140) (eQ - 140)           | otherwise    = loop (i+1)  ss'           eQ           where ss' = ss * fromIntegral i / fromIntegral n++data KSMatrix = KSMatrix Int Mat.Matrix+++multiply :: KSMatrix -> KSMatrix -> KSMatrix+multiply (KSMatrix e1 m1) (KSMatrix e2 m2) = KSMatrix (e1+e2) (Mat.multiply m1 m2)++power :: KSMatrix -> Int -> KSMatrix+power mat 1 = mat+power mat n = avoidOverflow res+  where+    mat2 = power mat (n `quot` 2)+    pow  = multiply mat2 mat2+    res | odd n     = multiply pow mat+        | otherwise = pow++avoidOverflow :: KSMatrix -> KSMatrix+avoidOverflow ksm@(KSMatrix e m)+  | center m > 1e140 = KSMatrix (e + 140) (Mat.map (* 1e-140) m)+  | otherwise        = ksm+  ----------------------------------------------------------------
Statistics/Test/KruskalWallis.hs view
@@ -8,19 +8,21 @@ -- Portability : portable -- module Statistics.Test.KruskalWallis-  ( kruskalWallisRank+  ( -- * Kruskal-Wallis test+    kruskalWallisTest+    -- ** Building blocks+  , kruskalWallisRank   , kruskalWallis-  , kruskalWallisSignificant-  , kruskalWallisTest+  , module Statistics.Test.Types   ) where  import Data.Ord (comparing)-import Data.Foldable (foldMap) import qualified Data.Vector.Unboxed as U import Statistics.Function (sort, sortBy, square)-import Statistics.Distribution (quantile)+import Statistics.Distribution (complCumulative) import Statistics.Distribution.ChiSquared (chiSquared)-import Statistics.Test.Types (TestResult(..), significant)+import Statistics.Types+import Statistics.Test.Types import Statistics.Test.Internal (rank) import Statistics.Sample import qualified Statistics.Sample.Internal as Sample(sum)@@ -32,7 +34,7 @@ -- -- 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 :: [Sample] -> [Sample]+kruskalWallisRank :: (U.Unbox a, Ord a) => [U.Vector a] -> [U.Vector Double] kruskalWallisRank samples = groupByTags                           . sortBy (comparing fst)                           . U.zip tags@@ -54,7 +56,7 @@ -- -- In textbooks the output value is usually represented by 'K' or 'H'. This -- function already does the ranking.-kruskalWallis :: [Sample] -> Double+kruskalWallis :: (U.Unbox a, Ord a) => [U.Vector a] -> Double kruskalWallis samples = (nTot - 1) * numerator / denominator   where     -- Total number of elements in all samples@@ -71,29 +73,25 @@     rsamples = kruskalWallisRank samples  --- | Calculates whether the Kruskal-Wallis test is significant.------ It uses /Chi-Squared/ distribution for aproximation as long as the sizes are--- larger than 5. Otherwise the test returns 'Nothing'.-kruskalWallisSignificant ::-       [Int]  -- ^ The samples' size-    -> Double -- ^ The p-value at which to test (e.g. 0.05)-    -> Double -- ^ K value from 'kruskallWallis'-    -> Maybe TestResult-kruskalWallisSignificant ns p k-    -- Use chi-squared approximation-    | all (>4) ns = Just . significant $ k > x-    -- TODO: Implement critical value calculation: kruskalWallisCriticalValue-    | otherwise = Nothing-  where-    x = quantile (chiSquared (length ns - 1)) (1 - p)- -- | Perform Kruskal-Wallis Test for the given samples and required -- significance. For additional information check 'kruskalWallis'. This is just -- a helper function.-kruskalWallisTest :: Double -> [Sample] -> Maybe TestResult-kruskalWallisTest p samples =-    kruskalWallisSignificant (map U.length samples) p $ kruskalWallis samples+--+-- 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
+ 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,14 +19,11 @@   , 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 Numeric.SpecFunctions (choose)@@ -36,22 +33,22 @@ import Statistics.Function (sortBy) import Statistics.Sample.Internal (sum) import Statistics.Test.Internal (rank, splitByTags)-import Statistics.Test.Types (TestResult(..), TestType(..), significant)-import Statistics.Types (Sample)+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 :: (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@@ -61,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))   @@ -72,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)@@ -105,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   {-@@ -181,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@@ -215,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/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,34 +1,93 @@-{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}+{-# LANGUAGE DeriveFunctor, DeriveDataTypeable,DeriveGeneric  #-} module Statistics.Test.Types (-    TestType(..)+    Test(..)+  , isSignificant   , TestResult(..)   , significant+  , PositionTest(..)   ) where -import Data.Aeson (FromJSON, ToJSON)+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,Data,Generic) -instance FromJSON TestType-instance ToJSON TestType- -- | Result of hypothesis testing data TestResult = Significant    -- ^ Null hypothesis should be rejected                 | NotSignificant -- ^ Data is compatible with hypothesis                   deriving (Eq,Ord,Show,Typeable,Data,Generic) +instance Binary   TestResult where+  get = do+      sig <- get+      if sig then return Significant else return NotSignificant+  put = put . (== Significant) instance FromJSON TestResult-instance ToJSON TestResult+instance ToJSON   TestResult+instance NFData   TestResult --- | Significant if parameter is 'True', not significant otherwiser+++-- | Result of statistical test.+data Test distr = Test+  { testSignificance :: !(PValue Double)+    -- ^ Probability of getting value of test statistics at least as+    --   extreme as measured.+  , testStatistics   :: !Double+    -- ^ Statistic used for test.+  , testDistribution :: distr+    -- ^ Distribution of test statistics if null hypothesis is correct.+  }+  deriving (Eq,Ord,Show,Typeable,Data,Generic,Functor)++instance (Binary   d) => Binary   (Test d) where+  get = liftM3 Test get get get+  put (Test sign stat distr) = put sign >> put stat >> put distr+instance (FromJSON d) => FromJSON (Test d)+instance (ToJSON   d) => ToJSON   (Test d)+instance (NFData   d) => NFData   (Test d) where+  rnf (Test _ _ a) = rnf a++-- | Check whether test is significant for given p-value.+isSignificant :: PValue Double -> Test d -> TestResult+isSignificant p t+  = significant $ p >= testSignificance t+++-- | Test type for test which compare positional (mean,median etc.)+--   information of samples.+data PositionTest+  = SamplesDiffer+    -- ^ Test whether samples differ in position. Null hypothesis is+    --   samples are not different+  | AGreater+    -- ^ Test if first sample (A) is larger than second (B). Null+    --   hypothesis is first sample is not larger than second.+  | BGreater+    -- ^ Test if second sample is larger than first.+  deriving (Eq,Ord,Show,Typeable,Data,Generic)++instance Binary   PositionTest where+  get = do+    i <- get+    case (i :: Int) of+      0 -> return SamplesDiffer+      1 -> return AGreater+      2 -> return BGreater+      _ -> fail "Invalid PositionTest"+  put SamplesDiffer = put (0 :: Int)+  put AGreater      = put (1 :: Int)+  put BGreater      = put (2 :: Int)+instance FromJSON PositionTest+instance ToJSON   PositionTest+instance NFData   PositionTest++-- | significant if parameter is 'True', not significant otherwise significant :: Bool -> TestResult significant True  = Significant significant False = NotSignificant
Statistics/Test/WilcoxonT.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE ViewPatterns #-} -- | -- Module    : Statistics.Test.WilcoxonT -- Copyright : (c) 2010 Neil Brown@@ -8,22 +9,20 @@ -- 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 serious bug and couldn't be--- used with samples larger than 1023.--- <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  @@ -38,32 +37,43 @@ -- 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 the length of the shorter sample.+-- to the length of the shorter sample. -import Control.Applicative ((<$>)) 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 (TestResult(..), TestType(..), significant)-import Statistics.Types (Sample)-import qualified Data.Vector.Unboxed as U+import Statistics.Test.Types+import Statistics.Types -- (CL,pValue,getPValue)+import Statistics.Distribution+import Statistics.Distribution.Normal -wilcoxonMatchedPairSignedRank :: Sample -> Sample -> (Double, Double)-wilcoxonMatchedPairSignedRank a b = (sum ranks1, negate (sum ranks2))++-- | 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. --@@ -92,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. --@@ -105,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@@ -134,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@@ -174,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/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,34 +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+---------------------------------------------------------------- --- | An estimator of a property of a sample, such as its 'mean'.+-- |+-- 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. ----- 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)+-- 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,71 +0,0 @@-import Control.Monad.ST (runST)-import Criterion.Main-import Data.Complex-import Statistics.Sample-import Statistics.Transform-import Statistics.Correlation.Pearson-import System.Random.MWC-import qualified Data.Vector.Unboxed as U----- 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-      -- Correlation-    , bench "pearson"          $ nf (\x -> pearson (U.reverse sample) x) sample-    , bench "pearson'"          $ nf (\x -> pearson' (U.reverse sample) x) sample-    , bench "pearsonFast"      $ nf (\x -> pearsonFast (U.reverse sample) x) 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   (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
@@ -1,9 +1,251 @@-Changes in 0.13.0.0+## 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 +## 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)@@ -20,7 +262,7 @@    * Added the Kruskal-Wallis test. -Changes in 0.11.0.3+## Changes in 0.11.0.3    * Fixed a subtle bug in calculation of the jackknifed unbiased variance. @@ -29,7 +271,7 @@   * We now calculate quantiles for normal distribution in a more     numerically stable way (bug #64). -Changes in 0.10.6.0+## 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@@ -43,55 +285,55 @@     implementation of mean has better numerical accuracy in almost all     cases. -Changes in 0.10.5.2+## 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+## 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+## 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+## 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+## Changes in 0.10.3.0    * Bug fixes -Changes in 0.10.2.0+## Changes in 0.10.2.0    * Bugs in DCT and IDCT are fixed. -  * Accesors for uniform distribution are added.+  * Accessors for uniform distribution are added. -  * ContGen instances for all continous distribtuions are added.+  * ContGen instances for all continuous distributions are added.    * Beta distribution is added. -  * Constructor for improper gamma distribtuion is added.+  * Constructor for improper gamma distribution is added.    * Binomial distribution allows zero trials.    * Poisson distribution now accept zero parameter. -  * Integer overflow in caculation of Wilcoxon-T test is fixed.+  * 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+## Changes in 0.10.1.0    * Kolmogorov-Smirnov nonparametric test added. @@ -101,16 +343,16 @@     is added.    * Modules 'Statistics.Math' and 'Statistics.Constants' are moved to-    the @math-functions@ package. They are still available but marked+    the `math-functions` package. They are still available but marked     as deprecated.  -Changed in 0.10.0.1+## Changes in 0.10.0.1 -  * @dct@ and @idct@ now have type @Vector Double -> Vector Double@+  * `dct` and `idct` now have type `Vector Double -> Vector Double`  -Changes in 0.10.0.0+## 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@@ -128,7 +370,7 @@   * 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+    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@@ -143,7 +385,7 @@   * Bugs in quantile estimations for chi-square and gamma distribution     are fixed. -  * Integer overlow in mannWhitneyUCriticalValue is fixed. It+  * 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.@@ -154,29 +396,29 @@   * 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@.+  * 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@+  * 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+  * 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-    distrbution are added.+    distribution 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+  * Function to perform approximate comparison of doubles is added to     S.Function.Comparison    * Regularized incomplete beta function and its inverse are added to
statistics.cabal view
@@ -1,5 +1,8 @@+cabal-version:  3.0+build-type:     Simple+ name:           statistics-version:        0.13.3.0+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@@ -22,33 +25,55 @@   * 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>+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:   README.markdown-  benchmark/bench.hs-  changelog.md   examples/kde/KDE.hs   examples/kde/data/faithful.csv   examples/kde/kde.html   examples/kde/kde.tpl-  tests/Tests/Math/Tables.hs-  tests/Tests/Math/gen.py   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@@ -56,69 +81,77 @@     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.RootFinding-    Statistics.Matrix-    Statistics.Matrix.Algorithms-    Statistics.Matrix.Mutable-    Statistics.Matrix.Types     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.Bartlett+    Statistics.Test.Levene     Statistics.Test.ChiSquared     Statistics.Test.KolmogorovSmirnov     Statistics.Test.KruskalWallis     Statistics.Test.MannWhitneyU+--    Statistics.Test.Runs+    Statistics.Test.StudentT     Statistics.Test.Types     Statistics.Test.WilcoxonT     Statistics.Transform     Statistics.Types   other-modules:     Statistics.Distribution.Poisson.Internal-    Statistics.Function.Comparison     Statistics.Internal-    Statistics.Sample.Internal     Statistics.Test.Internal-  build-depends:-    aeson >= 0.6.0.0,-    base >= 4.4 && < 5,-    binary >= 0.5.1.0,-    deepseq >= 1.1.0.2,-    erf,-    math-functions    >= 0.1.5.2,-    monad-par         >= 0.3.4,-    mwc-random        >= 0.13.0.0,-    primitive         >= 0.3,-    vector            >= 0.10,-    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--  -- gather extensive profiling data for now-  ghc-prof-options: -auto-all-   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@@ -126,6 +159,7 @@     Tests.ApproxEq     Tests.Correlation     Tests.Distribution+    Tests.ExactDistribution     Tests.Function     Tests.Helpers     Tests.KDE@@ -133,32 +167,75 @@     Tests.Matrix.Types     Tests.NonParametric     Tests.NonParametric.Table+    Tests.Orphanage+    Tests.Parametric+    Tests.Serialization     Tests.Transform-+    Tests.Quantile   ghc-options:     -Wall -threaded -rtsopts -fsimpl-tick-factor=500+  if impl(ghc >= 9.8)+    ghc-options: -Wno-x-partial+  build-depends: base+               , statistics+               , dense-linear-algebra+               , QuickCheck >= 2.7.5+               , binary+               , erf+               , aeson+               , ieee754 >= 0.7.3+               , math-functions+               , primitive+               , tasty+               , tasty-hunit+               , tasty-quickcheck+               , tasty-expected-failure+               , vector+               , vector-algorithms +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:-    HUnit,-    QuickCheck >= 2.7.5,-    base,-    binary,-    erf,-    ieee754 >= 0.7.3,-    math-functions,-    mwc-random,-    primitive,-    statistics,-    test-framework,-    test-framework-hunit,-    test-framework-quickcheck2,-    vector,-    vector-algorithms+            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
@@ -24,7 +24,8 @@     eql eps a b = counterexample (show a ++ " /=~ " ++ show b) (eq eps a b)      (=~)  :: a -> a -> Bool-    (==~) :: ApproxEq a => a -> a -> Property++    (==~) :: a -> a -> Property     a ==~ b = counterexample (show a ++ " /=~ " ++ show b) (a =~ b)  instance ApproxEq Double where@@ -77,8 +78,8 @@ instance ApproxEq Matrix where     type Bounds Matrix = Double -    eq eps (Matrix r1 c1 e1 v1) (Matrix r2 c2 e2 v2) =-      (r1,c1,e1) == (r2,c2,e2) && eq eps v1 v2+    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
tests/Tests/Correlation.hs view
@@ -5,14 +5,12 @@  import Control.Arrow (Arrow(..)) import qualified Data.Vector as V-import Statistics.Matrix hiding (map)+import Data.Maybe import Statistics.Correlation import Statistics.Correlation.Kendall-import Test.QuickCheck ((==>),Property,counterexample)-import Test.Framework-import Test.Framework.Providers.QuickCheck2-import Test.Framework.Providers.HUnit-import Test.HUnit (Assertion, (@=?), assertBool)+import Test.Tasty+import Test.Tasty.QuickCheck hiding (sample)+import Test.Tasty.HUnit  import Tests.ApproxEq @@ -20,7 +18,7 @@ -- Tests list ---------------------------------------------------------------- -tests :: Test+tests :: TestTree tests = testGroup "Correlation"     [ testProperty "Pearson correlation"           testPearson     , testProperty "Spearman correlation is scale invariant" testSpearmanScale@@ -36,15 +34,19 @@  testPearson :: [(Double,Double)] -> Property testPearson sample-  = (length sample > 1) ==> (exact ~= fast)+  = (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)] -> Double+exactPearson :: [(Rational,Rational)] -> Maybe Double exactPearson sample-  = realToFrac cov / sqrt (realToFrac (varX * varY))+  | varX == 0 || varY == 0 = Nothing+  | otherwise              = Just $ realToFrac cov / sqrt (realToFrac (varX * varY))   where     (xs,ys) = unzip sample     n       = fromIntegral $ length sample@@ -100,11 +102,11 @@         , not (isNaN c3)         , not (isNaN c4)         ]-  ==> ( counterexample (show sample0)-      $ counterexample (show sample1)-      $ counterexample (show sample2)-      $ counterexample (show sample3)-      $ counterexample (show sample4)+  ==> ( 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@@ -115,8 +117,8 @@     -- We need to stretch sample into [-10 .. 10] range to avoid     -- problems with under/overflows etc.     stretch xs-      | a == b = xs-      | otherwise = [ (x - a - 10) * 20 / (a - b) | x <- xs ]+      | a == b    = xs+      | otherwise = [ ((x - a)/(b - a) - 0.5) * 20 | x <- xs ]       where         a = minimum xs         b = maximum xs
tests/Tests/Distribution.hs view
@@ -1,42 +1,48 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE FlexibleInstances, OverlappingInstances, ScopedTypeVariables,+{-# LANGUAGE FlexibleInstances, ScopedTypeVariables,     ViewPatterns #-} module Tests.Distribution (tests) where -import Control.Applicative ((<$), (<$>), (<*>))-import Data.Binary (Binary, decode, encode)+import qualified Control.Exception as E import Data.List (find) import Data.Typeable (Typeable)+import Data.Word+import Numeric.MathFunctions.Constants (m_tiny,m_huge,m_epsilon)+import Numeric.MathFunctions.Comparison import Statistics.Distribution-import Statistics.Distribution.Beta (BetaDistribution, betaDistr)-import Statistics.Distribution.Binomial (BinomialDistribution, binomial)+import Statistics.Distribution.Beta           (BetaDistribution)+import Statistics.Distribution.Binomial       (BinomialDistribution) 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.ChiSquared     (ChiSquared)+import Statistics.Distribution.Exponential    (ExponentialDistribution)+import Statistics.Distribution.FDistribution  (FDistribution,fDistribution)+import Statistics.Distribution.Gamma          (GammaDistribution,gammaDistr) import Statistics.Distribution.Geometric import Statistics.Distribution.Hypergeometric-import Statistics.Distribution.Laplace (LaplaceDistribution, laplace)-import Statistics.Distribution.Normal (NormalDistribution, normalDistr)-import Statistics.Distribution.Poisson (PoissonDistribution, 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 (LinearTransform, linTransDistr)-import Statistics.Distribution.Uniform (UniformDistribution, uniformDistr)-import Test.Framework (Test, testGroup)-import Test.Framework.Providers.QuickCheck2 (testProperty)+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 Tests.ApproxEq (ApproxEq(..))-import Tests.Helpers (T(..), testAssertion, typeName)-import Tests.Helpers (monotonicallyIncreasesIEEE) import Text.Printf (printf)-import qualified Control.Exception as E-import qualified Numeric.IEEE as IEEE +import Tests.ApproxEq  (ApproxEq(..))+import Tests.ExactDistribution (exactDistributionTests)+import Tests.Helpers   (T(..), Double01(..), testAssertion, typeName)+import Tests.Helpers   (monotonicallyIncreasesIEEE,isDenorm)+import Tests.Orphanage ()  -- | Tests for all distributions-tests :: Test+tests :: TestTree tests = testGroup "Tests for all distributions"   [ contDistrTests (T :: T BetaDistribution        )   , contDistrTests (T :: T CauchyDistribution      )@@ -44,18 +50,23 @@   , 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   ] @@ -63,37 +74,39 @@ -- Tests ---------------------------------------------------------------- --- Tests for continous distribution-contDistrTests :: (Param d, ContDistr d, QC.Arbitrary d, Typeable d, Show d, Binary d, Eq 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, Binary d, Eq 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, Binary d, Eq 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-  , testProperty "Binary OK"            $ p_binary t   ]  @@ -109,39 +122,46 @@ 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 ==> counterexample ("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 ==> counterexample ("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   = counterexample (unlines badN)   $ null badN@@ -150,50 +170,95 @@     --     -- > 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-  = counterexample (printf "density    = %g" p)-  $ counterexample (printf "logDensity = %g" logP)-  $ counterexample (printf "log p      = %g" (log p))-  $ counterexample (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  ==> ( counterexample (printf "Quantile     = %g" q )-                      $ counterexample (printf "Probability  = %g" p )-                      $ counterexample (printf "Probability' = %g" p')-                      $ counterexample (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@@ -216,9 +281,9 @@   $ 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@@ -226,111 +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   = counterexample (printf "probability    = %g" p)   $ counterexample (printf "logProbability = %g" logP)   $ counterexample (printf "log p          = %g" (log p))-  $ counterexample (printf "eps            = %g" (abs (logP - log p) / max (abs (log p)) (abs logP)))+  $ 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---p_binary :: (Eq a, Show a, Binary a) => T a -> a -> Bool-p_binary _ a = a == (decode . encode) a----------------------------------------------------------------------- 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 LaplaceDistribution where-  arbitrary = laplace <$> QC.choose (-10,10) <*> QC.choose (0, 2)-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,14 +1,14 @@ module Tests.Function ( tests ) where  import Statistics.Function-import Test.Framework-import Test.Framework.Providers.QuickCheck2+import Test.Tasty+import Test.Tasty.QuickCheck import Test.QuickCheck import Tests.Helpers 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
tests/Tests/Helpers.hs view
@@ -1,8 +1,12 @@+{-# LANGUAGE ScopedTypeVariables #-} -- | Helpers for testing module Tests.Helpers (     -- * helpers     T(..)   , typeName+  , Double01(..)+    -- * IEEE 754+  , isDenorm     -- * Generic QC tests   , monotonicallyIncreases   , monotonicallyIncreasesIEEE@@ -16,11 +20,12 @@   ) where  import Data.Typeable-import Test.Framework-import Test.Framework.Providers.HUnit+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.HUnit as HU+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@@ -32,6 +37,18 @@     typeParam :: T a -> a     typeParam _ = undefined +-- | Check if Double denormalized+isDenorm :: Double -> Bool+isDenorm x = let ax = abs x in ax > 0 && ax < m_tiny++-- | Generates Doubles in range [0,1]+newtype Double01 = Double01 Double+                   deriving (Show)+instance Arbitrary Double01 where+  arbitrary = do+    (_::Int, x) <- fmap properFraction arbitrary+    return $ Double01 x+ ---------------------------------------------------------------- -- Generic QC ----------------------------------------------------------------@@ -43,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@@ -58,10 +75,10 @@ -- 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
tests/Tests/KDE.hs view
@@ -3,17 +3,17 @@   tests   )where -import Data.Vector.Unboxed ((!))-import Numeric.Sum (kbn, sumVector)+import Data.Vector.Unboxed             ((!))+import Numeric.Sum                     (kbn, sumVector) import Statistics.Sample.KernelDensity-import Test.Framework (Test, testGroup)-import Test.Framework.Providers.QuickCheck2 (testProperty)-import Test.QuickCheck (Property, (==>), counterexample)-import Text.Printf (printf)+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   ]
− 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
@@ -2,10 +2,9 @@  import Statistics.Matrix hiding (map) import Statistics.Matrix.Algorithms-import Test.Framework (Test, testGroup)-import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.QuickCheck (testProperty) import Test.QuickCheck-import Tests.ApproxEq (ApproxEq(..)) import Tests.Matrix.Types import qualified Data.Vector.Unboxed as U @@ -27,13 +26,24 @@ t_transpose m = U.concat (map (column n) [0..rows m-1]) === toVector m   where n = transpose m -t_qr :: Matrix -> Property-t_qr a = hasNaN p .||. eql 1e-10 a p-  where p = uncurry multiply (qr a)+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 :: Test-tests = testGroup "Matrix" [-    testProperty "t_row" t_row+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
tests/Tests/Matrix/Types.hs view
@@ -6,6 +6,8 @@       Mat(..)     , fromMat     , toMat+    , arbMat+    , arbMatWith     ) where  import Control.Monad (join)@@ -23,7 +25,7 @@ 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+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 []       = []@@ -32,10 +34,21 @@     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 (Positive (Small r)) (Positive (Small c)) =-    Mat r c <$> vectorOf r (vector c)+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
tests/Tests/NonParametric.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ViewPatterns     #-} -- Tests for Statistics.Test.NonParametric module Tests.NonParametric (tests) where @@ -6,16 +8,18 @@ import Statistics.Test.MannWhitneyU import Statistics.Test.KruskalWallis import Statistics.Test.WilcoxonT-import Test.Framework (Test, testGroup)-import Test.Framework.Providers.HUnit-import Test.HUnit (assertEqual)-import Tests.ApproxEq (eq)-import Tests.Helpers (testAssertion, testEquality)+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 :: Test+tests :: Tst.TestTree tests = testGroup "Nonparametric tests"         $ concat [ mannWhitneyTests                  , wilcoxonSumTests@@ -27,20 +31,20 @@  ---------------------------------------------------------------- -mannWhitneyTests :: [Test]+mannWhitneyTests :: [Tst.TestTree] 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]]+      [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) 0.025 | x <- [1..20]]+      [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) 0.05 | x <- [1..20]]+      [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) 0.025 | x <- [1..20]]+      [mannWhitneyUCriticalValue (20,x) (mkPValue 0.025) | x <- [1..20]]   ]   where     test n (a, b, c, d)@@ -49,7 +53,7 @@           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+        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]@@ -84,7 +88,7 @@                  )                ] -wilcoxonSumTests :: [Test]+wilcoxonSumTests :: [Tst.TestTree] wilcoxonSumTests = zipWith test [(0::Int)..] testData   where     test n (a, b, c) = testCase "Wilcoxon Sum"@@ -101,62 +105,64 @@                  )                ] -wilcoxonPairTests :: [Test]+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 0.05 | x <- [1..27]]+      [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 0.025 | x <- [1..27]]+      [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 0.01 | x <- [1..27]]+      [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 0.005 | x <- [1..27]]+      [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.fromList a) (U.fromList b))+      where res = wilcoxonMatchedPairSignedRank (U.zip (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)))+    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]-                 , ( sum $ filter (> 0) [7,-3,1.5,9,0,-4,8,-6,1.5,-5]+                 , ( 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]-                 , (18, -3)+                 , (6, 18, -3)                  )                , ( [130,170,125,170,130,130,145,160]                  , [120,163,120,135,143,136,144,120]-                 , (27, -9)+                 , (8, 27, -9)                  )                , ( [540,580,600,680,430,740,600,690,605,520]                  , [760,710,1105,880,500,990,1050,640,595,520]-                 , (3, -42)+                 , (9, 3, -42)                  )                ]-    to4dp tgt x = x >= tgt - 0.00005 && x < tgt + 0.00005+    to4dp tgt (pValue -> x) = x >= tgt - 0.00005 && x < tgt + 0.00005  ---------------------------------------------------------------- -kruskalWallisRankTests :: [Test]+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]@@ -170,18 +176,19 @@                  )                ] -kruskalWallisTests :: [Test]+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 = kruskalWallisTest 0.05 $ map U.fromList a+        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]@@ -220,7 +227,7 @@ ----------------------------------------------------------------  -kolmogorovSmirnovDTest :: [Test]+kolmogorovSmirnovDTest :: [Tst.TestTree] kolmogorovSmirnovDTest =   [ testAssertion "K-S D statistics" $     and [ eq 1e-6 (kolmogorovSmirnovD standard (toU sample)) reference@@ -291,3 +298,6 @@       , (0.392          ,   30, 0.99988478803318    )       , (0.09           ,  100, 0.629367974413669   )       ]++p005 :: PValue Double+p005 = mkPValue 0.05
+ 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
@@ -8,13 +8,13 @@  import Data.Bits ((.&.), shiftL) import Data.Complex (Complex((:+)))-import Data.Functor ((<$>)) import Numeric.Sum (kbn, sumVector) import Statistics.Function (within) import Statistics.Transform (CD, dct, fft, idct, ifft)-import Test.Framework (Test, testGroup)-import Test.Framework.Providers.QuickCheck2 (testProperty)-import Test.QuickCheck (Positive(..), Arbitrary(..), Gen, choose, vectorOf, counterexample)+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)@@ -22,7 +22,7 @@ import qualified Data.Vector.Unboxed as U  -tests :: Test+tests :: TestTree tests = testGroup "fft" [           testProperty "t_impulse"        t_impulse         , testProperty "t_impulse_offset" t_impulse_offset@@ -68,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) = U.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@@ -83,15 +86,14 @@ -- 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 = MkProperty $ do-  x <- genFftVector-  let n  = G.length x-      x' = roundtrip x-      d  = G.zipWith (-) x x'-      nd = vectorNorm d-      nx = vectorNorm x-  unProperty-     $ counterexample "Original vector"+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')@@ -100,13 +102,13 @@      $ 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
+ tests/doctest.hs view
@@ -0,0 +1,5 @@+import Test.DocTest (doctest)++main :: IO ()+main = doctest ["-XHaskell2010", "Statistics"]+
tests/tests.hs view
@@ -1,18 +1,26 @@-import Test.Framework (defaultMain)-import qualified Tests.Distribution as Distribution-import qualified Tests.Function as Function-import qualified Tests.KDE as KDE-import qualified Tests.Matrix as Matrix-import qualified Tests.NonParametric as NonParametric-import qualified Tests.Transform as Transform-import qualified Tests.Correlation as Correlation+import Test.Tasty (defaultMain,testGroup) +import qualified Tests.Distribution+import qualified Tests.Function+import qualified Tests.KDE+import qualified Tests.Matrix+import qualified Tests.NonParametric+import qualified Tests.Parametric+import qualified Tests.Transform+import qualified Tests.Correlation+import qualified Tests.Serialization+import qualified Tests.Quantile+ main :: IO ()-main = defaultMain [ Distribution.tests-                   , Function.tests-                   , KDE.tests-                   , Matrix.tests-                   , NonParametric.tests-                   , Transform.tests-                   , Correlation.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+  ]