packages feed

statistics-skinny (empty) → 0.15.2.0

raw patch · 76 files changed

+10185/−0 lines, 76 filesdep +QuickCheckdep +asyncdep +basesetup-changed

Dependencies added: QuickCheck, async, base, base-orphans, data-default-class, deepseq, dense-linear-algebra, erf, ghc-prim, ieee754, math-functions, monad-par, mwc-random, primitive, statistics-skinny, tasty, tasty-expected-failure, tasty-hunit, tasty-quickcheck, vector, vector-algorithms, vector-th-unbox

Files

+ LICENSE view
@@ -0,0 +1,26 @@+Copyright (c) 2009, 2010 Bryan O'Sullivan+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.markdown view
@@ -0,0 +1,30 @@+# Statistics: efficient, general purpose statistics++This package provides the Statistics module, a Haskell library for+working with statistical data in a space- and time-efficient way.++Where possible, we give citations and computational complexity+estimates for the algorithms used.+++# Performance++This library has been carefully optimised for high performance.  To+obtain the best runtime efficiency, it is imperative to compile+libraries and applications that use this library using a high level of+optimisation.+++# Get involved!++Please report bugs via the+[github issue tracker](https://github.com/bos/statistics/issues).++Master [git mirror](https://github.com/bos/statistics):++* `git clone git://github.com/bos/statistics.git`++# Authors++This library is written by Bryan O'Sullivan,+<bos@serpentine.com>.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ Statistics/Autocorrelation.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE FlexibleContexts #-}+-- |+-- Module    : Statistics.Autocorrelation+-- Copyright : (c) 2009 Bryan O'Sullivan+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Functions for computing autocovariance and autocorrelation of a+-- sample.++module Statistics.Autocorrelation+    (+      autocovariance+    , autocorrelation+    ) where++import Prelude hiding (sum)+import Statistics.Function (square)+import Statistics.Sample (mean)+import Statistics.Sample.Internal (sum)+import qualified Data.Vector.Generic as G++-- | Compute the autocovariance of a sample, i.e. the covariance of+-- the sample against a shifted version of itself.+autocovariance :: (G.Vector v Double, G.Vector v Int) => v Double -> v Double+autocovariance a = G.map f . G.enumFromTo 0 $ l-2+  where+    f k = sum (G.zipWith (*) (G.take (l-k) c) (G.slice k (l-k) c))+          / fromIntegral l+    c   = G.map (subtract (mean a)) a+    l   = G.length a++-- | Compute the autocorrelation function of a sample, and the upper+-- and lower bounds of confidence intervals for each element.+--+-- /Note/: The calculation of the 95% confidence interval assumes a+-- stationary Gaussian process.+autocorrelation :: (G.Vector v Double, G.Vector v Int) => v Double -> (v Double, v Double, v Double)+autocorrelation a = (r, ci (-), ci (+))+  where+    r           = G.map (/ G.head c) c+      where c   = autocovariance a+    dllse       = G.map f . G.scanl1 (+) . G.map square $ r+      where f v = 1.96 * sqrt ((v * 2 + 1) / l)+    l           = fromIntegral (G.length a)+    ci f        = G.cons 1 . G.tail . G.map (f (-1/l)) $ dllse
+ 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/Correlation.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE BangPatterns #-}+-- |+-- Module      : Statistics.Correlation.Pearson+--+module Statistics.Correlation+    ( -- * Pearson correlation+      pearson+    , pearsonMatByRow+      -- * Spearman correlation+    , spearman+    , spearmanMatByRow+    ) where++import qualified Data.Vector.Generic as G+import qualified Data.Vector.Unboxed as U+import Statistics.Matrix+import Statistics.Sample+import Statistics.Test.Internal (rankUnsorted)+++----------------------------------------------------------------+-- Pearson+----------------------------------------------------------------++-- | Pearson correlation for sample of pairs. Exactly same as+-- 'Statistics.Sample.correlation'+pearson :: (G.Vector v (Double, Double), G.Vector v Double)+        => v (Double, Double) -> Double+pearson = correlation+{-# INLINE pearson #-}++-- | Compute pairwise pearson correlation between rows of a matrix+pearsonMatByRow :: Matrix -> Matrix+pearsonMatByRow m+  = generateSym (rows m)+      (\i j -> pearson $ row m i `U.zip` row m j)+{-# INLINE pearsonMatByRow #-}++++----------------------------------------------------------------+-- Spearman+----------------------------------------------------------------++-- | compute spearman correlation between two samples+spearman :: ( Ord a+            , Ord b+            , G.Vector v a+            , G.Vector v b+            , G.Vector v (a, b)+            , G.Vector v Int+            , G.Vector v Double+            , G.Vector v (Double, Double)+            , G.Vector v (Int, a)+            , G.Vector v (Int, b)+            )+         => v (a, b)+         -> Double+spearman xy+  = pearson+  $ G.zip (rankUnsorted x) (rankUnsorted y)+  where+    (x, y) = G.unzip xy+{-# INLINE spearman #-}++-- | compute pairwise spearman correlation between rows of a matrix+spearmanMatByRow :: Matrix -> Matrix+spearmanMatByRow+  = pearsonMatByRow . fromRows . fmap rankUnsorted . toRows+{-# INLINE spearmanMatByRow #-}
+ Statistics/Correlation/Kendall.hs view
@@ -0,0 +1,144 @@+{-# LANGUAGE BangPatterns, CPP, FlexibleContexts #-}+-- |+-- Module      : Statistics.Correlation.Kendall+--+-- Fast O(NlogN) implementation of+-- <http://en.wikipedia.org/wiki/Kendall_tau_rank_correlation_coefficient Kendall's tau>.+--+-- This module implements Kendall's tau form b which allows ties in the data.+-- This is the same formula used by other statistical packages, e.g., R, matlab.+--+-- > \tau = \frac{n_c - n_d}{\sqrt{(n_0 - n_1)(n_0 - n_2)}}+--+-- where n_0 = n(n-1)\/2, n_1 = number of pairs tied for the first quantify,+-- n_2 = number of pairs tied for the second quantify,+-- n_c = number of concordant pairs$, n_d = number of discordant pairs.++module Statistics.Correlation.Kendall+    ( kendall++    -- * References+    -- $references+    ) where++import Control.Monad.ST (ST, runST)+import Data.Bits (shiftR)+import Data.Function (on)+import Data.STRef+import qualified Data.Vector.Algorithms.Intro as I+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Generic.Mutable as GM++-- | /O(nlogn)/ Compute the Kendall's tau from a vector of paired data.+-- Return NaN when number of pairs <= 1.+kendall :: (Ord a, Ord b, G.Vector v (a, b)) => v (a, b) -> Double+kendall xy'+  | G.length xy' <= 1 = 0/0+  | otherwise  = runST $ do+    xy <- G.thaw xy'+    let n = GM.length xy+    n_dRef <- newSTRef 0+    I.sort xy+    tieX <- numOfTiesBy ((==) `on` fst) xy+    tieXY <- numOfTiesBy (==) xy+    tmp <- GM.new n+    mergeSort (compare `on` snd) xy tmp n_dRef+    tieY <- numOfTiesBy ((==) `on` snd) xy+    n_d <- readSTRef n_dRef+    let n_0 = (fromIntegral n * (fromIntegral n-1)) `shiftR` 1 :: Integer+        n_c = n_0 - n_d - tieX - tieY + tieXY+    return $ fromIntegral (n_c - n_d) /+             (sqrt.fromIntegral) ((n_0 - tieX) * (n_0 - tieY))+{-# INLINE kendall #-}++-- calculate number of tied pairs in a sorted vector+numOfTiesBy :: GM.MVector v a+            => (a -> a -> Bool) -> v s a -> ST s Integer+numOfTiesBy f xs = do count <- newSTRef (0::Integer)+                      loop count (1::Int) (0::Int)+                      readSTRef count+  where+    n = GM.length xs+    loop c !acc !i | i >= n - 1 = modifySTRef' c (+ g acc)+                   | otherwise = do+                       x1 <- GM.unsafeRead xs i+                       x2 <- GM.unsafeRead xs (i+1)+                       if f x1 x2+                          then loop c (acc+1) (i+1)+                          else modifySTRef' c (+ g acc) >> loop c 1 (i+1)+    g x = fromIntegral ((x * (x - 1)) `shiftR` 1)+{-# INLINE numOfTiesBy #-}++-- Implementation of Knight's merge sort (adapted from vector-algorithm). This+-- function is used to count the number of discordant pairs.+mergeSort :: GM.MVector v e+          => (e -> e -> Ordering)+          -> v s e+          -> v s e+          -> STRef s Integer+          -> ST s ()+mergeSort cmp src buf count = loop 0 (GM.length src - 1)+  where+    loop l u+      | u == l = return ()+      | u - l == 1 = do+          eL <- GM.unsafeRead src l+          eU <- GM.unsafeRead src u+          case cmp eL eU of+              GT -> do GM.unsafeWrite src l eU+                       GM.unsafeWrite src u eL+                       modifySTRef' count (+1)+              _ -> return ()+      | otherwise  = do+          let mid = (u + l) `shiftR` 1+          loop l mid+          loop mid u+          merge cmp (GM.unsafeSlice l (u-l+1) src) buf (mid - l) count+{-# INLINE mergeSort #-}++merge :: GM.MVector v e+      => (e -> e -> Ordering)+      -> v s e+      -> v s e+      -> Int+      -> STRef s Integer+      -> ST s ()+merge cmp src buf mid count = do GM.unsafeCopy tmp lower+                                 eTmp <- GM.unsafeRead tmp 0+                                 eUpp <- GM.unsafeRead upper 0+                                 loop tmp 0 eTmp upper 0 eUpp 0+  where+    lower = GM.unsafeSlice 0 mid src+    upper = GM.unsafeSlice mid (GM.length src - mid) src+    tmp = GM.unsafeSlice 0 mid buf+    wroteHigh low iLow eLow high iHigh iIns+      | iHigh >= GM.length high =+          GM.unsafeCopy (GM.unsafeSlice iIns (GM.length low - iLow) src)+                        (GM.unsafeSlice iLow (GM.length low - iLow) low)+      | otherwise = do eHigh <- GM.unsafeRead high iHigh+                       loop low iLow eLow high iHigh eHigh iIns++    wroteLow low iLow high iHigh eHigh iIns+      | iLow  >= GM.length low  = return ()+      | otherwise = do eLow <- GM.unsafeRead low iLow+                       loop low iLow eLow high iHigh eHigh iIns++    loop !low !iLow !eLow !high !iHigh !eHigh !iIns = case cmp eHigh eLow of+        LT -> do GM.unsafeWrite src iIns eHigh+                 modifySTRef' count (+ fromIntegral (GM.length low - iLow))+                 wroteHigh low iLow eLow high (iHigh+1) (iIns+1)+        _  -> do GM.unsafeWrite src iIns eLow+                 wroteLow low (iLow+1) high iHigh eHigh (iIns+1)+{-# INLINE merge #-}++#if !MIN_VERSION_base(4,6,0)+modifySTRef' :: STRef s a -> (a -> a) -> ST s ()+modifySTRef' = modifySTRef+#endif++-- $references+--+-- * William R. Knight. (1966) A computer method for calculating Kendall's Tau+--   with ungrouped data. /Journal of the American Statistical Association/,+--   Vol. 61, No. 314, Part 1, pp. 436-439. <http://www.jstor.org/pss/2282833>+--
+ Statistics/Distribution.hs view
@@ -0,0 +1,233 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}+-- |+-- Module    : Statistics.Distribution+-- Copyright : (c) 2009 Bryan O'Sullivan+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Type classes for probability distributions++module Statistics.Distribution+    (+      -- * Type classes+      Distribution(..)+    , DiscreteDistr(..)+    , ContDistr(..)+      -- ** Distribution statistics+    , MaybeMean(..)+    , Mean(..)+    , MaybeVariance(..)+    , Variance(..)+    , MaybeEntropy(..)+    , Entropy(..)+    , FromSample(..)+      -- ** Random number generation+    , ContGen(..)+    , DiscreteGen(..)+    , genContinuous+    , genContinous+      -- * Helper functions+    , findRoot+    , sumProbabilities+    ) where++import Control.Applicative ((<$>), Applicative(..))+import Control.Monad.Primitive (PrimMonad,PrimState)+import Prelude hiding (sum)+import Statistics.Function (square)+import Statistics.Sample.Internal (sum)+import System.Random.MWC (Gen, uniform)+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Generic as G+++-- | Type class common to all distributions. Only c.d.f. could be+-- defined for both discrete and continuous distributions.+class Distribution d where+    -- | Cumulative distribution function.  The probability that a+    -- random variable /X/ is less or equal than /x/,+    -- i.e. P(/X/&#8804;/x/). Cumulative should be defined for+    -- infinities as well:+    --+    -- > cumulative d +∞ = 1+    -- > cumulative d -∞ = 0+    cumulative :: d -> Double -> Double++    -- | One's complement of cumulative distribution:+    --+    -- > complCumulative d x = 1 - cumulative d x+    --+    -- It's useful when one is interested in P(/X/>/x/) and+    -- expression on the right side begin to lose precision. This+    -- function have default implementation but implementors are+    -- encouraged to provide more precise implementation.+    complCumulative :: d -> Double -> Double+    complCumulative d x = 1 - cumulative d x++-- | 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+++-- | 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/+    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++    -- | 1-complement of @quantile@:+    --+    -- > complQuantile x ≡ quantile (1 - x)+    complQuantile :: d -> Double -> Double+    complQuantile d x = quantile d (1 - x)++    -- | Natural logarithm of density.+    logDensity :: d -> Double -> Double+    logDensity d = log . density d+++-- | Type class for distributions with mean. 'maybeMean' should return+--   'Nothing' if it's undefined for current value of data+class Distribution d => MaybeMean d where+    maybeMean :: d -> Maybe Double++-- | Type class for distributions with mean. If a distribution has+--   finite mean for all valid values of parameters it should be+--   instance of this type class.+class MaybeMean d => Mean d where+    mean :: d -> Double++++-- | Type class for distributions with variance. If variance is+--   undefined for some parameter values both 'maybeVariance' and+--   'maybeStdDev' should return Nothing.+--+--   Minimal complete definition is 'maybeVariance' or 'maybeStdDev'+class MaybeMean d => MaybeVariance d where+    maybeVariance :: d -> Maybe Double+    maybeVariance d = (*) <$> x <*> x where x = maybeStdDev d+    maybeStdDev   :: d -> Maybe Double+    maybeStdDev = fmap sqrt . maybeVariance++-- | Type class for distributions with variance. If distribution have+--   finite variance for all valid parameter values it should be+--   instance of this type class.+--+--   Minimal complete definition is 'variance' or 'stdDev'+class (Mean d, MaybeVariance d) => Variance d where+    variance :: d -> Double+    variance d = square (stdDev d)+    stdDev   :: d -> Double+    stdDev = sqrt . variance++-- | Type class for distributions with entropy, meaning Shannon entropy+--   in the case of a discrete distribution, or differential entropy in the+--   case of a continuous one.  'maybeEntropy' should return 'Nothing' if+--   entropy is undefined for the chosen parameter values.+class (Distribution d) => MaybeEntropy d where+  -- | Returns the entropy of a distribution, in nats, if such is defined.+  maybeEntropy :: d -> Maybe Double++-- | Type class for distributions with entropy, meaning Shannon+--   entropy in the case of a discrete distribution, or differential+--   entropy in the case of a continuous one.  If the distribution has+--   well-defined entropy for all valid parameter values then it+--   should be an instance of this type class.+class (MaybeEntropy d) => Entropy d where+  -- | Returns the entropy of a distribution, in nats.+  entropy :: d -> Double++-- | Generate discrete random variates which have given+--   distribution.+class Distribution d => ContGen d where+  genContVar :: PrimMonad m => d -> Gen (PrimState m) -> 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++-- | 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 is there's+  --   not enough data to estimate or sample clearly doesn't come from+  --   distribution in question. For example if there's negative+  --   samples in exponential distribution.+  fromSample :: G.Vector v a => v a -> Maybe d+++-- | Generate variates from continuous distribution using inverse+--   transform rule.+genContinuous :: (ContDistr d, PrimMonad m) => d -> Gen (PrimState m) -> m Double+genContinuous d gen = do+  x <- uniform gen+  return $! quantile d x++-- | Backwards compatibility with genContinuous.+genContinous :: (ContDistr d, PrimMonad m) => d -> Gen (PrimState m) -> m Double+genContinous = genContinuous+{-# DEPRECATED genContinous "Use genContinuous" #-}++data P = P {-# UNPACK #-} !Double {-# UNPACK #-} !Double++-- | Approximate the value of /X/ for which P(/x/>/X/)=/p/.+--+-- This method uses a combination of Newton-Raphson iteration and+-- bisection with the given guess as a starting point.  The upper and+-- lower bounds specify the interval in which the probability+-- distribution reaches the value /p/.+findRoot :: ContDistr d =>+            d                   -- ^ Distribution+         -> Double              -- ^ Probability /p/+         -> Double              -- ^ Initial guess+         -> Double              -- ^ Lower bound on interval+         -> Double              -- ^ Upper bound on interval+         -> Double+findRoot d prob = loop 0 1+  where+    loop !(i::Int) !dx !x !lo !hi+      | abs dx <= accuracy || i >= maxIters = x+      | otherwise                           = loop (i+1) dx'' x'' lo' hi'+      where+        err                   = cumulative d x - prob+        P lo' hi' | err < 0   = P x hi+                  | otherwise = P lo x+        pdf                   = density d x+        P dx' x' | pdf /= 0   = P (err / pdf) (x - dx)+                 | otherwise  = P dx x+        P dx'' x''+            | x' < lo' || x' > hi' || pdf == 0 = let y = (lo' + hi') / 2+                                                 in  P (y-x) y+            | otherwise                        = P dx' x'+    accuracy = 1e-15+    maxIters = 150++-- | Sum probabilities in inclusive interval.+sumProbabilities :: DiscreteDistr d => d -> Int -> Int -> Double+sumProbabilities d low hi =+  -- Return value is forced to be less than 1 to guard against roundoff errors.+  -- ATTENTION! this check should be removed for testing or it could mask bugs.+  min 1 . sum . U.map (probability d) $ U.enumFromTo low hi
+ Statistics/Distribution/Beta.hs view
@@ -0,0 +1,157 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Statistics.Distribution.Beta+-- Copyright   :  (C) 2012 Edward Kmett,+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  DeriveDataTypeable+--+----------------------------------------------------------------------------+module Statistics.Distribution.Beta+  ( BetaDistribution+    -- * Constructor+  , betaDistr+  , betaDistrE+  , improperBetaDistr+  , improperBetaDistrE+    -- * Accessors+  , bdAlpha+  , bdBeta+  ) where++import Control.Applicative+import Data.Data             (Data, Typeable)+import GHC.Generics          (Generic)+import Numeric.SpecFunctions (+  incompleteBeta, invIncompleteBeta, logBeta, digamma, log1p)+import Numeric.MathFunctions.Constants (m_NaN,m_neg_inf)+import qualified Statistics.Distribution as D+import Statistics.Internal+++-- | The beta distribution+data BetaDistribution = BD+ { bdAlpha :: {-# UNPACK #-} !Double+   -- ^ Alpha shape parameter+ , bdBeta  :: {-# UNPACK #-} !Double+   -- ^ Beta shape parameter+ } deriving (Eq, Typeable, Data, Generic)++instance Show BetaDistribution where+  showsPrec n (BD a b) = defaultShow2 "improperBetaDistr" a b n+instance Read BetaDistribution where+  readPrec = defaultReadPrecM2 "improperBetaDistr" improperBetaDistrE+++-- | Create beta distribution. Both shape parameters must be positive.+betaDistr :: Double             -- ^ Shape parameter alpha+          -> Double             -- ^ Shape parameter beta+          -> BetaDistribution+betaDistr a b = maybe (error $ errMsg a b) id $ betaDistrE a b++-- | Create beta distribution. Both shape parameters must be positive.+betaDistrE :: Double             -- ^ Shape parameter alpha+          -> Double             -- ^ Shape parameter beta+          -> Maybe BetaDistribution+betaDistrE a b+  | a > 0 && b > 0 = Just (BD a b)+  | otherwise      = Nothing++errMsg :: Double -> Double -> String+errMsg a b = "Statistics.Distribution.Beta.betaDistr: "+          ++ "shape parameters must be positive. Got a = "+          ++ show a+          ++ " b = "+          ++ show b+++-- | Create beta distribution. Both shape parameters must be+-- non-negative. So it allows to construct improper beta distribution+-- which could be used as improper prior.+improperBetaDistr :: Double             -- ^ Shape parameter alpha+                  -> Double             -- ^ Shape parameter beta+                  -> BetaDistribution+improperBetaDistr a b+  = maybe (error $ errMsgI a b) id $ improperBetaDistrE a b++-- | Create beta distribution. Both shape parameters must be+-- non-negative. So it allows to construct improper beta distribution+-- which could be used as improper prior.+improperBetaDistrE :: Double             -- ^ Shape parameter alpha+                   -> Double             -- ^ Shape parameter beta+                   -> Maybe BetaDistribution+improperBetaDistrE a b+  | a >= 0 && b >= 0 = Just (BD a b)+  | otherwise        = Nothing++errMsgI :: Double -> Double -> String+errMsgI a b+  =  "Statistics.Distribution.Beta.betaDistr: "+  ++ "shape parameters must be non-negative. Got a = " ++ show a+  ++ " b = " ++ show b++++instance D.Distribution BetaDistribution where+  cumulative (BD a b) x+    | x <= 0    = 0+    | x >= 1    = 1+    | otherwise = incompleteBeta a b x+  complCumulative (BD a b) x+    | x <= 0    = 1+    | x >= 1    = 0+    -- For small x we use direct computation to avoid precision loss+    -- when computing (1-x)+    | x <  0.5  = 1 - incompleteBeta a b x+    -- Otherwise we use property of incomplete beta:+    --  > I(x,a,b) = 1 - I(1-x,b,a)+    | otherwise = incompleteBeta b a (1-x)++instance D.Mean BetaDistribution where+  mean (BD a b) = a / (a + b)++instance D.MaybeMean BetaDistribution where+  maybeMean = Just . D.mean++instance D.Variance BetaDistribution where+  variance (BD a b) = a*b / (apb*apb*(apb+1))+    where apb = a + b++instance D.MaybeVariance BetaDistribution where+  maybeVariance = Just . D.variance++instance D.Entropy BetaDistribution where+  entropy (BD a b) =+    logBeta a b+    - (a-1) * digamma a+    - (b-1) * digamma b+    + (a+b-2) * digamma (a+b)++instance D.MaybeEntropy BetaDistribution where+  maybeEntropy = Just . D.entropy++instance D.ContDistr BetaDistribution where+  density (BD a b) x+    | a <= 0 || b <= 0 = m_NaN+    | x <= 0 = 0+    | x >= 1 = 0+    | otherwise = exp $ (a-1)*log x + (b-1) * log1p (-x) - logBeta a b+  logDensity (BD a b) x+    | a <= 0 || b <= 0 = m_NaN+    | x <= 0 = m_neg_inf+    | x >= 1 = m_neg_inf+    | otherwise = (a-1)*log x + (b-1)*log1p (-x) - logBeta a b++  quantile (BD a b) p+    | p == 0         = 0+    | p == 1         = 1+    | p > 0 && p < 1 = invIncompleteBeta a b p+    | otherwise      =+        error $ "Statistics.Distribution.Gamma.quantile: p must be in [0,1] range. Got: "++show p++instance D.ContGen BetaDistribution where+  genContVar = D.genContinuous
+ Statistics/Distribution/Binomial.hs view
@@ -0,0 +1,148 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}+-- |+-- Module    : Statistics.Distribution.Binomial+-- Copyright : (c) 2009 Bryan O'Sullivan+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- The binomial distribution.  This is the discrete probability+-- distribution of the number of successes in a sequence of /n/+-- independent yes\/no experiments, each of which yields success with+-- probability /p/.++module Statistics.Distribution.Binomial+    (+      BinomialDistribution+    -- * Constructors+    , binomial+    , binomialE+    -- * Accessors+    , bdTrials+    , bdProbability+    ) where++import Control.Applicative+import Data.Data             (Data, Typeable)+import GHC.Generics          (Generic)+import Numeric.SpecFunctions           (choose,logChoose,incompleteBeta,log1p)+import Numeric.MathFunctions.Constants (m_epsilon)++import qualified Statistics.Distribution as D+import qualified Statistics.Distribution.Poisson.Internal as I+import Statistics.Internal+++-- | The binomial distribution.+data BinomialDistribution = BD {+      bdTrials      :: {-# UNPACK #-} !Int+    -- ^ Number of trials.+    , bdProbability :: {-# UNPACK #-} !Double+    -- ^ Probability.+    } deriving (Eq, Typeable, Data, Generic)++instance Show BinomialDistribution where+  showsPrec i (BD n p) = defaultShow2 "binomial" n p i+instance Read BinomialDistribution where+  readPrec = defaultReadPrecM2 "binomial" binomialE+++instance D.Distribution BinomialDistribution where+    cumulative = cumulative++instance D.DiscreteDistr BinomialDistribution where+    probability    = probability+    logProbability = logProbability++instance D.Mean BinomialDistribution where+    mean = mean++instance D.Variance BinomialDistribution where+    variance = variance++instance D.MaybeMean BinomialDistribution where+    maybeMean = Just . D.mean++instance D.MaybeVariance BinomialDistribution where+    maybeStdDev   = Just . D.stdDev+    maybeVariance = Just . D.variance++instance D.Entropy BinomialDistribution where+  entropy (BD n p)+    | n == 0 = 0+    | n <= 100 = directEntropy (BD n p)+    | otherwise = I.poissonEntropy (fromIntegral n * p)++instance D.MaybeEntropy BinomialDistribution where+  maybeEntropy = Just . D.entropy++-- This could be slow for big n+probability :: BinomialDistribution -> Int -> Double+probability (BD n p) k+  | k < 0 || k > n = 0+  | n == 0         = 1+    -- choose could overflow Double for n >= 1030 so we switch to+    -- log-domain to calculate probability+  | n < 1000       = choose n k * p^k * (1-p)^(n-k)+  | otherwise      = exp $ logChoose n k + log p * k' + log1p (-p) * nk'+  where+    k'  = fromIntegral k+    nk' = fromIntegral $ n - k++logProbability :: BinomialDistribution -> Int -> Double+logProbability (BD n p) k+  | k < 0 || k > n          = (-1)/0+  | n == 0                  = 0+  | otherwise               = logChoose n k + log p * k' + log1p (-p) * nk'+  where+    k'  = fromIntegral   k+    nk' = fromIntegral $ n - k++-- Summation from different sides required to reduce roundoff errors+cumulative :: BinomialDistribution -> Double -> Double+cumulative (BD n p) x+  | isNaN x      = error "Statistics.Distribution.Binomial.cumulative: NaN input"+  | isInfinite x = if x > 0 then 1 else 0+  | k <  0       = 0+  | k >= n       = 1+  | otherwise    = incompleteBeta (fromIntegral (n-k)) (fromIntegral (k+1)) (1 - p)+  where+    k = floor x++mean :: BinomialDistribution -> Double+mean (BD n p) = fromIntegral n * p++variance :: BinomialDistribution -> Double+variance (BD n p) = fromIntegral n * p * (1 - p)++directEntropy :: BinomialDistribution -> Double+directEntropy d@(BD n _) =+  negate . sum $+  takeWhile (< negate m_epsilon) $+  dropWhile (not . (< negate m_epsilon)) $+  [ let x = probability d k in x * log x | k <- [0..n]]++-- | Construct binomial distribution. Number of trials must be+--   non-negative and probability must be in [0,1] range+binomial :: Int                 -- ^ Number of trials.+         -> Double              -- ^ Probability.+         -> BinomialDistribution+binomial n p = 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
@@ -0,0 +1,105 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}+-- |+-- Module    : Statistics.Distribution.CauchyLorentz+-- Copyright : (c) 2011 Aleksey Khudyakov+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- The Cauchy-Lorentz distribution. It's also known as Lorentz+-- distribution or Breit–Wigner distribution.+--+-- It doesn't have mean and variance.+module Statistics.Distribution.CauchyLorentz (+    CauchyDistribution+  , cauchyDistribMedian+  , cauchyDistribScale+    -- * Constructors+  , cauchyDistribution+  , cauchyDistributionE+  , standardCauchy+  ) where++import Control.Applicative+import Data.Maybe             (fromMaybe)+import Data.Data              (Data, Typeable)+import GHC.Generics           (Generic)+import qualified Statistics.Distribution as D+import Statistics.Internal++-- | Cauchy-Lorentz distribution.+data CauchyDistribution = CD {+    -- | Central value of Cauchy-Lorentz distribution which is its+    --   mode and median. Distribution doesn't have mean so function+    --   is named after median.+    cauchyDistribMedian :: {-# UNPACK #-} !Double+    -- | Scale parameter of Cauchy-Lorentz distribution. It's+    --   different from variance and specify half width at half+    --   maximum (HWHM).+  , cauchyDistribScale  :: {-# UNPACK #-} !Double+  }+  deriving (Eq, Typeable, Data, Generic)++instance Show CauchyDistribution where+  showsPrec i (CD m s) = defaultShow2 "cauchyDistribution" m s i+instance Read CauchyDistribution where+  readPrec = defaultReadPrecM2 "cauchyDistribution" cauchyDistributionE+++-- | Cauchy distribution+cauchyDistribution :: Double    -- ^ Central point+                   -> Double    -- ^ Scale parameter (FWHM)+                   -> CauchyDistribution+cauchyDistribution m s+  = fromMaybe (error $ errMsg m s)+  $ cauchyDistributionE m s+++-- | Cauchy distribution+cauchyDistributionE :: Double    -- ^ Central point+                    -> Double    -- ^ Scale parameter (FWHM)+                    -> Maybe CauchyDistribution+cauchyDistributionE m s+  | s > 0     = Just (CD m s)+  | otherwise = Nothing++errMsg :: Double -> Double -> String+errMsg _ s+  = "Statistics.Distribution.CauchyLorentz.cauchyDistribution: FWHM must be positive. Got "+  ++ show s++-- | Standard Cauchy distribution. It's centered at 0 and have 1 FWHM+standardCauchy :: CauchyDistribution+standardCauchy = CD 0 1+++instance D.Distribution CauchyDistribution where+  cumulative (CD m s) x = 0.5 + atan( (x - m) / s ) / pi++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+  complQuantile (CD m s) p+    | p > 0 && p < 1 = m + s * tan( pi * (0.5 - p) )+    | p == 0         =  1 / 0+    | p == 1         = -1 / 0+    | otherwise      =+      error $ "Statistics.Distribution.CauchyLorentz.complQuantile: p must be in [0,1] range. Got: "++show p++instance D.ContGen CauchyDistribution where+  genContVar = D.genContinuous++instance D.Entropy CauchyDistribution where+  entropy (CD _ s) = log s + log (4*pi)++instance D.MaybeEntropy CauchyDistribution where+  maybeEntropy = Just . D.entropy
+ Statistics/Distribution/ChiSquared.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}+-- |+-- Module    : Statistics.Distribution.ChiSquared+-- Copyright : (c) 2010 Alexey Khudyakov+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- The chi-squared distribution. This is a continuous probability+-- distribution of sum of squares of k independent standard normal+-- distributions. It's commonly used in statistical tests+module Statistics.Distribution.ChiSquared (+          ChiSquared+        , chiSquaredNDF+        -- * Constructors+        , chiSquared+        , chiSquaredE+        ) where++import Control.Applicative+import Data.Data             (Data, Typeable)+import GHC.Generics          (Generic)+import Numeric.SpecFunctions ( incompleteGamma,invIncompleteGamma,logGamma,digamma)+import Numeric.MathFunctions.Constants (m_neg_inf)+import qualified System.Random.MWC.Distributions as MWC++import qualified Statistics.Distribution         as D+import Statistics.Internal++++-- | Chi-squared distribution+newtype ChiSquared = ChiSquared+  { chiSquaredNDF :: Int+    -- ^ Get number of degrees of freedom+  }+  deriving (Eq, Typeable, Data, Generic)++instance Show ChiSquared where+  showsPrec i (ChiSquared n) = defaultShow1 "chiSquared" n i+instance Read ChiSquared where+  readPrec = defaultReadPrecM1 "chiSquared" chiSquaredE++-- | Construct chi-squared distribution. Number of degrees of freedom+--   must be positive.+chiSquared :: Int -> ChiSquared+chiSquared n = maybe (error $ errMsg n) id $ chiSquaredE n++-- | Construct chi-squared distribution. Number of degrees of freedom+--   must be positive.+chiSquaredE :: Int -> Maybe ChiSquared+chiSquaredE n+  | n <= 0    = Nothing+  | otherwise = Just (ChiSquared n)++errMsg :: Int -> String+errMsg n = "Statistics.Distribution.ChiSquared.chiSquared: N.D.F. must be positive. Got " ++ show n++instance D.Distribution ChiSquared where+  cumulative = cumulative++instance D.ContDistr ChiSquared where+  density chi x+    | x <= 0    = 0+    | otherwise = exp $ log x * (ndf2 - 1) - x2 - logGamma ndf2 - log 2 * ndf2+    where+      ndf  = fromIntegral $ chiSquaredNDF chi+      ndf2 = ndf/2+      x2   = x/2++  logDensity chi x+    | x <= 0    = m_neg_inf+    | otherwise = log x * (ndf2 - 1) - x2 - logGamma ndf2 - log 2 * ndf2+    where+      ndf  = fromIntegral $ chiSquaredNDF chi+      ndf2 = ndf/2+      x2   = x/2++  quantile = quantile++instance D.Mean ChiSquared where+    mean (ChiSquared ndf) = fromIntegral ndf++instance D.Variance ChiSquared where+    variance (ChiSquared ndf) = fromIntegral (2*ndf)++instance D.MaybeMean ChiSquared where+    maybeMean = Just . D.mean++instance D.MaybeVariance ChiSquared where+    maybeStdDev   = Just . D.stdDev+    maybeVariance = Just . D.variance++instance D.Entropy ChiSquared where+  entropy (ChiSquared ndf) =+    let kHalf = 0.5 * fromIntegral ndf in+    kHalf+    + log 2+    + logGamma kHalf+    + (1-kHalf) * digamma kHalf++instance D.MaybeEntropy ChiSquared where+  maybeEntropy = Just . D.entropy++instance D.ContGen ChiSquared where+    genContVar (ChiSquared n) = MWC.chiSquare n+++cumulative :: ChiSquared -> Double -> Double+cumulative chi x+  | x <= 0    = 0+  | otherwise = incompleteGamma (ndf/2) (x/2)+  where+    ndf = fromIntegral $ chiSquaredNDF chi++quantile :: ChiSquared -> Double -> Double+quantile (ChiSquared ndf) p+  | p == 0         = 0+  | p == 1         = 1/0+  | p > 0 && p < 1 = 2 * invIncompleteGamma (fromIntegral ndf / 2) p+  | otherwise      =+    error $ "Statistics.Distribution.ChiSquared.quantile: p must be in [0,1] range. Got: "++show p
+ Statistics/Distribution/DiscreteUniform.hs view
@@ -0,0 +1,98 @@+{-# 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.Data    (Data, Typeable)+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 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++-- | 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
@@ -0,0 +1,131 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}+-- |+-- Module    : Statistics.Distribution.Exponential+-- Copyright : (c) 2009 Bryan O'Sullivan+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- 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.++module Statistics.Distribution.Exponential+    (+      ExponentialDistribution+    -- * Constructors+    , exponential+    , exponentialE+    -- * Accessors+    , edLambda+    ) where++import Control.Applicative+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 Data.Vector.Generic as G++import qualified Statistics.Distribution         as D+import qualified Statistics.Sample               as S+import Statistics.Internal++++newtype ExponentialDistribution = ED {+      edLambda :: Double+    } deriving (Eq, Typeable, Data, Generic)++instance Show ExponentialDistribution where+  showsPrec n (ED l) = defaultShow1 "exponential" l n+instance Read ExponentialDistribution where+  readPrec = defaultReadPrecM1 "exponential" exponentialE++instance D.Distribution ExponentialDistribution where+    cumulative      = cumulative+    complCumulative = complCumulative++instance D.ContDistr ExponentialDistribution where+    density (ED l) x+      | x < 0     = 0+      | otherwise = l * exp (-l * x)+    logDensity (ED l) x+      | x < 0     = m_neg_inf+      | otherwise = log l + (-l * x)+    quantile      = quantile+    complQuantile = complQuantile++instance D.Mean ExponentialDistribution where+    mean (ED l) = 1 / l++instance D.Variance ExponentialDistribution where+    variance (ED l) = 1 / (l * l)++instance D.MaybeMean ExponentialDistribution where+    maybeMean = Just . D.mean++instance D.MaybeVariance ExponentialDistribution where+    maybeStdDev   = Just . D.stdDev+    maybeVariance = Just . D.variance++instance D.Entropy ExponentialDistribution where+  entropy (ED l) = 1 - log l++instance D.MaybeEntropy ExponentialDistribution where+  maybeEntropy = Just . D.entropy++instance D.ContGen ExponentialDistribution where+  genContVar = MWC.exponential . edLambda++cumulative :: ExponentialDistribution -> Double -> Double+cumulative (ED l) x | x <= 0    = 0+                    | otherwise = - expm1 (-l * x)++complCumulative :: ExponentialDistribution -> Double -> Double+complCumulative (ED l) x | x <= 0    = 1+                         | otherwise = exp (-l * x)+++quantile :: ExponentialDistribution -> Double -> Double+quantile (ED l) p+  | p >= 0 && p <= 1 = - log1p(-p) / l+  | otherwise        =+    error $ "Statistics.Distribution.Exponential.quantile: p must be in [0,1] range. Got: "++show p++complQuantile :: ExponentialDistribution -> Double -> Double+complQuantile (ED l) p+  | p == 0          = 0+  | p >= 0 && p < 1 = -log p / l+  | otherwise       =+    error $ "Statistics.Distribution.Exponential.quantile: p must be in [0,1] range. Got: "++show p++-- | Create an exponential distribution.+exponential :: Double            -- ^ Rate parameter.+            -> ExponentialDistribution+exponential l = maybe (error $ errMsg l) id $ exponentialE l++-- | Create an exponential distribution.+exponentialE :: Double            -- ^ Rate parameter.+             -> Maybe ExponentialDistribution+exponentialE l+  | l > 0     = Just (ED l)+  | otherwise = Nothing++errMsg :: Double -> String+errMsg l = "Statistics.Distribution.Exponential.exponential: scale parameter must be positive. Got " ++ show l++-- | Create exponential distribution from sample. Returns @Nothing@ if+--   sample is empty or contains negative elements. No other tests are+--   made to check whether it truly is exponential.+instance D.FromSample ExponentialDistribution Double where+  fromSample xs+    | G.null xs       = Nothing+    | G.all (>= 0) xs = Nothing+    | otherwise       = Just $! ED (S.mean xs)
+ Statistics/Distribution/FDistribution.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}+-- |+-- Module    : Statistics.Distribution.FDistribution+-- Copyright : (c) 2011 Aleksey Khudyakov+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Fisher F distribution+module Statistics.Distribution.FDistribution (+    FDistribution+    -- * Constructors+  , fDistribution+  , fDistributionE+  , fDistributionReal+  , fDistributionRealE+    -- * Accessors+  , fDistributionNDF1+  , fDistributionNDF2+  ) where++import Control.Applicative+import Data.Data              (Data, Typeable)+import GHC.Generics           (Generic)+import Numeric.SpecFunctions (+  logBeta, incompleteBeta, invIncompleteBeta, digamma)+import Numeric.MathFunctions.Constants (m_neg_inf)++import qualified Statistics.Distribution as D+import Statistics.Function (square)+import Statistics.Internal+++-- | F distribution+data FDistribution = F { fDistributionNDF1 :: {-# UNPACK #-} !Double+                       , fDistributionNDF2 :: {-# UNPACK #-} !Double+                       , _pdfFactor        :: {-# UNPACK #-} !Double+                       }+                   deriving (Eq, Typeable, Data, Generic)++instance Show FDistribution where+  showsPrec i (F n m _) = defaultShow2 "fDistributionReal" n m i+instance Read FDistribution where+  readPrec = defaultReadPrecM2 "fDistributionReal" fDistributionRealE++fDistribution :: Int -> Int -> FDistribution+fDistribution n m = maybe (error $ errMsg n m) id $ fDistributionE n m++fDistributionReal :: Double -> Double -> FDistribution+fDistributionReal n m = maybe (error $ errMsgR n m) id $ fDistributionRealE n m++fDistributionE :: Int -> Int -> Maybe FDistribution+fDistributionE n m+  | n > 0 && m > 0 =+    let n' = fromIntegral n+        m' = fromIntegral m+        f' = 0.5 * (log m' * m' + log n' * n') - logBeta (0.5*n') (0.5*m')+    in Just $ F n' m' f'+  | otherwise = Nothing++fDistributionRealE :: Double -> Double -> Maybe FDistribution+fDistributionRealE n m+  | n > 0 && m > 0 =+    let f' = 0.5 * (log m * m + log n * n) - logBeta (0.5*n) (0.5*m)+    in Just $ F n m f'+  | otherwise = Nothing++errMsg :: Int -> Int -> String+errMsg _ _ = "Statistics.Distribution.FDistribution.fDistribution: non-positive number of degrees of freedom"++errMsgR :: Double -> Double -> String+errMsgR _ _ = "Statistics.Distribution.FDistribution.fDistribution: non-positive number of degrees of freedom"++++instance D.Distribution FDistribution where+  cumulative      = cumulative+  complCumulative = complCumulative++instance D.ContDistr FDistribution where+  density d x+    | x <= 0    = 0+    | otherwise = exp $ logDensity d x+  logDensity d x+    | x <= 0    = m_neg_inf+    | otherwise = logDensity d x+  quantile = quantile++cumulative :: FDistribution -> Double -> Double+cumulative (F n m _) x+  | x <= 0       = 0+  -- Only matches +∞+  | isInfinite x = 1+  -- NOTE: Here we rely on implementation detail of incompleteBeta. It+  --       computes using series expansion for sufficiently small x+  --       and uses following identity otherwise:+  --+  --           I(x; a, b) = 1 - I(1-x; b, a)+  --+  --       Point is we can compute 1-x as m/(m+y) without loss of+  --       precision for large x. Sadly this switchover point is+  --       implementation detail.+  | n >= (n+m)*bx = incompleteBeta (0.5 * n) (0.5 * m) bx+  | otherwise     = 1 - incompleteBeta (0.5 * m) (0.5 * n) bx1+  where+    y   = n * x+    bx  = y / (m + y)+    bx1 = m / (m + y)++complCumulative :: FDistribution -> Double -> Double+complCumulative (F n m _) x+  | x <= 0        = 1+  -- Only matches +∞+  | isInfinite x  = 0+  -- See NOTE at cumulative+  | m >= (n+m)*bx = incompleteBeta (0.5 * m) (0.5 * n) bx+  | otherwise     = 1 - incompleteBeta (0.5 * n) (0.5 * m) bx1+  where+    y   = n*x+    bx  = m / (m + y)+    bx1 = y / (m + y)++logDensity :: FDistribution -> Double -> Double+logDensity (F n m fac) x+  = fac + log x * (0.5 * n - 1) - log(m + n*x) * 0.5 * (n + m)++quantile :: FDistribution -> Double -> Double+quantile (F n m _) p+  | p >= 0 && p <= 1 =+    let x = invIncompleteBeta (0.5 * n) (0.5 * m) p+    in m * x / (n * (1 - x))+  | otherwise =+    error $ "Statistics.Distribution.Uniform.quantile: p must be in [0,1] range. Got: "++show p+++instance D.MaybeMean FDistribution where+  maybeMean (F _ m _) | m > 2     = Just $ m / (m - 2)+                      | otherwise = Nothing++instance D.MaybeVariance FDistribution where+  maybeStdDev (F n m _)+    | m > 4     = Just $ 2 * square m * (m + n - 2) / (n * square (m - 2) * (m - 4))+    | otherwise = Nothing++instance D.Entropy FDistribution where+  entropy (F n m _) =+    let nHalf = 0.5 * n+        mHalf = 0.5 * m in+    log (n/m)+    + logBeta nHalf mHalf+    + (1 - nHalf) * digamma nHalf+    - (1 + mHalf) * digamma mHalf+    + (nHalf + mHalf) * digamma (nHalf + mHalf)++instance D.MaybeEntropy FDistribution where+  maybeEntropy = Just . D.entropy++instance D.ContGen FDistribution where+  genContVar = D.genContinuous
+ Statistics/Distribution/Gamma.hs view
@@ -0,0 +1,161 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}+-- |+-- Module    : Statistics.Distribution.Gamma+-- Copyright : (c) 2009, 2011 Bryan O'Sullivan+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- The gamma distribution.  This is a continuous probability+-- distribution with two parameters, /k/ and &#977;. If /k/ is+-- integral, the distribution represents the sum of /k/ independent+-- exponentially distributed random variables, each of which has a+-- mean of &#977;.++module Statistics.Distribution.Gamma+    (+      GammaDistribution+    -- * Constructors+    , gammaDistr+    , gammaDistrE+    , improperGammaDistr+    , improperGammaDistrE+    -- * Accessors+    , gdShape+    , gdScale+    ) where++import Control.Applicative+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 Statistics.Distribution.Poisson.Internal as Poisson+import qualified Statistics.Distribution as D+import Statistics.Internal+++-- | The gamma distribution.+data GammaDistribution = GD {+      gdShape :: {-# UNPACK #-} !Double -- ^ Shape parameter, /k/.+    , gdScale :: {-# UNPACK #-} !Double -- ^ Scale parameter, &#977;.+    } deriving (Eq, Typeable, Data, Generic)++instance Show GammaDistribution where+  showsPrec i (GD k theta) = defaultShow2 "improperGammaDistr" k theta i+instance Read GammaDistribution where+  readPrec = defaultReadPrecM2 "improperGammaDistr" improperGammaDistrE+++-- | Create gamma distribution. Both shape and scale parameters must+-- be positive.+gammaDistr :: Double            -- ^ Shape parameter. /k/+           -> Double            -- ^ Scale parameter, &#977;.+           -> GammaDistribution+gammaDistr k theta+  = maybe (error $ errMsg k theta) id $ gammaDistrE k theta++errMsg :: Double -> Double -> String+errMsg k theta+  =  "Statistics.Distribution.Gamma.gammaDistr: "+  ++ "k=" ++ show k+  ++ "theta=" ++ show theta+  ++ " but must be positive"++-- | Create gamma distribution. Both shape and scale parameters must+-- be positive.+gammaDistrE :: Double            -- ^ Shape parameter. /k/+            -> Double            -- ^ Scale parameter, &#977;.+            -> Maybe GammaDistribution+gammaDistrE k theta+  | k > 0 && theta > 0 = Just (GD k theta)+  | otherwise          = Nothing+++-- | Create gamma distribution. Both shape and scale parameters must+-- be non-negative.+improperGammaDistr :: Double            -- ^ Shape parameter. /k/+                   -> Double            -- ^ Scale parameter, &#977;.+                   -> GammaDistribution+improperGammaDistr k theta+  = maybe (error $ errMsgI k theta) id $ improperGammaDistrE k theta++errMsgI :: Double -> Double -> String+errMsgI k theta+  =  "Statistics.Distribution.Gamma.gammaDistr: "+  ++ "k=" ++ show k+  ++ "theta=" ++ show theta+  ++ " but must be non-negative"++-- | Create gamma distribution. Both shape and scale parameters must+-- be non-negative.+improperGammaDistrE :: Double            -- ^ Shape parameter. /k/+                    -> Double            -- ^ Scale parameter, &#977;.+                    -> Maybe GammaDistribution+improperGammaDistrE k theta+  | k >= 0 && theta >= 0 = Just (GD k theta)+  | otherwise            = Nothing++instance D.Distribution GammaDistribution where+    cumulative = cumulative++instance D.ContDistr GammaDistribution where+    density    = density+    logDensity (GD k theta) x+      | x <= 0    = m_neg_inf+      | otherwise = log x * (k - 1) - (x / theta) - logGamma k - log theta * k+    quantile   = quantile++instance D.Variance GammaDistribution where+    variance (GD a l) = a * l * l++instance D.Mean GammaDistribution where+    mean (GD a l) = a * l++instance D.MaybeMean GammaDistribution where+    maybeMean = Just . D.mean++instance D.MaybeVariance GammaDistribution where+    maybeStdDev   = Just . D.stdDev+    maybeVariance = Just . D.variance++instance D.MaybeEntropy GammaDistribution where+  maybeEntropy (GD a l)+    | a > 0 && l > 0 =+      Just $+      a+      + log l+      + logGamma a+      + (1-a) * digamma a+    | otherwise = Nothing++instance D.ContGen GammaDistribution where+    genContVar (GD a l) = MWC.gamma a l+++density :: GammaDistribution -> Double -> Double+density (GD a l) x+  | a < 0 || l <= 0   = m_NaN+  | x <= 0            = 0+  | a == 0            = if x == 0 then m_pos_inf else 0+  | x == 0            = if a < 1 then m_pos_inf else if a > 1 then 0 else 1/l+  | a < 1             = Poisson.probability (x/l) a * a / x+  | otherwise         = Poisson.probability (x/l) (a-1) / l++cumulative :: GammaDistribution -> Double -> Double+cumulative (GD k l) x+  | x <= 0    = 0+  | otherwise = incompleteGamma k (x/l)++quantile :: GammaDistribution -> Double -> Double+quantile (GD k l) p+  | p == 0         = 0+  | p == 1         = 1/0+  | p > 0 && p < 1 = l * invIncompleteGamma k p+  | otherwise      =+    error $ "Statistics.Distribution.Gamma.quantile: p must be in [0,1] range. Got: "++show p
+ Statistics/Distribution/Geometric.hs view
@@ -0,0 +1,194 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}+-- |+-- Module    : Statistics.Distribution.Geometric+-- Copyright : (c) 2009 Bryan O'Sullivan+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- The Geometric distribution. There are two variants of+-- distribution. First is the probability distribution of the number+-- of Bernoulli trials needed to get one success, supported on the set+-- [1,2..] ('GeometricDistribution'). Sometimes it's referred to as+-- the /shifted/ geometric distribution to distinguish from another+-- one.+--+-- Second variant is probability distribution of the number of+-- failures before first success, defined over the set [0,1..]+-- ('GeometricDistribution0').+module Statistics.Distribution.Geometric+    (+      GeometricDistribution+    , GeometricDistribution0+    -- * Constructors+    , geometric+    , geometricE+    , geometric0+    , geometric0E+    -- ** Accessors+    , gdSuccess+    , gdSuccess0+    ) where++import Control.Applicative+import Control.Monad       (liftM)+import Data.Data           (Data, Typeable)+import GHC.Generics        (Generic)+import Numeric.MathFunctions.Constants (m_pos_inf, m_neg_inf)+import Numeric.SpecFunctions           (log1p,expm1)+import qualified System.Random.MWC.Distributions as MWC++import qualified Statistics.Distribution as D+import Statistics.Internal++++----------------------------------------------------------------++-- | Distribution over [1..]+newtype GeometricDistribution = GD {+      gdSuccess :: Double+    } deriving (Eq, Typeable, Data, Generic)++instance Show GeometricDistribution where+  showsPrec i (GD x) = defaultShow1 "geometric" x i+instance Read GeometricDistribution where+  readPrec = defaultReadPrecM1 "geometric" geometricE+++instance D.Distribution GeometricDistribution where+    cumulative      = cumulative+    complCumulative = complCumulative++instance D.DiscreteDistr GeometricDistribution where+    probability (GD s) n+      | n < 1     = 0+      | otherwise = s * (1-s) ** (fromIntegral n - 1)+    logProbability (GD s) n+       | n < 1     = m_neg_inf+       | otherwise = log s + log (1-s) * (fromIntegral n - 1)+++instance D.Mean GeometricDistribution where+    mean (GD s) = 1 / s++instance D.Variance GeometricDistribution where+    variance (GD s) = (1 - s) / (s * s)++instance D.MaybeMean GeometricDistribution where+    maybeMean = Just . D.mean++instance D.MaybeVariance GeometricDistribution where+    maybeStdDev   = Just . D.stdDev+    maybeVariance = Just . D.variance++instance D.Entropy GeometricDistribution where+  entropy (GD s)+    | s == 0 = m_pos_inf+    | s == 1 = 0+    | otherwise = negate $ (s * log s + (1-s) * log (1-s)) / s++instance D.MaybeEntropy GeometricDistribution where+  maybeEntropy = Just . D.entropy++instance D.DiscreteGen GeometricDistribution where+  genDiscreteVar (GD s) g = MWC.geometric1 s g++instance D.ContGen GeometricDistribution where+  genContVar d g = fromIntegral `liftM` D.genDiscreteVar d g++cumulative :: GeometricDistribution -> Double -> Double+cumulative (GD s) x+  | x < 1        = 0+  | isInfinite x = 1+  | isNaN      x = error "Statistics.Distribution.Geometric.cumulative: NaN input"+  | otherwise    = negate $ expm1 $ fromIntegral (floor x :: Int) * log1p (-s)++complCumulative :: GeometricDistribution -> Double -> Double+complCumulative (GD s) x+  | x < 1        = 1+  | isInfinite x = 0+  | isNaN      x = error "Statistics.Distribution.Geometric.cumulative: NaN input"+  | otherwise    = exp $ fromIntegral (floor x :: Int) * log1p (-s)+++-- | Create geometric distribution.+geometric :: Double                -- ^ Success rate+          -> GeometricDistribution+geometric x = maybe (error $ errMsg x) id $ geometricE x++-- | Create geometric distribution.+geometricE :: Double                -- ^ Success rate+           -> Maybe GeometricDistribution+geometricE x+  | x >= 0 && x <= 1 = Just (GD x)+  | otherwise        = Nothing++errMsg :: Double -> String+errMsg x = "Statistics.Distribution.Geometric.geometric: probability must be in [0,1] range. Got " ++ show x+++----------------------------------------------------------------++-- | Distribution over [0..]+newtype GeometricDistribution0 = GD0 {+      gdSuccess0 :: Double+    } deriving (Eq, Typeable, Data, Generic)++instance Show GeometricDistribution0 where+  showsPrec i (GD0 x) = defaultShow1 "geometric0" x i+instance Read GeometricDistribution0 where+  readPrec = defaultReadPrecM1 "geometric0" geometric0E+++instance D.Distribution GeometricDistribution0 where+    cumulative      (GD0 s) x = cumulative      (GD s) (x + 1)+    complCumulative (GD0 s) x = complCumulative (GD s) (x + 1)++instance D.DiscreteDistr GeometricDistribution0 where+    probability    (GD0 s) n = D.probability    (GD s) (n + 1)+    logProbability (GD0 s) n = D.logProbability (GD s) (n + 1)++instance D.Mean GeometricDistribution0 where+    mean (GD0 s) = 1 / s - 1++instance D.Variance GeometricDistribution0 where+    variance (GD0 s) = D.variance (GD s)++instance D.MaybeMean GeometricDistribution0 where+    maybeMean = Just . D.mean++instance D.MaybeVariance GeometricDistribution0 where+    maybeStdDev   = Just . D.stdDev+    maybeVariance = Just . D.variance++instance D.Entropy GeometricDistribution0 where+  entropy (GD0 s) = D.entropy (GD s)++instance D.MaybeEntropy GeometricDistribution0 where+  maybeEntropy = Just . D.entropy++instance D.DiscreteGen GeometricDistribution0 where+  genDiscreteVar (GD0 s) g = MWC.geometric0 s g++instance D.ContGen GeometricDistribution0 where+  genContVar d g = fromIntegral `liftM` D.genDiscreteVar d g+++-- | Create geometric distribution.+geometric0 :: Double                -- ^ Success rate+           -> GeometricDistribution0+geometric0 x = maybe (error $ errMsg0 x) id $ geometric0E x++-- | Create geometric distribution.+geometric0E :: Double                -- ^ Success rate+            -> Maybe GeometricDistribution0+geometric0E x+  | x >= 0 && x <= 1 = Just (GD0 x)+  | otherwise        = Nothing++errMsg0 :: Double -> String+errMsg0 x = "Statistics.Distribution.Geometric.geometric0: probability must be in [0,1] range. Got " ++ show x
+ Statistics/Distribution/Hypergeometric.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}+-- |+-- Module    : Statistics.Distribution.Hypergeometric+-- Copyright : (c) 2009 Bryan O'Sullivan+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- The Hypergeometric distribution.  This is the discrete probability+-- distribution that measures the probability of /k/ successes in /l/+-- trials, without replacement, from a finite population.+--+-- The parameters of the distribution describe /k/ elements chosen+-- from a population of /l/, with /m/ elements of one type, and+-- /l/-/m/ of the other (all are positive integers).++module Statistics.Distribution.Hypergeometric+    (+      HypergeometricDistribution+    -- * Constructors+    , hypergeometric+    , hypergeometricE+    -- ** Accessors+    , hdM+    , hdL+    , hdK+    ) where++import Control.Applicative+import Data.Data            (Data, Typeable)+import GHC.Generics         (Generic)+import Numeric.MathFunctions.Constants (m_epsilon,m_neg_inf)+import Numeric.SpecFunctions (choose,logChoose)++import qualified Statistics.Distribution as D+import Statistics.Internal+++data HypergeometricDistribution = HD {+      hdM :: {-# UNPACK #-} !Int+    , hdL :: {-# UNPACK #-} !Int+    , hdK :: {-# UNPACK #-} !Int+    } deriving (Eq, Typeable, Data, Generic)++instance Show HypergeometricDistribution where+  showsPrec i (HD m l k) = defaultShow3 "hypergeometric" m l k i+instance Read HypergeometricDistribution where+  readPrec = defaultReadPrecM3 "hypergeometric" hypergeometricE++instance D.Distribution HypergeometricDistribution where+    cumulative = cumulative++instance D.DiscreteDistr HypergeometricDistribution where+    probability    = probability+    logProbability = logProbability++instance D.Mean HypergeometricDistribution where+    mean = mean++instance D.Variance HypergeometricDistribution where+    variance = variance++instance D.MaybeMean HypergeometricDistribution where+    maybeMean = Just . D.mean++instance D.MaybeVariance HypergeometricDistribution where+    maybeStdDev   = Just . D.stdDev+    maybeVariance = Just . D.variance++instance D.Entropy HypergeometricDistribution where+  entropy = directEntropy++instance D.MaybeEntropy HypergeometricDistribution where+  maybeEntropy = Just . D.entropy++variance :: HypergeometricDistribution -> Double+variance (HD m l k) = (k' * ml) * (1 - ml) * (l' - k') / (l' - 1)+  where m' = fromIntegral m+        l' = fromIntegral l+        k' = fromIntegral k+        ml = m' / l'++mean :: HypergeometricDistribution -> Double+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]]+++hypergeometric :: Int               -- ^ /m/+               -> Int               -- ^ /l/+               -> Int               -- ^ /k/+               -> HypergeometricDistribution+hypergeometric m l k+  = maybe (error $ errMsg m l k) id $ hypergeometricE m l k++hypergeometricE :: Int               -- ^ /m/+                -> Int               -- ^ /l/+                -> Int               -- ^ /k/+                -> Maybe HypergeometricDistribution+hypergeometricE m l k+  | not (l > 0)            = Nothing+  | not (m >= 0 && m <= l) = Nothing+  | not (k > 0  && k <= l) = Nothing+  | otherwise              = Just (HD m l k)+++errMsg :: Int -> Int -> Int -> String+errMsg m l k+  =  "Statistics.Distribution.Hypergeometric.hypergeometric: "+  ++ "m=" ++ show m+  ++ "l=" ++ show l+  ++ "k=" ++ show k+  ++ " should hold: l>0 & m in [0,l] & k in (0,l]"++-- Naive implementation+probability :: HypergeometricDistribution -> Int -> Double+probability (HD mi li ki) n+  | n < max 0 (mi+ki-li) || n > min mi ki = 0+    -- No overflow+  | li < 1000 = choose mi n * choose (li - mi) (ki - n)+              / choose li ki+  | otherwise = exp $ logChoose mi n+                    + logChoose (li - mi) (ki - n)+                    - logChoose li ki++logProbability :: HypergeometricDistribution -> Int -> Double+logProbability (HD mi li ki) n+  | n < max 0 (mi+ki-li) || n > min mi ki = m_neg_inf+  | otherwise = logChoose mi n+              + logChoose (li - mi) (ki - n)+              - logChoose li ki++cumulative :: HypergeometricDistribution -> Double -> Double+cumulative d@(HD mi li ki) x+  | isNaN x      = error "Statistics.Distribution.Hypergeometric.cumulative: NaN argument"+  | isInfinite x = if x > 0 then 1 else 0+  | n <  minN    = 0+  | n >= maxN    = 1+  | otherwise    = D.sumProbabilities d minN n+  where+    n    = floor x+    minN = max 0 (mi+ki-li)+    maxN = min mi ki
+ Statistics/Distribution/Laplace.hs view
@@ -0,0 +1,146 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}+-- |+-- Module    : Statistics.Distribution.Laplace+-- Copyright : (c) 2015 Mihai Maruseac+-- License   : BSD3+--+-- Maintainer  : mihai.maruseac@maruseac.com+-- Stability   : experimental+-- Portability : portable+--+-- The Laplace distribution.  This is the continuous probability+-- defined as the difference of two iid exponential random variables+-- or a Brownian motion evaluated as exponentially distributed times.+-- It is used in differential privacy (Laplace Method), speech+-- recognition and least absolute deviations method (Laplace's first+-- law of errors, giving a robust regression method)+--+module Statistics.Distribution.Laplace+    (+      LaplaceDistribution+    -- * Constructors+    , laplace+    , laplaceE+    -- * Accessors+    , ldLocation+    , ldScale+    ) where++import Control.Applicative+import Data.Data            (Data, Typeable)+import GHC.Generics         (Generic)+import qualified Data.Vector.Generic             as G+import qualified Statistics.Distribution         as D+import qualified Statistics.Quantile             as Q+import qualified Statistics.Sample               as S+import Statistics.Internal+++data LaplaceDistribution = LD {+      ldLocation :: {-# UNPACK #-} !Double+    -- ^ Location.+    , ldScale    :: {-# UNPACK #-} !Double+    -- ^ Scale.+    } deriving (Eq, Typeable, Data, Generic)++instance Show LaplaceDistribution where+  showsPrec i (LD l s) = defaultShow2 "laplace" l s i+instance Read LaplaceDistribution where+  readPrec = defaultReadPrecM2 "laplace" laplaceE++instance D.Distribution LaplaceDistribution where+    cumulative      = cumulative+    complCumulative = complCumulative++instance D.ContDistr LaplaceDistribution where+    density    (LD l s) x = exp (- abs (x - l) / s) / (2 * s)+    logDensity (LD l s) x = - abs (x - l) / s - log 2 - log s+    quantile      = quantile+    complQuantile = complQuantile++instance D.Mean LaplaceDistribution where+    mean (LD l _) = l++instance D.Variance LaplaceDistribution where+    variance (LD _ s) = 2 * s * s++instance D.MaybeMean LaplaceDistribution where+    maybeMean = Just . D.mean++instance D.MaybeVariance LaplaceDistribution where+    maybeStdDev   = Just . D.stdDev+    maybeVariance = Just . D.variance++instance D.Entropy LaplaceDistribution where+  entropy (LD _ s) = 1 + log (2 * s)++instance D.MaybeEntropy LaplaceDistribution where+  maybeEntropy = Just . D.entropy++instance D.ContGen LaplaceDistribution where+  genContVar = D.genContinuous++cumulative :: LaplaceDistribution -> Double -> Double+cumulative (LD l s) x+  | x <= l    = 0.5 * exp ( (x - l) / s)+  | otherwise = 1 - 0.5 * exp ( - (x - l) / s )++complCumulative :: LaplaceDistribution -> Double -> Double+complCumulative (LD l s) x+  | x <= l    = 1 - 0.5 * exp ( (x - l) / s)+  | otherwise = 0.5 * exp ( - (x - l) / s )++quantile :: LaplaceDistribution -> Double -> Double+quantile (LD l s) p+  | p == 0             = -inf+  | p == 1             = inf+  | p == 0.5           = l+  | p > 0   && p < 0.5 = l + s * log (2 * p)+  | p > 0.5 && p < 1   = l - s * log (2 - 2 * p)+  | otherwise          =+    error $ "Statistics.Distribution.Laplace.quantile: p must be in [0,1] range. Got: "++show p+  where+    inf = 1 / 0++complQuantile :: LaplaceDistribution -> Double -> Double+complQuantile (LD l s) p+  | p == 0             = inf+  | p == 1             = -inf+  | p == 0.5           = l+  | p > 0   && p < 0.5 = l - s * log (2 * p)+  | p > 0.5 && p < 1   = l + s * log (2 - 2 * p)+  | otherwise          =+    error $ "Statistics.Distribution.Laplace.quantile: p must be in [0,1] range. Got: "++show p+  where+    inf = 1 / 0++-- | Create an Laplace distribution.+laplace :: Double         -- ^ Location+        -> Double        -- ^ Scale+        -> LaplaceDistribution+laplace l s = maybe (error $ errMsg l s) id $ laplaceE l s++-- | Create an Laplace distribution.+laplaceE :: Double         -- ^ Location+         -> Double        -- ^ Scale+         -> Maybe LaplaceDistribution+laplaceE l s+  | s >= 0    = Just (LD l s)+  | otherwise = Nothing++errMsg :: Double -> Double -> String+errMsg _ s = "Statistics.Distribution.Laplace.laplace: scale parameter must be positive. Got " ++ show s+++-- | Create Laplace distribution from sample. No tests are made to+--   check whether it truly is Laplace. Location of distribution+--   estimated as median of sample.+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/Normal.hs view
@@ -0,0 +1,161 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}+-- |+-- Module    : Statistics.Distribution.Normal+-- Copyright : (c) 2009 Bryan O'Sullivan+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- The normal distribution.  This is a continuous probability+-- distribution that describes data that cluster around a mean.++module Statistics.Distribution.Normal+    (+      NormalDistribution+    -- * Constructors+    , normalDistr+    , normalDistrE+    , standard+    ) where++import Control.Applicative+import Data.Data             (Data, Typeable)+import GHC.Generics          (Generic)+import Numeric.MathFunctions.Constants (m_sqrt_2, m_sqrt_2_pi)+import Numeric.SpecFunctions (erfc, invErfc)+import qualified System.Random.MWC.Distributions as MWC+import qualified Data.Vector.Generic as G++import qualified Statistics.Distribution as D+import qualified Statistics.Sample as S+import Statistics.Internal+++-- | The normal distribution.+data NormalDistribution = ND {+      mean       :: {-# UNPACK #-} !Double+    , stdDev     :: {-# UNPACK #-} !Double+    , ndPdfDenom :: {-# UNPACK #-} !Double+    , ndCdfDenom :: {-# UNPACK #-} !Double+    } deriving (Eq, Typeable, Data, Generic)++instance Show NormalDistribution where+  showsPrec i (ND m s _ _) = defaultShow2 "normalDistr" m s i+instance Read NormalDistribution where+  readPrec = defaultReadPrecM2 "normalDistr" normalDistrE++instance D.Distribution NormalDistribution where+    cumulative      = cumulative+    complCumulative = complCumulative++instance D.ContDistr NormalDistribution where+    logDensity    = logDensity+    quantile      = quantile+    complQuantile = complQuantile++instance D.MaybeMean NormalDistribution where+    maybeMean = Just . D.mean++instance D.Mean NormalDistribution where+    mean = mean++instance D.MaybeVariance NormalDistribution where+    maybeStdDev   = Just . D.stdDev+    maybeVariance = Just . D.variance++instance D.Variance NormalDistribution where+    stdDev = stdDev++instance D.Entropy NormalDistribution where+  entropy d = 0.5 * log (2 * pi * exp 1 * D.variance d)++instance D.MaybeEntropy NormalDistribution where+  maybeEntropy = Just . D.entropy++instance D.ContGen NormalDistribution where+    genContVar d = MWC.normal (mean d) (stdDev d)++-- | Standard normal distribution with mean equal to 0 and variance equal to 1+standard :: NormalDistribution+standard = ND { mean       = 0.0+              , stdDev     = 1.0+              , ndPdfDenom = log m_sqrt_2_pi+              , ndCdfDenom = m_sqrt_2+              }++-- | Create normal distribution from parameters.+--+-- IMPORTANT: prior to 0.10 release second parameter was variance not+-- standard deviation.+normalDistr :: Double            -- ^ Mean of distribution+            -> Double            -- ^ Standard deviation of distribution+            -> NormalDistribution+normalDistr m sd = maybe (error $ errMsg m sd) id $ normalDistrE m sd++-- | 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+  | sd > 0    = Just ND { mean       = m+                        , stdDev     = sd+                        , ndPdfDenom = log $ m_sqrt_2_pi * sd+                        , ndCdfDenom = m_sqrt_2 * sd+                        }+  | otherwise = Nothing++errMsg :: Double -> Double -> String+errMsg _ sd = "Statistics.Distribution.Normal.normalDistr: standard deviation must be positive. Got " ++ show sd++-- | Variance is estimated using maximum likelihood method+--   (biased estimation).+--+--   Returns @Nothing@ if sample contains less than one element or+--   variance is zero (all elements are equal)+instance D.FromSample NormalDistribution Double where+  fromSample xs+    | G.length xs <= 1 = Nothing+    | v == 0           = Nothing+    | otherwise        = Just $! normalDistr m (sqrt v)+    where+      (m,v) = S.meanVariance xs++logDensity :: NormalDistribution -> Double -> Double+logDensity d x = (-xm * xm / (2 * sd * sd)) - ndPdfDenom d+    where xm = x - mean d+          sd = stdDev d++cumulative :: NormalDistribution -> Double -> Double+cumulative d x = erfc ((mean d - x) / ndCdfDenom d) / 2++complCumulative :: NormalDistribution -> Double -> Double+complCumulative d x = erfc ((x - mean d) / ndCdfDenom d) / 2++quantile :: NormalDistribution -> Double -> Double+quantile d p+  | p == 0         = -inf+  | p == 1         = inf+  | p == 0.5       = mean d+  | p > 0 && p < 1 = x * ndCdfDenom d + mean d+  | otherwise      =+    error $ "Statistics.Distribution.Normal.quantile: p must be in [0,1] range. Got: "++show p+  where x          = - invErfc (2 * p)+        inf        = 1/0++complQuantile :: NormalDistribution -> Double -> Double+complQuantile d p+  | p == 0         = inf+  | p == 1         = -inf+  | p == 0.5       = mean d+  | p > 0 && p < 1 = x * ndCdfDenom d + mean d+  | otherwise      =+    error $ "Statistics.Distribution.Normal.complQuantile: p must be in [0,1] range. Got: "++show p+  where x          = invErfc (2 * p)+        inf        = 1/0
+ Statistics/Distribution/Poisson.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}+-- |+-- Module    : Statistics.Distribution.Poisson+-- Copyright : (c) 2009, 2011 Bryan O'Sullivan+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- The Poisson distribution.  This is the discrete probability+-- distribution of a number of events occurring in a fixed interval if+-- these events occur with a known average rate, and occur+-- independently from each other within that interval.++module Statistics.Distribution.Poisson+    (+      PoissonDistribution+    -- * Constructors+    , poisson+    , poissonE+    -- * Accessors+    , poissonLambda+    -- * References+    -- $references+    ) where++import Control.Applicative+import Data.Data            (Data, Typeable)+import GHC.Generics         (Generic)+import Numeric.SpecFunctions (incompleteGamma,logFactorial)+import Numeric.MathFunctions.Constants (m_neg_inf)++import qualified Statistics.Distribution as D+import qualified Statistics.Distribution.Poisson.Internal as I+import Statistics.Internal++++newtype PoissonDistribution = PD {+      poissonLambda :: Double+    } deriving (Eq, Typeable, Data, Generic)++instance Show PoissonDistribution where+  showsPrec i (PD l) = defaultShow1 "poisson" l i+instance Read PoissonDistribution where+  readPrec = defaultReadPrecM1 "poisson" poissonE++instance D.Distribution PoissonDistribution where+    cumulative (PD lambda) x+      | x < 0        = 0+      | isInfinite x = 1+      | isNaN      x = error "Statistics.Distribution.Poisson.cumulative: NaN input"+      | otherwise    = 1 - incompleteGamma (fromIntegral (floor x + 1 :: Int)) lambda++instance D.DiscreteDistr PoissonDistribution where+    probability (PD lambda) x = I.probability lambda (fromIntegral x)+    logProbability (PD lambda) i+      | i < 0     = m_neg_inf+      | otherwise = log lambda * fromIntegral i - logFactorial i - lambda++instance D.Variance PoissonDistribution where+    variance = poissonLambda++instance D.Mean PoissonDistribution where+    mean = poissonLambda++instance D.MaybeMean PoissonDistribution where+    maybeMean = Just . D.mean++instance D.MaybeVariance PoissonDistribution where+    maybeStdDev   = Just . D.stdDev++instance D.Entropy PoissonDistribution where+  entropy (PD lambda) = I.poissonEntropy lambda++instance D.MaybeEntropy PoissonDistribution where+  maybeEntropy = Just . D.entropy++-- | Create Poisson distribution.+poisson :: Double -> PoissonDistribution+poisson l = maybe (error $ errMsg l) id $ poissonE l++-- | Create Poisson distribution.+poissonE :: Double -> Maybe PoissonDistribution+poissonE l+  | l >=  0   = Just (PD l)+  | otherwise = Nothing++errMsg :: Double -> String+errMsg l = "Statistics.Distribution.Poisson.poisson: lambda must be non-negative. Got "+        ++ show l+++-- $references+--+-- * Loader, C. (2000) Fast and Accurate Computation of Binomial+--   Probabilities. <http://projects.scipy.org/scipy/raw-attachment/ticket/620/loader2000Fast.pdf>+-- * Adell, J., Lekuona, A., and Yu, Y. (2010) Sharp Bounds on the+--   Entropy of the Poisson Law and Related Quantities+--   <http://arxiv.org/pdf/1001.2897.pdf>
+ Statistics/Distribution/Poisson/Internal.hs view
@@ -0,0 +1,177 @@+-- |+-- Module    : Statistics.Distribution.Poisson.Internal+-- Copyright : (c) 2011 Bryan O'Sullivan+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Internal code for the Poisson distribution.++module Statistics.Distribution.Poisson.Internal+    (+      probability, poissonEntropy+    ) where++import Data.List (unfoldr)+import Numeric.MathFunctions.Constants (m_sqrt_2_pi, m_tiny, m_epsilon)+import Numeric.SpecFunctions (logGamma, stirlingError {-, choose, logFactorial -})+import Numeric.SpecFunctions.Extra (bd0)++-- | An unchecked, non-integer-valued version of Loader's saddle point+-- algorithm.+probability :: Double -> Double -> Double+probability 0      0     = 1+probability 0      1     = 0+probability lambda x+  | isInfinite lambda    = 0+  | x < 0                = 0+  | x <= lambda * m_tiny = exp (-lambda)+  | lambda < x * m_tiny  = exp (-lambda + x * log lambda - logGamma (x+1))+  | otherwise            = exp (-(stirlingError x) - bd0 x lambda) /+                           (m_sqrt_2_pi * sqrt x)++-- -- | Compute entropy using Theorem 1 from "Sharp Bounds on the Entropy+-- -- of the Poisson Law".  This function is unused because '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..] ]++-- alyc :: Int -> Double+-- alyc k =+--   sum [ parity j * choose (k-1) j * log (fromIntegral j+1) | j <- [0..k-1] ]+--   where parity j+--           | even (k-j) = -1+--           | otherwise  = 1++-- | Returns [x, x^2, x^3, x^4, ...]+powers :: Double -> [Double]+powers x = unfoldr (\y -> Just (y*x,y*x)) 1++-- | Returns an upper bound according to theorem 2 of "Sharp Bounds on+-- the Entropy of the Poisson Law"+alyThm2Upper :: Double -> [Double] -> Double+alyThm2Upper lambda coefficients =+  1.4189385332046727 + 0.5 * log lambda ++  zipCoefficients lambda coefficients++-- | Returns the average of the upper and lower bounds accounding to+-- theorem 2.+alyThm2 :: Double -> [Double] -> [Double] -> Double+alyThm2 lambda upper lower =+  alyThm2Upper lambda upper + 0.5 * (zipCoefficients lambda lower)++zipCoefficients :: Double -> [Double] -> Double+zipCoefficients lambda coefficients =+  (sum $ map (uncurry (*)) (zip (powers $ recip lambda) coefficients))++-- Mathematica code deriving the coefficients below:+--+-- poissonMoment[0, s_] := 1+-- poissonMoment[1, s_] := 0+-- poissonMoment[k_, s_] :=+--   Sum[s * Binomial[k - 1, j] * poissonMoment[j, s], {j, 0, k - 2}]+--+-- upperSeries[m_]  :=+--  Distribute[Integrate[+--    Sum[(-1)^(j - 1) *+--      poissonMoment[j, \[Lambda]] / (j * (j - 1)* \[Lambda]^j),+--     {j, 3, 2 m - 1}],+--    \[Lambda]]]+--+-- lowerSeries[m_] :=+--  Distribute[Integrate[+--    poissonMoment[+--      2 m + 2, \[Lambda]] / ((2 m ++--         1)*\[Lambda]^(2 m + 2)), \[Lambda]]]+--+-- upperBound[m_] := upperSeries[m] + (Log[2*Pi*\[Lambda]] + 1)/2+--+-- lowerBound[m_] := upperBound[m] + lowerSeries[m]++upperCoefficients4 :: [Double]+upperCoefficients4 = [1/12, 1/24, -103/180, -13/40, -1/210]++lowerCoefficients4 :: [Double]+lowerCoefficients4 = [0,0,0, -105/4, -210, -2275/18, -167/21, -1/72]++upperCoefficients6 :: [Double]+upperCoefficients6 = [1/12, 1/24, 19/360, 9/80, -38827/2520,+                      -74855/1008, -73061/2520, -827/720, -1/990]++lowerCoefficients6 :: [Double]+lowerCoefficients6 = [0,0,0,0,0, -3465/2, -45045, -466235/4, -531916/9,+                      -56287/10, -629/11, -1/156]++upperCoefficients8 :: [Double]+upperCoefficients8 = [1/12, 1/24, 19/360, 9/80, 863/2520, 1375/1008,+                      -3023561/2520, -15174047/720, -231835511/5940,+                      -18927611/1320, -58315591/60060, -23641/3640,+                      -1/2730]++lowerCoefficients8 :: [Double]+lowerCoefficients8 = [0,0,0,0,0,0,0, -2027025/8, -15315300, -105252147,+                      -178127950, -343908565/4, -10929270, -3721149/14,+                      -7709/15, -1/272]++upperCoefficients10 :: [Double]+upperCoefficients10 = [1/12, 1/24, 19/360, 9,80, 863/2520, 1375/1008,+                       33953/5040, 57281/1440, -2271071617/11880,+                       -1483674219/176, -31714406276557/720720,+                       -7531072742237/131040, -1405507544003/65520,+                       -21001919627/10080, -1365808297/36720,+                       -26059/544, -1/5814]++lowerCoefficients10 :: [Double]+lowerCoefficients10 = [0,0,0,0,0,0,0,0,0,-130945815/2, -7638505875,+                       -438256243425/4, -435477637540, -3552526473925/6,+                       -857611717105/3, -545654955967/12, -5794690528/3,+                       -578334559/42, -699043/133, -1/420]++upperCoefficients12 :: [Double]+upperCoefficients12 = [1/12, 1/24, 19/360, 863/2520, 1375/1008,+                       33953/5040, 57281/1440, 3250433/11880,+                       378351/176, -37521922090657/720720,+                       -612415657466657/131040, -3476857538815223/65520,+                       -243882174660761/1440, -34160796727900637/183600,+                       -39453820646687/544, -750984629069237/81396,+                       -2934056300989/9576, -20394527513/12540,+                       -3829559/9240, -1/10626]++lowerCoefficients12 :: [Double]+lowerCoefficients12 = [0,0,0,0,0,0,0,0,0,0,0,+                       -105411381075/4, -5270569053750, -272908057767345/2,+                       -1051953238104769, -24557168490009155/8,+                       -3683261873403112, -5461918738302026/3,+                       -347362037754732, -2205885452434521/100,+                       -12237195698286/35, -16926981721/22,+                       -6710881/155, -1/600]++-- | Compute entropy directly from its definition. This is just as accurate+-- as 'alyThm1' for lambda <= 1 and is faster, but is slow for large lambda,+-- and produces some underestimation due to accumulation of floating point+-- error.+directEntropy :: Double -> Double+directEntropy lambda =+  negate . sum $+  takeWhile (< negate m_epsilon * lambda) $+  dropWhile (not . (< negate m_epsilon * lambda)) $+  [ let x = probability lambda k in x * log x | k <- [0..]]++-- | Compute the entropy of a poisson distribution using the best available+-- method.+poissonEntropy :: Double -> Double+poissonEntropy lambda+  | lambda == 0 = 0+  | lambda <= 10 = directEntropy lambda+  | lambda <= 12 = alyThm2 lambda upperCoefficients4 lowerCoefficients4+  | lambda <= 18 = alyThm2 lambda upperCoefficients6 lowerCoefficients6+  | lambda <= 24 = alyThm2 lambda upperCoefficients8 lowerCoefficients8+  | lambda <= 30 = alyThm2 lambda upperCoefficients10 lowerCoefficients10+  | otherwise = alyThm2 lambda upperCoefficients12 lowerCoefficients12
+ Statistics/Distribution/StudentT.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}+-- |+-- Module    : Statistics.Distribution.StudentT+-- Copyright : (c) 2011 Aleksey Khudyakov+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Student-T distribution+module Statistics.Distribution.StudentT (+    StudentT+    -- * Constructors+  , studentT+  , studentTE+  , studentTUnstandardized+    -- * Accessors+  , studentTndf+  ) where++import Control.Applicative+import Data.Data           (Data, Typeable)+import GHC.Generics        (Generic)+import Numeric.SpecFunctions (+  logBeta, incompleteBeta, invIncompleteBeta, digamma)++import qualified Statistics.Distribution as D+import Statistics.Distribution.Transform (LinearTransform (..))+import Statistics.Internal+++-- | Student-T distribution+newtype StudentT = StudentT { studentTndf :: Double }+                   deriving (Eq, Typeable, Data, Generic)++instance Show StudentT where+  showsPrec i (StudentT ndf) = defaultShow1 "studentT" ndf i+instance Read StudentT where+  readPrec = defaultReadPrecM1 "studentT" studentTE++-- | Create Student-T distribution. Number of parameters must be positive.+studentT :: Double -> StudentT+studentT ndf = maybe (error $ errMsg ndf) id $ studentTE ndf++-- | Create Student-T distribution. Number of parameters must be positive.+studentTE :: Double -> Maybe StudentT+studentTE ndf+  | ndf > 0   = Just (StudentT ndf)+  | otherwise = Nothing++errMsg :: Double -> String+errMsg _ = modErr "studentT" "non-positive number of degrees of freedom"+++instance D.Distribution StudentT where+  cumulative      = cumulative+  complCumulative = complCumulative++instance D.ContDistr StudentT where+  density    d@(StudentT ndf) x = exp (logDensityUnscaled d x) / sqrt ndf+  logDensity d@(StudentT ndf) x = logDensityUnscaled d x - log (sqrt ndf)+  quantile = quantile++cumulative :: StudentT -> Double -> Double+cumulative (StudentT ndf) x+  | x > 0     = 1 - 0.5 * ibeta+  | otherwise = 0.5 * ibeta+  where+    ibeta = incompleteBeta (0.5 * ndf) 0.5 (ndf / (ndf + x*x))++complCumulative :: StudentT -> Double -> Double+complCumulative (StudentT ndf) x+  | x > 0     = 0.5 * ibeta+  | otherwise = 1 - 0.5 * ibeta+  where+    ibeta = incompleteBeta (0.5 * ndf) 0.5 (ndf / (ndf + x*x))+++logDensityUnscaled :: StudentT -> Double -> Double+logDensityUnscaled (StudentT ndf) x =+    log (ndf / (ndf + x*x)) * (0.5 * (1 + ndf)) - logBeta 0.5 (0.5 * ndf)++quantile :: StudentT -> Double -> Double+quantile (StudentT ndf) p+  | p >= 0 && p <= 1 =+    let x = invIncompleteBeta (0.5 * ndf) 0.5 (2 * min p (1 - p))+    in case sqrt $ ndf * (1 - x) / x of+         r | p < 0.5   -> -r+           | otherwise -> r+  | otherwise = modErr "quantile" $ "p must be in [0,1] range. Got: "++show p+++instance D.MaybeMean StudentT where+  maybeMean (StudentT ndf) | ndf > 1   = Just 0+                           | otherwise = Nothing++instance D.MaybeVariance StudentT where+  maybeVariance (StudentT ndf) | ndf > 2   = Just $! ndf / (ndf - 2)+                               | otherwise = Nothing++instance D.Entropy StudentT where+  entropy (StudentT ndf) =+    0.5 * (ndf+1) * (digamma ((1+ndf)/2) - digamma(ndf/2))+    + log (sqrt ndf)+    + logBeta (ndf/2) 0.5++instance D.MaybeEntropy StudentT where+  maybeEntropy = Just . D.entropy++instance D.ContGen StudentT where+  genContVar = D.genContinuous++-- | Create an unstandardized Student-t distribution.+studentTUnstandardized :: Double -- ^ Number of degrees of freedom+                       -> Double -- ^ Central value (0 for standard Student T distribution)+                       -> Double -- ^ Scale parameter+                       -> LinearTransform StudentT+studentTUnstandardized ndf mu sigma+  | sigma > 0 = LinearTransform mu sigma $ studentT ndf+  | otherwise = modErr "studentTUnstandardized" $ "sigma must be > 0. Got: " ++ show sigma++modErr :: String -> String -> a+modErr fun msg = error $ "Statistics.Distribution.StudentT." ++ fun ++ ": " ++ msg
+ Statistics/Distribution/Transform.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, FlexibleContexts,+    FlexibleInstances, UndecidableInstances #-}+-- |+-- Module    : Statistics.Distribution.Transform+-- Copyright : (c) 2013 John McDonnell;+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Transformations over distributions+module Statistics.Distribution.Transform+    (+      LinearTransform (..)+    , linTransFixedPoint+    , scaleAround+    ) where++import Control.Applicative ((<*>))+import Data.Data (Data, Typeable)+import Data.Functor ((<$>))+import GHC.Generics (Generic)+import qualified Statistics.Distribution as D++-- | Linear transformation applied to distribution.+--+-- > LinearTransform μ σ _+-- > x' = μ + σ·x+data LinearTransform d = LinearTransform+  { linTransLocation :: {-# UNPACK #-} !Double+    -- ^ Location parameter.+  , linTransScale    :: {-# UNPACK #-} !Double+    -- ^ Scale parameter.+  , linTransDistr    :: d+    -- ^ Distribution being transformed.+  } deriving (Eq, Show, Read, Typeable, Data, Generic)++-- | Apply linear transformation to distribution.+scaleAround :: Double           -- ^ Fixed point+            -> Double           -- ^ Scale parameter+            -> d                -- ^ Distribution+            -> LinearTransform d+scaleAround x0 sc = LinearTransform (x0 * (1 - sc)) sc++-- | Get fixed point of linear transformation+linTransFixedPoint :: LinearTransform d -> Double+linTransFixedPoint (LinearTransform loc sc _) = loc / (1 - sc)++instance Functor LinearTransform where+  fmap f (LinearTransform loc sc dist) = LinearTransform loc sc (f dist)++instance D.Distribution d => D.Distribution (LinearTransform d) where+  cumulative (LinearTransform loc sc dist) x = D.cumulative dist $ (x-loc) / sc++instance D.ContDistr d => D.ContDistr (LinearTransform d) where+  density    (LinearTransform loc sc dist) x = D.density    dist ((x-loc) / sc) / sc+  logDensity (LinearTransform loc sc dist) x = D.logDensity dist ((x-loc) / sc) - log sc+  quantile      (LinearTransform loc sc dist) p = loc + sc * D.quantile      dist p+  complQuantile (LinearTransform loc sc dist) p = loc + sc * D.complQuantile dist p++instance D.MaybeMean d => D.MaybeMean (LinearTransform d) where+  maybeMean (LinearTransform loc _ dist) = (+loc) <$> D.maybeMean dist++instance (D.Mean d) => D.Mean (LinearTransform d) where+  mean (LinearTransform loc _ dist) = loc + D.mean dist++instance D.MaybeVariance  d => D.MaybeVariance (LinearTransform d) where+  maybeVariance (LinearTransform _ sc dist) = (*(sc*sc)) <$> D.maybeVariance dist+  maybeStdDev   (LinearTransform _ sc dist) = (*sc)      <$> D.maybeStdDev dist++instance (D.Variance d) => D.Variance (LinearTransform d) where+  variance (LinearTransform _ sc dist) = sc * sc * D.variance dist+  stdDev   (LinearTransform _ sc dist) = sc * D.stdDev dist++instance (D.MaybeEntropy d) => D.MaybeEntropy (LinearTransform d) where+  maybeEntropy (LinearTransform _ _ dist) = D.maybeEntropy dist++instance (D.Entropy d) => D.Entropy (LinearTransform d) where+  entropy (LinearTransform _ _ dist) = D.entropy dist++instance D.ContGen d => D.ContGen (LinearTransform d) where+  genContVar (LinearTransform loc sc d) g = do+    x <- D.genContVar d g+    return $! loc + sc * x
+ Statistics/Distribution/Uniform.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}+-- |+-- Module    : Statistics.Distribution.Uniform+-- Copyright : (c) 2011 Aleksey Khudyakov+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Variate distributed uniformly in the interval.+module Statistics.Distribution.Uniform+    (+      UniformDistribution+    -- * Constructors+    , uniformDistr+    , uniformDistrE+    -- ** Accessors+    , uniformA+    , uniformB+    ) where++import Control.Applicative+import Data.Data           (Data, Typeable)+import GHC.Generics        (Generic)+import qualified System.Random.MWC       as MWC++import qualified Statistics.Distribution as D+import Statistics.Internal++++-- | Uniform distribution from A to B+data UniformDistribution = UniformDistribution {+      uniformA :: {-# UNPACK #-} !Double -- ^ Low boundary of distribution+    , uniformB :: {-# UNPACK #-} !Double -- ^ Upper boundary of distribution+    } deriving (Eq, Typeable, Data, Generic)++instance Show UniformDistribution where+  showsPrec i (UniformDistribution a b) = defaultShow2 "uniformDistr" a b i+instance Read UniformDistribution where+  readPrec = defaultReadPrecM2 "uniformDistr" uniformDistrE++-- | Create uniform distribution.+uniformDistr :: Double -> Double -> UniformDistribution+uniformDistr a b = maybe (error errMsg) id $ uniformDistrE a b++-- | Create uniform distribution.+uniformDistrE :: Double -> Double -> Maybe UniformDistribution+uniformDistrE a b+  | b < a     = Just $ UniformDistribution b a+  | a < b     = Just $ UniformDistribution a b+  | otherwise = Nothing+-- NOTE: failure is in default branch to guard against NaNs.++errMsg :: String+errMsg = "Statistics.Distribution.Uniform.uniform: wrong parameters"+++instance D.Distribution UniformDistribution where+  cumulative (UniformDistribution a b) x+    | x < a     = 0+    | x > b     = 1+    | otherwise = (x - a) / (b - a)++instance D.ContDistr UniformDistribution where+  density (UniformDistribution a b) x+    | x < a     = 0+    | x > b     = 0+    | otherwise = 1 / (b - a)+  quantile (UniformDistribution a b) p+    | p >= 0 && p <= 1 = a + (b - a) * p+    | otherwise        =+      error $ "Statistics.Distribution.Uniform.quantile: p must be in [0,1] range. Got: "++show p+  complQuantile (UniformDistribution a b) p+    | p >= 0 && p <= 1 = b + (a - b) * p+    | otherwise        =+      error $ "Statistics.Distribution.Uniform.complQuantile: p must be in [0,1] range. Got: "++show p++instance D.Mean UniformDistribution where+  mean (UniformDistribution a b) = 0.5 * (a + b)++instance D.Variance UniformDistribution where+  -- NOTE: 1/sqrt 12 is not constant folded (#4101) so it's written as+  --       numerical constant. (Also FIXME!)+  stdDev   (UniformDistribution a b) = 0.2886751345948129 * (b - a)+  variance (UniformDistribution a b) = d * d / 12 where d = b - a++instance D.MaybeMean UniformDistribution where+    maybeMean = Just . D.mean++instance D.MaybeVariance UniformDistribution where+    maybeStdDev   = Just . D.stdDev++instance D.Entropy UniformDistribution where+  entropy (UniformDistribution a b) = log (b - a)++instance D.MaybeEntropy UniformDistribution where+  maybeEntropy = Just . D.entropy++instance D.ContGen UniformDistribution where+    genContVar (UniformDistribution a b) gen = MWC.uniformR (a,b) gen
+ Statistics/Function.hs view
@@ -0,0 +1,145 @@+{-# LANGUAGE BangPatterns, CPP, FlexibleContexts, Rank2Types #-}+{-# OPTIONS_GHC -fsimpl-tick-factor=200 #-}+-- |+-- Module    : Statistics.Function+-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Useful functions.++module Statistics.Function+    (+    -- * Scanning+      minMax+    -- * Sorting+    , sort+    , gsort+    , sortBy+    , partialSort+    -- * Indexing+    , indexed+    , indices+    -- * Bit twiddling+    , nextHighestPowerOfTwo+    -- * Comparison+    , within+    -- * Arithmetic+    , square+    -- * Vectors+    , unsafeModify+    -- * Combinators+    , for+    , rfor+    ) where++#include "MachDeps.h"++import Control.Monad.ST (ST)+import Data.Bits ((.|.), shiftR)+import qualified Data.Vector.Algorithms.Intro as I+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Unboxed.Mutable as M+import Numeric.MathFunctions.Comparison (within)++-- | Sort a vector.+sort :: U.Vector Double -> U.Vector Double+sort = G.modify I.sort+{-# NOINLINE sort #-}++-- | Sort a vector.+gsort :: (Ord e, G.Vector v e) => v e -> v e+gsort = G.modify I.sort+{-# INLINE gsort #-}++-- | Sort a vector using a custom ordering.+sortBy :: (G.Vector v e) => I.Comparison e -> v e -> v e+sortBy f = G.modify $ I.sortBy f+{-# INLINE sortBy #-}++-- | Partially sort a vector, such that the least /k/ elements will be+-- at the front.+partialSort :: (G.Vector v e, Ord e) =>+               Int -- ^ The number /k/ of least elements.+            -> v e+            -> v e+partialSort k = G.modify (`I.partialSort` k)+{-# SPECIALIZE partialSort :: Int -> U.Vector Double -> U.Vector Double #-}++-- | Return the indices of a vector.+indices :: (G.Vector v a, G.Vector v Int) => v a -> v Int+indices a = G.enumFromTo 0 (G.length a - 1)+{-# INLINE indices #-}++-- | Zip a vector with its indices.+indexed :: (G.Vector v e, G.Vector v Int, G.Vector v (Int,e)) => v e -> v (Int,e)+indexed a = G.zip (indices a) a+{-# INLINE indexed #-}++data MM = MM {-# UNPACK #-} !Double {-# UNPACK #-} !Double++-- | Compute the minimum and maximum of a vector in one pass.+minMax :: (G.Vector v Double) => v Double -> (Double, Double)+minMax = fini . G.foldl' go (MM (1/0) (-1/0))+  where+    go (MM lo hi) k = MM (min lo k) (max hi k)+    fini (MM lo hi) = (lo, hi)+{-# INLINE minMax #-}++-- | Efficiently compute the next highest power of two for a+-- non-negative integer.  If the given value is already a power of+-- two, it is returned unchanged.  If negative, zero is returned.+nextHighestPowerOfTwo :: Int -> Int+nextHighestPowerOfTwo n+#if WORD_SIZE_IN_BITS == 64+  = 1 + _i32+#else+  = 1 + i16+#endif+  where+    i0   = n - 1+    i1   = i0  .|. i0  `shiftR` 1+    i2   = i1  .|. i1  `shiftR` 2+    i4   = i2  .|. i2  `shiftR` 4+    i8   = i4  .|. i4  `shiftR` 8+    i16  = i8  .|. i8  `shiftR` 16+    _i32 = i16 .|. i16 `shiftR` 32+-- It could be implemented as+--+-- > nextHighestPowerOfTwo n = 1 + foldl' go (n-1) [1, 2, 4, 8, 16, 32]+--     where go m i = m .|. m `shiftR` i+--+-- But GHC do not inline foldl (probably because it's recursive) and+-- as result function walks list of boxed ints. Hand rolled version+-- uses unboxed arithmetic.++-- | Multiply a number by itself.+square :: Double -> Double+square x = x * x++-- | Simple for loop.  Counts from /start/ to /end/-1.+for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()+for n0 !n f = loop n0+  where+    loop i | i == n    = return ()+           | otherwise = f i >> loop (i+1)+{-# INLINE for #-}++-- | Simple reverse-for loop.  Counts from /start/-1 to /end/ (which+-- must be less than /start/).+rfor :: Monad m => Int -> Int -> (Int -> m ()) -> m ()+rfor n0 !n f = loop n0+  where+    loop i | i == n    = return ()+           | otherwise = let i' = i-1 in f i' >> loop i'+{-# INLINE rfor #-}++unsafeModify :: M.MVector s Double -> Int -> (Double -> Double) -> ST s ()+unsafeModify v i f = do+  k <- M.unsafeRead v i+  M.unsafeWrite v i (f k)+{-# INLINE unsafeModify #-}
+ Statistics/Internal.hs view
@@ -0,0 +1,96 @@+-- |+-- Module    : Statistics.Internal+-- Copyright : (c) 2009 Bryan O'Sullivan+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- +module Statistics.Internal (+    -- * Default definitions for Show+    defaultShow1+  , defaultShow2+  , defaultShow3+    -- * Default definitions for Read+  , defaultReadPrecM1+  , defaultReadPrecM2+  , defaultReadPrecM3+    -- * Reexports+  , Show(..)+  , Read(..)+  ) where++import Control.Applicative+import Control.Monad+import Text.Read+import Data.Orphans ()++++----------------------------------------------------------------+-- Default show implementations+----------------------------------------------------------------++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/Quantile.hs view
@@ -0,0 +1,403 @@+{-# LANGUAGE CPP                #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFoldable     #-}+{-# LANGUAGE DeriveFunctor      #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE FlexibleContexts   #-}+{-# LANGUAGE ViewPatterns       #-}+-- |+-- Module    : Statistics.Quantile+-- Copyright : (c) 2009 Bryan O'Sullivan+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Functions for approximating quantiles, i.e. points taken at regular+-- intervals from the cumulative distribution function of a random+-- variable.+--+-- 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 ≤ /k/ ≤ /q/.++module Statistics.Quantile+    (+    -- * Quantile estimation functions+    -- $cont_quantiles+      ContParam(..)+    , Default(..)+    , quantile+    , quantiles+    , quantilesVec+    -- ** Parameters for the continuous sample method+    , cadpw+    , hazen+    , spss+    , s+    , medianUnbiased+    , normalUnbiased+    -- * Other algorithms+    , weightedAvg+    -- * Median & other specializations+    , median+    , mad+    , midspread+    -- * Deprecated+    , continuousBy+    -- * References+    -- $references+    ) where++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)+++----------------------------------------------------------------+-- Quantile estimation+----------------------------------------------------------------++-- | O(/n/·log /n/). Estimate the /k/th /q/-quantile of a sample,+-- using the weighted average method. Up to rounding errors it's same+-- as @quantile s@.+--+-- The following properties should hold otherwise an error will be thrown.+--+--   * the length of the input is greater than @0@+--+--   * the input does not contain @NaN@+--+--   * k ≥ 0 and k ≤ q+weightedAvg :: G.Vector v Double =>+               Int        -- ^ /k/, the desired quantile.+            -> Int        -- ^ /q/, the number of quantiles.+            -> v Double   -- ^ /x/, the sample data.+            -> Double+weightedAvg k q x+  | G.any isNaN x   = modErr "weightedAvg" "Sample contains NaNs"+  | n == 0          = modErr "weightedAvg" "Sample is empty"+  | n == 1          = G.head x+  | q < 2           = modErr "weightedAvg" "At least 2 quantiles is needed"+  | k == 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+    g   = idx - fromIntegral j+    xj  = sx ! j+    xj1 = sx ! (j+1)+    sx  = partialSort (j+2) x+    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 #-}+++----------------------------------------------------------------+-- 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.+++-- | 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++-- | 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+    pk       = toPk param n q nQ+    sortedXs = psort xs $ floor pk + 1+    n        = G.length xs+{-# INLINABLE quantile #-}+{-# SPECIALIZE+    quantile :: ContParam -> Int -> Int -> U.Vector Double -> Double #-}+{-# SPECIALIZE+    quantile :: ContParam -> Int -> Int -> V.Vector Double -> Double #-}+{-# SPECIALIZE+    quantile :: ContParam -> Int -> Int -> S.Vector Double -> Double #-}++-- | O(/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+--+--   The following properties should hold, otherwise an error will be thrown.+--+--     * 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+  | fnull qs           = 0 <$ qs+  | otherwise          = fmap (estimateQuantile sortedXs) ks'+  where+    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 #-}++-- COMPAT+fnull :: F.Foldable f => f a -> Bool+#if !MIN_VERSION_base(4,8,0)+fnull = F.foldr (\_ _ -> False) True+#else+fnull = null+#endif++-- | 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, /α/=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 /α/=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 /α/=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, /α/=1\/3, /β/=1\/3. The resulting+-- quantile estimates are approximately median unbiased regardless of+-- the distribution of /x/.  This corresponds to method 8 in R and+-- Mathematica.+medianUnbiased :: ContParam+medianUnbiased = ContParam third third+    where third = 1/3++-- | Normal unbiased definition, /α/=3\/8, /β/=3\/8.  An approximately+-- unbiased estimate if the empirical distribution approximates the+-- normal distribution.  This corresponds to method 9 in R and+-- Mathematica.+normalUnbiased :: ContParam+normalUnbiased = ContParam ta ta+    where ta = 3/8++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>+--+-- * [Hyndman1996] Hyndman, R.J.; Fan, Y. (1996) Sample quantiles in statistical+--   packages. /American Statistician/+--   50(4):361&#8211;365. <http://www.jstor.org/stable/2684934>
+ Statistics/Regression.hs view
@@ -0,0 +1,168 @@+-- |+-- Module    : Statistics.Regression+-- Copyright : 2014 Bryan O'Sullivan+-- License   : BSD3+--+-- Functions for regression analysis.++module Statistics.Regression+    (+      olsRegress+    , ols+    , rSquare+    , bootstrapRegress+    ) where++import Control.Applicative ((<$>))+import Control.Concurrent.Async (forConcurrently)+import Control.DeepSeq (rnf)+import Control.Monad (when)+import Data.List (nub)+import GHC.Conc (getNumCapabilities)+import Prelude hiding (pred, sum)+import Statistics.Function as F+import Statistics.Matrix hiding (map)+import Statistics.Matrix.Algorithms (qr)+import Statistics.Resampling (splitGen)+import Statistics.Types      (Estimate(..),ConfInt,CL,estimateFromInterval,significanceLevel)+import Statistics.Sample (mean)+import Statistics.Sample.Internal (sum)+import System.Random.MWC (GenIO, uniformR)+import qualified Data.Vector as V+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Unboxed.Mutable as M++-- | Perform an ordinary least-squares regression on a set of+-- predictors, and calculate the goodness-of-fit of the regression.+--+-- The returned pair consists of:+--+-- * A vector of regression coefficients.  This vector has /one more/+--   element than the list of predictors; the last element is the+--   /y/-intercept value.+--+-- * /R&#0178;/, the coefficient of determination (see 'rSquare' for+--   details).+olsRegress :: [Vector]+              -- ^ Non-empty list of predictor vectors.  Must all have+              -- the same length.  These will become the columns of+              -- the matrix /A/ solved by 'ols'.+           -> Vector+              -- ^ Responder vector.  Must have the same length as the+              -- predictor vectors.+           -> (Vector, Double)+olsRegress preds@(_:_) resps+  | any (/=n) ls        = error $ "predictor vector length mismatch " +++                                  show lss+  | G.length resps /= n = error $ "responder/predictor length mismatch " +++                                  show (G.length resps, n)+  | otherwise           = (coeffs, rSquare mxpreds resps coeffs)+  where+    coeffs    = ols mxpreds resps+    mxpreds   = transpose .+                fromVector (length lss + 1) n .+                G.concat $ preds ++ [G.replicate n 1]+    lss@(n:ls) = map G.length preds+olsRegress _ _ = error "no predictors given"++-- | Compute the ordinary least-squares solution to /A x = b/.+ols :: Matrix     -- ^ /A/ has at least as many rows as columns.+    -> Vector     -- ^ /b/ has the same length as columns in /A/.+    -> Vector+ols a b+  | rs < cs   = error $ "fewer rows than columns " ++ show d+  | otherwise = solve r (transpose q `multiplyV` b)+  where+    d@(rs,cs) = dimension a+    (q,r)     = qr a++-- | Solve the equation /R x = b/.+solve :: Matrix     -- ^ /R/ is an upper-triangular square matrix.+      -> Vector     -- ^ /b/ is of the same length as rows\/columns in /R/.+      -> Vector+solve r b+  | n /= l    = error $ "row/vector mismatch " ++ show (n,l)+  | otherwise = U.create $ do+  s <- U.thaw b+  rfor n 0 $ \i -> do+    si <- (/ unsafeIndex r i i) <$> M.unsafeRead s i+    M.unsafeWrite s i si+    F.for 0 i $ \j -> F.unsafeModify s j $ subtract (unsafeIndex r j i * si)+  return s+  where n = rows r+        l = U.length b++-- | Compute /R&#0178;/, the coefficient of determination that+-- indicates goodness-of-fit of a regression.+--+-- This value will be 1 if the predictors fit perfectly, dropping to 0+-- if they have no explanatory power.+rSquare :: Matrix               -- ^ Predictors (regressors).+        -> Vector               -- ^ Responders.+        -> Vector               -- ^ Regression coefficients.+        -> Double+rSquare pred resp coeff = 1 - r / t+  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)++-- | Bootstrap a regression function.  Returns both the results of the+-- regression and the requested confidence interval values.+bootstrapRegress+  :: GenIO+  -> Int         -- ^ Number of resamples to compute.+  -> CL Double   -- ^ Confidence level.+  -> ([Vector] -> Vector -> (Vector, Double))+     -- ^ Regression function.+  -> [Vector]    -- ^ Predictor vectors.+  -> Vector      -- ^ Responder vector.+  -> IO (V.Vector (Estimate ConfInt Double), Estimate ConfInt Double)+bootstrapRegress gen0 numResamples cl rgrss preds0 resp0+  | numResamples < 1   = error $ "bootstrapRegress: number of resamples " +++                                 "must be positive"+  | otherwise = do++  -- some error checks so that we do not run into vector index out of bounds.+  case nub (map U.length preds0) of+    [] -> error "bootstrapRegress: predictor vectors must not be empty"+    [plen] -> do+        let rlen = U.length resp0+        when (plen /= rlen) $+            error $ "bootstrapRegress: responder vector length ["+                ++ show rlen+                ++ "] must be the same as predictor vectors' length ["+                ++ show plen ++ "]"+    xs -> error $ "bootstrapRegress: all predictor vectors must be of the same \+        \length, lengths provided are: " ++ show xs++  caps <- getNumCapabilities+  gens <- splitGen caps gen0+  vs <- forConcurrently (zip gens (balance caps numResamples)) $ \(gen,count) -> do+      v <- V.replicateM count $ do+           let n = U.length resp0+           ixs <- U.replicateM n $ uniformR (0,n-1) gen+           let resp  = U.backpermute resp0 ixs+               preds = map (flip U.backpermute ixs) preds0+           return $ rgrss preds resp+      rnf v `seq` return v+  let (coeffsv, r2v) = G.unzip (V.concat vs)+  let coeffs  = flip G.imap (G.convert coeffss) $ \i x ->+                est x . U.generate numResamples $ \k -> (coeffsv G.! k) G.! i+      r2      = est r2s (G.convert r2v)+      (coeffss, r2s) = rgrss preds0 resp0+      est s v = estimateFromInterval s (w G.! lo, w G.! hi) cl+        where w  = F.sort v+              bounded i = min (U.length w - 1) (max 0 i)+              lo = bounded $ round c+              hi = bounded $ truncate (n - c)+              n  = fromIntegral numResamples+              c  = n * (significanceLevel cl / 2)+  return (coeffs, r2)++-- | Balance units of work across workers.+balance :: Int -> Int -> [Int]+balance numSlices numItems = zipWith (+) (replicate numSlices q)+                                         (replicate r 1 ++ repeat 0)+ where (q,r) = numItems `quotRem` numSlices
+ Statistics/Resampling.hs view
@@ -0,0 +1,262 @@+{-# LANGUAGE BangPatterns       #-}+{-# LANGUAGE CPP                #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFoldable     #-}+{-# LANGUAGE DeriveFunctor      #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE DeriveTraversable  #-}+{-# LANGUAGE FlexibleContexts   #-}+{-# LANGUAGE TypeFamilies       #-}++-- |+-- Module    : Statistics.Resampling+-- Copyright : (c) 2009, 2010 Bryan O'Sullivan+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Resampling statistics.++module Statistics.Resampling+    ( -- * Data types+      Resample(..)+    , Bootstrap(..)+    , Estimator(..)+    , estimate+      -- * Resampling+    , resampleST+    , resample+    , resampleVector+      -- * Jackknife+    , jackknife+    , jackknifeMean+    , jackknifeVariance+    , jackknifeVarianceUnb+    , jackknifeStdDev+      -- * Helper functions+    , splitGen+    ) where++import Control.Concurrent.Async (forConcurrently_)+import Control.Monad (forM_, forM, replicateM)+import Control.Monad.Primitive (PrimMonad(..))+import Data.Data (Data, Typeable)+import Data.Vector.Algorithms.Intro (sort)+import Data.Vector.Generic (unsafeFreeze,unsafeThaw)+import Data.Word (Word32)+import qualified Data.Foldable as T+import qualified Data.Traversable as T+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Unboxed.Mutable as MU++import GHC.Conc (numCapabilities)+import GHC.Generics (Generic)+import Numeric.Sum (Summation(..), kbn)+import Statistics.Function (indices)+import Statistics.Sample (mean, stdDev, variance, varianceUnbiased)+import Statistics.Types (Sample)+import System.Random.MWC (Gen, GenIO, initialize, uniformR, uniformVector)+++----------------------------------------------------------------+-- Data types+----------------------------------------------------------------++-- | A resample drawn randomly, with replacement, from a set of data+-- points.  Distinct from a normal array to make it harder for your+-- humble author's brain to go wrong.+newtype Resample = Resample {+      fromResample :: U.Vector Double+    } deriving (Eq, Read, Show, Typeable, Data, Generic)++data Bootstrap v a = Bootstrap+  { fullSample :: !a+  , resamples  :: v a+  }+  deriving (Eq, Read, Show , Generic, Functor, T.Foldable, T.Traversable+#if __GLASGOW_HASKELL__ >= 708+           , Typeable, Data+#endif+           )+++-- | An estimator of a property of a sample, such as its 'mean'.+--+-- The use of an algebraic data type here allows functions such as+-- 'jackknife' and 'bootstrapBCA' to use more efficient algorithms+-- when possible.+data Estimator = Mean+               | Variance+               | VarianceUnbiased+               | StdDev+               | Function (Sample -> Double)++-- | Run an 'Estimator' over a sample.+estimate :: Estimator -> Sample -> Double+estimate Mean             = mean+estimate Variance         = variance+estimate VarianceUnbiased = varianceUnbiased+estimate StdDev           = stdDev+estimate (Function est) = est+++----------------------------------------------------------------+-- Resampling+----------------------------------------------------------------++-- | Single threaded and deterministic version of resample.+resampleST :: PrimMonad m+           => Gen (PrimState m)+           -> [Estimator]         -- ^ Estimation functions.+           -> Int                 -- ^ Number of resamples to compute.+           -> U.Vector Double     -- ^ Original sample.+           -> m [Bootstrap U.Vector Double]+resampleST gen ests numResamples sample = do+  -- Generate resamples+  res <- forM ests $ \e -> U.replicateM numResamples $ do+    v <- resampleVector gen sample+    return $! estimate e v+  -- Sort resamples+  resM <- mapM unsafeThaw res+  mapM_ sort resM+  resSorted <- mapM unsafeFreeze resM+  return $ zipWith Bootstrap [estimate e sample | e <- ests]+                             resSorted+++-- | /O(e*r*s)/ Resample a data set repeatedly, with replacement,+-- computing each estimate over the resampled data.+--+-- This function is expensive; it has to do work proportional to+-- /e*r*s/, where /e/ is the number of estimation functions, /r/ is+-- the number of resamples to compute, and /s/ is the number of+-- original samples.+--+-- To improve performance, this function will make use of all+-- available CPUs.  At least with GHC 7.0, parallel performance seems+-- best if the parallel garbage collector is disabled (RTS option+-- @-qg@).+resample :: GenIO+         -> [Estimator]         -- ^ Estimation functions.+         -> Int                 -- ^ Number of resamples to compute.+         -> U.Vector Double     -- ^ Original sample.+         -> IO [(Estimator, Bootstrap U.Vector Double)]+resample gen ests numResamples samples = do+  let ixs = scanl (+) 0 $+            zipWith (+) (replicate numCapabilities q)+                        (replicate r 1 ++ repeat 0)+          where (q,r) = numResamples `quotRem` numCapabilities+  results <- mapM (const (MU.new numResamples)) ests+  gens <- splitGen numCapabilities gen+  forConcurrently_ (zip3 ixs (tail ixs) gens) $ \ (start,!end,gen') -> do+    -- on GHCJS it doesn't make sense to do any forking.+    -- JavaScript runtime has only single capability.+      let loop k ers | k >= end = return ()+                     | otherwise = do+            re <- resampleVector gen' samples+            forM_ ers $ \(est,arr) ->+                MU.write arr k . est $ re+            loop (k+1) ers+      loop start (zip ests' results)+  mapM_ sort results+  -- Build resamples+  res <- mapM unsafeFreeze results+  return $ zip ests+         $ zipWith Bootstrap [estimate e samples | e <- ests]+                             res+ where+  ests' = map estimate ests++-- | Create vector using resamples+resampleVector :: (PrimMonad m, G.Vector v a)+               => Gen (PrimState m) -> v a -> m (v a)+resampleVector gen v+  = G.replicateM n $ do i <- uniformR (0,n-1) gen+                        return $! G.unsafeIndex v i+  where+    n = G.length v+++----------------------------------------------------------------+-- Jackknife+----------------------------------------------------------------++-- | /O(n) or O(n^2)/ Compute a statistical estimate repeatedly over a+-- sample, each time omitting a successive element.+jackknife :: Estimator -> Sample -> U.Vector Double+jackknife Mean sample             = jackknifeMean sample+jackknife Variance sample         = jackknifeVariance sample+jackknife VarianceUnbiased sample = jackknifeVarianceUnb sample+jackknife StdDev sample = jackknifeStdDev sample+jackknife (Function est) sample+  | G.length sample == 1 = singletonErr "jackknife"+  | otherwise            = U.map f . indices $ sample+  where f i = est (dropAt i sample)++-- | /O(n)/ Compute the jackknife mean of a sample.+jackknifeMean :: Sample -> U.Vector Double+jackknifeMean samp+  | len == 1  = singletonErr "jackknifeMean"+  | otherwise = G.map (/l) $ G.zipWith (+) (pfxSumL samp) (pfxSumR samp)+  where+    l   = fromIntegral (len - 1)+    len = G.length samp++-- | /O(n)/ Compute the jackknife variance of a sample with a+-- correction factor @c@, so we can get either the regular or+-- \"unbiased\" variance.+jackknifeVariance_ :: Double -> Sample -> U.Vector Double+jackknifeVariance_ c samp+  | len == 1  = singletonErr "jackknifeVariance"+  | otherwise = G.zipWith4 go als ars bls brs+  where+    als = pfxSumL . G.map goa $ samp+    ars = pfxSumR . G.map goa $ samp+    goa x = v * v where v = x - m+    bls = pfxSumL . G.map (subtract m) $ samp+    brs = pfxSumR . G.map (subtract m) $ samp+    m = mean samp+    n = fromIntegral len+    go al ar bl br = (al + ar - (b * b) / q) / (q - c)+      where b = bl + br+            q = n - 1+    len = G.length samp++-- | /O(n)/ Compute the unbiased jackknife variance of a sample.+jackknifeVarianceUnb :: Sample -> U.Vector Double+jackknifeVarianceUnb samp+  | G.length samp == 2  = singletonErr "jackknifeVariance"+  | otherwise           = jackknifeVariance_ 1 samp++-- | /O(n)/ Compute the jackknife variance of a sample.+jackknifeVariance :: Sample -> U.Vector Double+jackknifeVariance = jackknifeVariance_ 0++-- | /O(n)/ Compute the jackknife standard deviation of a sample.+jackknifeStdDev :: Sample -> U.Vector Double+jackknifeStdDev = G.map sqrt . jackknifeVarianceUnb++pfxSumL :: U.Vector Double -> U.Vector Double+pfxSumL = G.map kbn . G.scanl add zero++pfxSumR :: U.Vector Double -> U.Vector Double+pfxSumR = G.tail . G.map kbn . G.scanr (flip add) zero++-- | Drop the /k/th element of a vector.+dropAt :: U.Unbox e => Int -> U.Vector e -> U.Vector e+dropAt n v = U.slice 0 n v U.++ U.slice (n+1) (U.length v - n - 1) v++singletonErr :: String -> a+singletonErr func = error $+                    "Statistics.Resampling." ++ func ++ ": not enough elements in sample"++-- | Split a generator into several that can run independently.+splitGen :: Int -> GenIO -> IO [GenIO]+splitGen n gen+  | n <= 0    = return []+  | otherwise =+  fmap (gen:) . replicateM (n-1) $+  initialize =<< (uniformVector gen 256 :: IO (U.Vector Word32))
+ Statistics/Resampling/Bootstrap.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE CPP #-}+-- |+-- Module    : Statistics.Resampling.Bootstrap+-- Copyright : (c) 2009, 2011 Bryan O'Sullivan+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- The bootstrap method for statistical inference.++module Statistics.Resampling.Bootstrap+    ( bootstrapBCA+    , basicBootstrap+    -- * References+    -- $references+    ) where++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 (Bootstrap(..), jackknife)+import Statistics.Sample (mean)+import Statistics.Types (Sample, CL, Estimate, ConfInt, estimateFromInterval,+                         estimateFromErr, CL, significanceLevel)+import Statistics.Function (gsort)++import qualified Statistics.Resampling as R++#if !defined(__GHCJS__)+import Control.Monad.Par (parMap, runPar)+#endif++data T = {-# UNPACK #-} !Double :< {-# UNPACK #-} !Double+infixl 2 :<++-- | Bias-corrected accelerated (BCA) bootstrap. This adjusts for both+--   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+#if defined(__GHCJS__)+  -- monad-par causes seems to cause "thread blocked indefinitely on MVar"+  -- on GHCJS still+  --+  -- I (phadej) would change the interface to return IO, and use mapConcurrently from async+  = map e resampledData+#else+  = runPar $ parMap e resampledData+#endif+  where+    e (est, Bootstrap pt resample)+      | U.length sample == 1 || isInfinite bias =+          estimateFromErr      pt (0,0) confidenceLevel+      | otherwise =+          estimateFromInterval pt (resample ! lo, resample ! hi) confidenceLevel+      where+        -- Quantile estimates for given CL+        lo    = min (max (cumn a1) 0) (ni - 1)+          where a1 = bias + b1 / (1 - accel * b1)+                b1 = bias + z1+        hi    = max (min (cumn a2) (ni - 1)) 0+          where a2 = bias + b2 / (1 - accel * b2)+                b2 = bias - z1+        -- 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+        accel = sumCubes / (6 * (sumSquares ** 1.5))+          where (sumSquares :< sumCubes) = U.foldl' f (0 :< 0) jack+                f (s :< c) j = s + d2 :< c + d2 * d+                    where d  = jackMean - j+                          d2 = d * d+                jackMean     = mean jack+        jack  = jackknife est sample+++-- | Basic bootstrap. This method simply uses empirical quantiles for+--   confidence interval.+basicBootstrap+  :: (G.Vector v a, Ord a, Num a)+  => CL Double       -- ^ Confidence vector+  -> Bootstrap v a   -- ^ Estimate from full sample and vector of+                     --   estimates obtained from resamples+  -> Estimate ConfInt a+{-# INLINE basicBootstrap #-}+basicBootstrap cl (Bootstrap e ests)+  = estimateFromInterval e (sorted ! lo, sorted ! hi) cl+  where+    sorted = gsort ests+    n  = fromIntegral $ G.length ests+    c  = n * (significanceLevel cl / 2)+    -- FIXME: can we have better estimates of quantiles in case when p+    --        is not multiple of 1/N+    --+    -- FIXME: we could have undercoverage here+    lo = round c+    hi = truncate (n - c)++-- $references+--+-- * Davison, A.C; Hinkley, D.V. (1997) Bootstrap methods and their+--   application. <http://statwww.epfl.ch/davison/BMA/>
+ Statistics/Sample.hs view
@@ -0,0 +1,454 @@+{-# LANGUAGE FlexibleContexts #-}+-- |+-- Module    : Statistics.Sample+-- Copyright : (c) 2008 Don Stewart, 2009 Bryan O'Sullivan+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Commonly used sample statistics, also known as descriptive+-- statistics.++module Statistics.Sample+    (+    -- * Types+      Sample+    , WeightedSample+    -- * Descriptive functions+    , range++    -- * Statistics of location+    , mean+    , welfordMean+    , meanWeighted+    , harmonicMean+    , geometricMean++    -- * Statistics of dispersion+    -- $variance++    -- ** Functions over central moments+    , centralMoment+    , centralMoments+    , skewness+    , kurtosis++    -- ** Two-pass functions (numerically robust)+    -- $robust+    , variance+    , varianceUnbiased+    , meanVariance+    , meanVarianceUnb+    , stdDev+    , varianceWeighted+    , stdErrMean++    -- ** Single-pass functions (faster, less safe)+    -- $cancellation+    , fastVariance+    , fastVarianceUnbiased+    , fastStdDev++    -- * Joint distirbutions+    , covariance+    , correlation+    , pair+    -- * References+    -- $references+    ) where++import Statistics.Function (minMax)+import Statistics.Sample.Internal (robustSumVar, sum)+import Statistics.Types.Internal  (Sample,WeightedSample)+import qualified Data.Vector as V+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Unboxed as U++-- Operator ^ will be overridden+import Prelude hiding ((^), sum)++-- | /O(n)/ Range. The difference between the largest and smallest+-- elements of a sample.+range :: (G.Vector v Double) => v Double -> Double+range s = hi - lo+    where (lo , hi) = minMax s+{-# INLINE range #-}++-- | /O(n)/ Arithmetic mean.  This uses Kahan-Babuška-Neumaier+-- summation, so is more accurate than 'welfordMean' unless the input+-- values are very large.+mean :: (G.Vector v Double) => v Double -> Double+mean xs = sum xs / fromIntegral (G.length xs)+{-# SPECIALIZE mean :: U.Vector Double -> Double #-}+{-# SPECIALIZE mean :: V.Vector Double -> Double #-}++-- | /O(n)/ Arithmetic mean.  This uses Welford's algorithm to provide+-- numerical stability, using a single pass over the sample data.+--+-- Compared to 'mean', this loses a surprising amount of precision+-- unless the inputs are very large.+welfordMean :: (G.Vector v Double) => v Double -> Double+welfordMean = fini . G.foldl' go (T 0 0)+  where+    fini (T a _) = a+    go (T m n) x = T m' n'+        where m' = m + (x - m) / fromIntegral n'+              n' = n + 1+{-# SPECIALIZE welfordMean :: U.Vector Double -> Double #-}+{-# SPECIALIZE welfordMean :: V.Vector Double -> Double #-}++-- | /O(n)/ Arithmetic mean for weighted sample. It uses a single-pass+-- algorithm analogous to the one used by 'welfordMean'.+meanWeighted :: (G.Vector v (Double,Double)) => v (Double,Double) -> Double+meanWeighted = fini . G.foldl' go (V 0 0)+    where+      fini (V a _) = a+      go (V m w) (x,xw) = V m' w'+          where m' | w' == 0   = 0+                   | otherwise = m + xw * (x - m) / w'+                w' = w + xw+{-# INLINE meanWeighted #-}++-- | /O(n)/ Harmonic mean.  This algorithm performs a single pass over+-- the sample.+harmonicMean :: (G.Vector v Double) => v Double -> Double+harmonicMean = fini . G.foldl' go (T 0 0)+  where+    fini (T b a) = fromIntegral a / b+    go (T x y) n = T (x + (1/n)) (y+1)+{-# INLINE harmonicMean #-}++-- | /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+{-# INLINE geometricMean #-}++-- | Compute the /k/th central moment of a sample.  The central moment+-- is also known as the moment about the mean.+--+-- This function performs two passes over the sample, so is not subject+-- to stream fusion.+--+-- For samples containing many values very close to the mean, this+-- function is subject to inaccuracy due to catastrophic cancellation.+centralMoment :: (G.Vector v Double) => Int -> v Double -> Double+centralMoment a xs+    | a < 0  = error "Statistics.Sample.centralMoment: negative input"+    | a == 0 = 1+    | a == 1 = 0+    | otherwise = sum (G.map go xs) / fromIntegral (G.length xs)+  where+    go x = (x-m) ^ a+    m    = mean xs+{-# SPECIALIZE centralMoment :: Int -> U.Vector Double -> Double #-}+{-# SPECIALIZE centralMoment :: Int -> V.Vector Double -> Double #-}++-- | Compute the /k/th and /j/th central moments of a sample.+--+-- This function performs two passes over the sample, so is not subject+-- to stream fusion.+--+-- For samples containing many values very close to the mean, this+-- function is subject to inaccuracy due to catastrophic cancellation.+centralMoments :: (G.Vector v Double) => Int -> Int -> v Double -> (Double, Double)+centralMoments a b xs+    | a < 2 || b < 2 = (centralMoment a xs , centralMoment b xs)+    | otherwise      = fini . G.foldl' go (V 0 0) $ xs+  where go (V i j) x = V (i + d^a) (j + d^b)+            where d  = x - m+        fini (V i j) = (i / n , j / n)+        m            = mean xs+        n            = fromIntegral (G.length xs)+{-# SPECIALIZE+    centralMoments :: Int -> Int -> U.Vector Double -> (Double, Double) #-}+{-# SPECIALIZE+    centralMoments :: Int -> Int -> V.Vector Double -> (Double, Double) #-}++-- | Compute the skewness of a sample. This is a measure of the+-- asymmetry of its distribution.+--+-- A sample with negative skew is said to be /left-skewed/.  Most of+-- its mass is on the right of the distribution, with the tail on the+-- left.+--+-- > skewness $ U.to [1,100,101,102,103]+-- > ==> -1.497681449918257+--+-- A sample with positive skew is said to be /right-skewed/.+--+-- > skewness $ U.to [1,2,3,4,100]+-- > ==> 1.4975367033335198+--+-- A sample's skewness is not defined if its 'variance' is zero.+--+-- This function performs two passes over the sample, so is not subject+-- to stream fusion.+--+-- For samples containing many values very close to the mean, this+-- function is subject to inaccuracy due to catastrophic cancellation.+skewness :: (G.Vector v Double) => v Double -> Double+skewness xs = c3 * c2 ** (-1.5)+    where (c3 , c2) = centralMoments 3 2 xs+{-# SPECIALIZE skewness :: U.Vector Double -> Double #-}+{-# SPECIALIZE skewness :: V.Vector Double -> Double #-}++-- | Compute the excess kurtosis of a sample.  This is a measure of+-- the \"peakedness\" of its distribution.  A high kurtosis indicates+-- that more of the sample's variance is due to infrequent severe+-- deviations, rather than more frequent modest deviations.+--+-- A sample's excess kurtosis is not defined if its 'variance' is+-- zero.+--+-- This function performs two passes over the sample, so is not subject+-- to stream fusion.+--+-- For samples containing many values very close to the mean, this+-- function is subject to inaccuracy due to catastrophic cancellation.+kurtosis :: (G.Vector v Double) => v Double -> Double+kurtosis xs = c4 / (c2 * c2) - 3+    where (c4 , c2) = centralMoments 4 2 xs+{-# SPECIALIZE kurtosis :: U.Vector Double -> Double #-}+{-# SPECIALIZE kurtosis :: V.Vector Double -> Double #-}++-- $variance+--+-- The variance&#8212;and hence the standard deviation&#8212;of a+-- sample of fewer than two elements are both defined to be zero.++-- $robust+--+-- These functions use the compensated summation algorithm of Chan et+-- al. for numerical robustness, but require two passes over the+-- sample data as a result.+--+-- Because of the need for two passes, these functions are /not/+-- subject to stream fusion.++data V = V {-# UNPACK #-} !Double {-# UNPACK #-} !Double++-- | Maximum likelihood estimate of a sample's variance.  Also known+-- as the population variance, where the denominator is /n/.+variance :: (G.Vector v Double) => v Double -> Double+variance samp+    | n > 1     = robustSumVar (mean samp) samp / fromIntegral n+    | otherwise = 0+    where+      n = G.length samp+{-# SPECIALIZE variance :: U.Vector Double -> Double #-}+{-# SPECIALIZE variance :: V.Vector Double -> Double #-}+++-- | Unbiased estimate of a sample's variance.  Also known as the+-- sample variance, where the denominator is /n/-1.+varianceUnbiased :: (G.Vector v Double) => v Double -> Double+varianceUnbiased samp+    | n > 1     = robustSumVar (mean samp) samp / fromIntegral (n-1)+    | otherwise = 0+    where+      n = G.length samp+{-# SPECIALIZE varianceUnbiased :: U.Vector Double -> Double #-}+{-# SPECIALIZE varianceUnbiased :: V.Vector Double -> Double #-}++-- | Calculate mean and maximum likelihood estimate of variance. This+-- function should be used if both mean and variance are required+-- since it will calculate mean only once.+meanVariance ::  (G.Vector v Double) => v Double -> (Double,Double)+meanVariance samp+  | n > 1     = (m, robustSumVar m samp / fromIntegral n)+  | otherwise = (m, 0)+    where+      n = G.length samp+      m = mean samp+{-# SPECIALIZE meanVariance :: U.Vector Double -> (Double,Double) #-}+{-# SPECIALIZE meanVariance :: V.Vector Double -> (Double,Double) #-}++-- | Calculate mean and unbiased estimate of variance. This+-- function should be used if both mean and variance are required+-- since it will calculate mean only once.+meanVarianceUnb :: (G.Vector v Double) => v Double -> (Double,Double)+meanVarianceUnb samp+  | n > 1     = (m, robustSumVar m samp / fromIntegral (n-1))+  | otherwise = (m, 0)+    where+      n = G.length samp+      m = mean samp+{-# SPECIALIZE meanVarianceUnb :: U.Vector Double -> (Double,Double) #-}+{-# SPECIALIZE meanVarianceUnb :: V.Vector Double -> (Double,Double) #-}++-- | Standard deviation.  This is simply the square root of the+-- unbiased estimate of the variance.+stdDev :: (G.Vector v Double) => v Double -> Double+stdDev = sqrt . varianceUnbiased+{-# SPECIALIZE stdDev :: U.Vector Double -> Double #-}+{-# SPECIALIZE stdDev :: V.Vector Double -> Double #-}++-- | Standard error of the mean. This is the standard deviation+-- divided by the square root of the sample size.+stdErrMean :: (G.Vector v Double) => v Double -> Double+stdErrMean samp = stdDev samp / (sqrt . fromIntegral . G.length) samp+{-# SPECIALIZE stdErrMean :: U.Vector Double -> Double #-}+{-# SPECIALIZE stdErrMean :: V.Vector Double -> Double #-}++robustSumVarWeighted :: (G.Vector v (Double,Double)) => v (Double,Double) -> V+robustSumVarWeighted samp = G.foldl' go (V 0 0) samp+    where+      go (V s w) (x,xw) = V (s + xw*d*d) (w + xw)+          where d = x - m+      m = meanWeighted samp+{-# INLINE robustSumVarWeighted #-}++-- | Weighted variance. This is biased estimation.+varianceWeighted :: (G.Vector v (Double,Double)) => v (Double,Double) -> Double+varianceWeighted samp+    | G.length samp > 1 = fini $ robustSumVarWeighted samp+    | otherwise         = 0+    where+      fini (V s w) = s / w+{-# SPECIALIZE varianceWeighted :: U.Vector (Double,Double) -> Double #-}+{-# SPECIALIZE varianceWeighted :: V.Vector (Double,Double) -> Double #-}++-- $cancellation+--+-- The functions prefixed with the name @fast@ below perform a single+-- pass over the sample data using Knuth's algorithm. They usually+-- work well, but see below for caveats. These functions are subject+-- to array fusion.+--+-- /Note/: in cases where most sample data is close to the sample's+-- mean, Knuth's algorithm gives inaccurate results due to+-- catastrophic cancellation.++fastVar :: (G.Vector v Double) => v Double -> T1+fastVar = G.foldl' go (T1 0 0 0)+  where+    go (T1 n m s) x = T1 n' m' s'+      where n' = n + 1+            m' = m + d / fromIntegral n'+            s' = s + d * (x - m')+            d  = x - m++-- | Maximum likelihood estimate of a sample's variance.+fastVariance :: (G.Vector v Double) => v Double -> Double+fastVariance = fini . fastVar+  where fini (T1 n _m s)+          | n > 1     = s / fromIntegral n+          | otherwise = 0+{-# INLINE fastVariance #-}++-- | Unbiased estimate of a sample's variance.+fastVarianceUnbiased :: (G.Vector v Double) => v Double -> Double+fastVarianceUnbiased = fini . fastVar+  where fini (T1 n _m s)+          | n > 1     = s / fromIntegral (n - 1)+          | otherwise = 0+{-# INLINE fastVarianceUnbiased #-}++-- | Standard deviation.  This is simply the square root of the+-- maximum likelihood estimate of the variance.+fastStdDev :: (G.Vector v Double) => v Double -> Double+fastStdDev = sqrt . fastVariance+{-# INLINE fastStdDev #-}++-- | Covariance of sample of pairs. For empty sample it's set to+--   zero+covariance :: (G.Vector v (Double,Double), G.Vector v 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)+  where+    n       = G.length xy+    (xs,ys) = G.unzip xy+    muX     = mean xs+    muY     = mean ys+{-# 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)+           => 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)+{-# SPECIALIZE correlation :: U.Vector (Double,Double) -> Double #-}+{-# SPECIALIZE correlation :: V.Vector (Double,Double) -> Double #-}+++-- | Pair two samples. It's like 'G.zip' but requires that both+--   samples have equal size.+pair :: (G.Vector v a, G.Vector v b, G.Vector v (a,b)) => v a -> v b -> v (a,b)+pair va vb+  | G.length va == G.length vb = G.zip va vb+  | otherwise = error "Statistics.Sample.pair: vector must have same length"+{-# INLINE pair #-}++------------------------------------------------------------------------+-- Helper code. Monomorphic unpacked accumulators.++-- (^) operator from Prelude is just slow.+(^) :: Double -> Int -> Double+x ^ 1 = x+x ^ n = x * (x ^ (n-1))+{-# INLINE (^) #-}++-- don't support polymorphism, as we can't get unboxed returns if we use it.+data T = T {-# UNPACK #-}!Double {-# UNPACK #-}!Int++data T1 = T1 {-# UNPACK #-}!Int {-# UNPACK #-}!Double {-# UNPACK #-}!Double++{-++Consider this core:++with data T a = T !a !Int++$wfold :: Double#+               -> Int#+               -> Int#+               -> (# Double, Int# #)++and without,++$wfold :: Double#+               -> Int#+               -> Int#+               -> (# Double#, Int# #)++yielding to boxed returns and heap checks.++-}++-- $references+--+-- * Chan, T. F.; Golub, G.H.; LeVeque, R.J. (1979) Updating formulae+--   and a pairwise algorithm for computing sample+--   variances. Technical Report STAN-CS-79-773, Department of+--   Computer Science, Stanford+--   University. <ftp://reports.stanford.edu/pub/cstr/reports/cs/tr/79/773/CS-TR-79-773.pdf>+--+-- * Knuth, D.E. (1998) The art of computer programming, volume 2:+--   seminumerical algorithms, 3rd ed., p. 232.+--+-- * Welford, B.P. (1962) Note on a method for calculating corrected+--   sums of squares and products. /Technometrics/+--   4(3):419&#8211;420. <http://www.jstor.org/stable/1266577>+--+-- * West, D.H.D. (1979) Updating mean and variance estimates: an+--   improved method. /Communications of the ACM/+--   22(9):532&#8211;535. <http://doi.acm.org/10.1145/359146.359153>
+ Statistics/Sample/Histogram.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE FlexibleContexts, BangPatterns #-}++-- |+-- Module    : Statistics.Sample.Histogram+-- Copyright : (c) 2011 Bryan O'Sullivan+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Functions for computing histograms of sample data.++module Statistics.Sample.Histogram+    (+      histogram+    -- * Building blocks+    , histogram_+    , range+    ) where++import Numeric.MathFunctions.Constants (m_epsilon,m_tiny)+import Statistics.Function (minMax)+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Generic.Mutable as GM++-- | /O(n)/ Compute a histogram over a data set.+--+-- The result consists of a pair of vectors:+--+-- * The lower bound of each interval.+--+-- * The number of samples within the interval.+--+-- Interval (bin) sizes are uniform, and the upper and lower bounds+-- are chosen automatically using the 'range' function.  To specify+-- these parameters directly, use the 'histogram_' function.+histogram :: (G.Vector v0 Double, G.Vector v1 Double, Num b, G.Vector v1 b) =>+             Int                -- ^ Number of bins (must be positive).+          -> v0 Double          -- ^ Sample data (cannot be empty).+          -> (v1 Double, v1 b)+histogram numBins xs = (G.generate numBins step, histogram_ numBins lo hi xs)+    where (lo,hi)    = range numBins xs+          step i     = lo + d * fromIntegral i+          d          = (hi - lo) / fromIntegral numBins+{-# INLINE histogram #-}++-- | /O(n)/ Compute a histogram over a data set.+--+-- Interval (bin) sizes are uniform, based on the supplied upper+-- and lower bounds.+histogram_ :: (Num b, RealFrac a, G.Vector v0 a, G.Vector v1 b) =>+              Int+           -- ^ Number of bins.  This value must be positive.  A zero+           -- or negative value will cause an error.+           -> a+           -- ^ Lower bound on interval range.  Sample data less than+           -- this will cause an error.+           -> a+           -- ^ Upper bound on interval range.  This value must not be+           -- less than the lower bound.  Sample data that falls above+           -- the upper bound will cause an error.+           -> v0 a+           -- ^ Sample data.+           -> v1 b+histogram_ numBins lo hi xs0 = G.create (GM.replicate numBins 0 >>= bin xs0)+  where+    bin xs bins = go 0+     where+       go i | i >= len = return bins+            | otherwise = do+         let x = xs `G.unsafeIndex` i+             b = truncate $ (x - lo) / d+         write' bins b . (+1) =<< GM.read bins b+         go (i+1)+       write' bins' b !e = GM.write bins' b e+       len = G.length xs+       d = ((hi - lo) * (1 + realToFrac m_epsilon)) / fromIntegral numBins+{-# INLINE histogram_ #-}++-- | /O(n)/ Compute decent defaults for the lower and upper bounds of+-- a histogram, based on the desired number of bins and the range of+-- the sample data.+--+-- The upper and lower bounds used are @(lo-d, hi+d)@, where+--+-- @d = (maximum sample - minimum sample) / ((bins - 1) * 2)@+--+-- If all elements in the sample are the same and equal to @x@ range+-- is set to @(x - |x|/10, x + |x|/10)@. And if @x@ is equal to 0 range+-- is set to @(-1,1)@. This is needed to avoid creating histogram with+-- zero bin size.+range :: (G.Vector v Double) =>+         Int                    -- ^ Number of bins (must be positive).+      -> v Double               -- ^ Sample data (cannot be empty).+      -> (Double, Double)+range numBins xs+    | numBins < 1 = error "Statistics.Histogram.range: invalid bin count"+    | G.null xs   = error "Statistics.Histogram.range: empty sample"+    | lo == hi    = case abs lo / 10 of+                      a | a < m_tiny -> (-1,1)+                        | otherwise  -> (lo - a, lo + a)+    | otherwise   = (lo-d, hi+d)+  where+    d | numBins == 1 = 0+      | otherwise    = (hi - lo) / ((fromIntegral numBins - 1) * 2)+    (lo,hi)          = minMax xs+{-# INLINE range #-}
+ Statistics/Sample/Internal.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE FlexibleContexts #-}++-- |+-- Module    : Statistics.Sample.Internal+-- Copyright : (c) 2013 Bryan O'Sullivan+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Internal functions for computing over samples.+module Statistics.Sample.Internal+    (+      robustSumVar+    , sum+    ) where++import Numeric.Sum (kbn, sumVector)+import Prelude hiding (sum)+import Statistics.Function (square)+import qualified Data.Vector.Generic as G++robustSumVar :: (G.Vector v Double) => Double -> v Double -> Double+robustSumVar m = sum . G.map (square . subtract m)+{-# INLINE robustSumVar #-}++sum :: (G.Vector v Double) => v Double -> Double+sum = sumVector kbn+{-# INLINE sum #-}
+ Statistics/Sample/KernelDensity.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE BangPatterns, FlexibleContexts, UnboxedTuples #-}+-- |+-- Module    : Statistics.Sample.KernelDensity+-- Copyright : (c) 2011 Bryan O'Sullivan+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Kernel density estimation.  This module provides a fast, robust,+-- non-parametric way to estimate the probability density function of+-- a sample.+--+-- This estimator does not use the commonly employed \"Gaussian rule+-- of thumb\".  As a result, it outperforms many plug-in methods on+-- multimodal samples with widely separated modes.++module Statistics.Sample.KernelDensity+    (+    -- * Estimation functions+      kde+    , kde_+    -- * References+    -- $references+    ) where++import Data.Default.Class+import Numeric.MathFunctions.Constants (m_sqrt_2_pi)+import Numeric.RootFinding             (fromRoot, ridders, RiddersParam(..), Tolerance(..))+import Prelude hiding (const, min, max, sum)+import Statistics.Function (minMax, nextHighestPowerOfTwo)+import Statistics.Sample.Histogram (histogram_)+import Statistics.Sample.Internal (sum)+import Statistics.Transform (CD, dct, idct)+import qualified Data.Vector.Generic  as G+import qualified Data.Vector.Unboxed  as U+import qualified Data.Vector          as V+++-- | Gaussian kernel density estimator for one-dimensional data, using+-- the method of Botev et al.+--+-- The result is a pair of vectors, containing:+--+-- * The coordinates of each mesh point.  The mesh interval is chosen+--   to be 20% larger than the range of the sample.  (To specify the+--   mesh interval, use 'kde_'.)+--+-- * Density estimates at each mesh point.+kde :: (G.Vector v CD, G.Vector v Double, G.Vector v Int)+    => Int+    -- ^ The number of mesh points to use in the uniform discretization+    -- of the interval @(min,max)@.  If this value is not a power of+    -- two, then it is rounded up to the next power of two.+    -> v Double -> (v Double, v Double)+kde n0 xs = kde_ n0 (lo - range / 10) (hi + range / 10) xs+  where+    (lo,hi) = minMax xs+    range   | G.length xs <= 1 = 1       -- Unreasonable guess+            | lo == hi         = 1       -- All elements are equal+            | otherwise        = hi - lo+{-# INLINABLE  kde #-}+{-# SPECIAlIZE kde :: Int -> U.Vector Double -> (U.Vector Double, U.Vector Double) #-}+{-# SPECIAlIZE kde :: Int -> V.Vector Double -> (V.Vector Double, V.Vector Double) #-}+++-- | Gaussian kernel density estimator for one-dimensional data, using+-- the method of Botev et al.+--+-- The result is a pair of vectors, containing:+--+-- * The coordinates of each mesh point.+--+-- * Density estimates at each mesh point.+kde_ :: (G.Vector v CD, G.Vector v Double, G.Vector v Int)+     => Int+     -- ^ The number of mesh points to use in the uniform discretization+     -- of the interval @(min,max)@.  If this value is not a power of+     -- two, then it is rounded up to the next power of two.+     -> Double+     -- ^ Lower bound (@min@) of the mesh range.+     -> Double+     -- ^ Upper bound (@max@) of the mesh range.+     -> v Double+     -> (v Double, v Double)+kde_ n0 min max xs+  | G.null xs = error "Statistics.KernelDensity.kde: empty sample"+  | n0 <= 1   = error "Statistics.KernelDensity.kde: invalid number of points"+  | otherwise = (mesh, density)+  where+    mesh = G.generate ni $ \z -> min + (d * fromIntegral z)+        where d = r / (n-1)+    density = G.map (/(2 * r)) . idct $ G.zipWith f a (G.enumFromTo 0 (n-1))+      where f b z = b * exp (sqr z * sqr pi * t_star * (-0.5))+    !n  = fromIntegral ni+    !ni = nextHighestPowerOfTwo n0+    !r  = max - min+    a   = dct . G.map (/ sum h) $ h+        where h = G.map (/ len) $ histogram_ ni min max xs+    !len    = fromIntegral (G.length xs)+    !t_star = fromRoot (0.28 * len ** (-0.4)) . ridders def{ riddersTol = AbsTol 1e-14 } (0,0.1)+            $ \x -> x - (len * (2 * sqrt pi) * go 6 (f 7 x)) ** (-0.4)+      where+        f q t = 2 * pi ** (q*2) * sum (G.zipWith g iv a2v)+          where g i a2 = i ** q * a2 * exp ((-i) * sqr pi * t)+                a2v = G.map (sqr . (*0.5)) $ G.tail a+                iv = G.map sqr $ G.enumFromTo 1 (n-1)+        go s !h | s == 1    = h+                | otherwise = go (s-1) (f s time)+          where time  = (2 * const * k0 / len / h) ** (2 / (3 + 2 * s))+                const = (1 + 0.5 ** (s+0.5)) / 3+                k0    = U.product (G.enumFromThenTo 1 3 (2*s-1)) / m_sqrt_2_pi+    sqr x = x * x+{-# INLINABLE  kde_ #-}+{-# SPECIAlIZE kde_ :: Int -> Double -> Double -> U.Vector Double -> (U.Vector Double, U.Vector Double) #-}+{-# SPECIAlIZE kde_ :: Int -> Double -> Double -> V.Vector Double -> (V.Vector Double, V.Vector Double) #-}+++-- $references+--+-- Botev. Z.I., Grotowski J.F., Kroese D.P. (2010). Kernel density+-- estimation via diffusion. /Annals of Statistics/+-- 38(5):2916&#8211;2957. <http://arxiv.org/pdf/1011.2602>
+ Statistics/Sample/KernelDensity/Simple.hs view
@@ -0,0 +1,195 @@+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, FlexibleContexts #-}+-- |+-- Module    : Statistics.Sample.KernelDensity.Simple+-- Copyright : (c) 2009 Bryan O'Sullivan+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Kernel density estimation code, providing non-parametric ways to+-- estimate the probability density function of a sample.+--+-- The techniques used by functions in this module are relatively+-- fast, but they generally give inferior results to the KDE function+-- in the main 'Statistics.KernelDensity' module (due to the+-- oversmoothing documented for 'bandwidth' below).++module Statistics.Sample.KernelDensity.Simple+    {-# DEPRECATED "Use Statistics.Sample.KernelDensity instead." #-}+    (+    -- * Simple entry points+      epanechnikovPDF+    , gaussianPDF+    -- * Building blocks+    -- These functions may be useful if you need to construct a kernel+    -- density function estimator other than the ones provided in this+    -- module.++    -- ** Choosing points from a sample+    , Points(..)+    , choosePoints+    -- ** Bandwidth estimation+    , Bandwidth+    , bandwidth+    , epanechnikovBW+    , gaussianBW+    -- ** Kernels+    , Kernel+    , epanechnikovKernel+    , gaussianKernel+    -- ** Low-level estimation+    , estimatePDF+    , simplePDF+    -- * References+    -- $references+    ) where++import Data.Data (Data, Typeable)+import GHC.Generics (Generic)+import Numeric.MathFunctions.Constants (m_1_sqrt_2, m_2_sqrt_pi)+import Prelude hiding (sum)+import Statistics.Function (minMax)+import Statistics.Sample (stdDev)+import Statistics.Sample.Internal (sum)+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Unboxed as U++-- | Points from the range of a 'Sample'.+newtype Points = Points {+      fromPoints :: U.Vector Double+    } deriving (Eq, Read, Show, Typeable, Data, Generic)++-- | Bandwidth estimator for an Epanechnikov kernel.+epanechnikovBW :: Double -> Bandwidth+epanechnikovBW n = (80 / (n * m_2_sqrt_pi)) ** 0.2++-- | Bandwidth estimator for a Gaussian kernel.+gaussianBW :: Double -> Bandwidth+gaussianBW n = (4 / (n * 3)) ** 0.2++-- | The width of the convolution kernel used.+type Bandwidth = Double++-- | Compute the optimal bandwidth from the observed data for the+-- given kernel.+--+-- This function uses an estimate based on the standard deviation of a+-- sample (due to Deheuvels), which performs reasonably well for+-- unimodal distributions but leads to oversmoothing for more complex+-- ones.+bandwidth :: G.Vector v Double =>+             (Double -> Bandwidth)+          -> v Double+          -> Bandwidth+bandwidth kern values = stdDev values * kern (fromIntegral $ G.length values)++-- | Choose a uniform range of points at which to estimate a sample's+-- probability density function.+--+-- If you are using a Gaussian kernel, multiply the sample's bandwidth+-- by 3 before passing it to this function.+--+-- If this function is passed an empty vector, it returns values of+-- positive and negative infinity.+choosePoints :: G.Vector v Double =>+                Int             -- ^ Number of points to select, /n/+             -> Double          -- ^ Sample bandwidth, /h/+             -> v Double        -- ^ Input data+             -> Points+choosePoints n h sample = Points . U.map f $ U.enumFromTo 0 n'+  where lo     = a - h+        hi     = z + h+        (a, z) = minMax sample+        d      = (hi - lo) / fromIntegral n'+        f i    = lo + fromIntegral i * d+        n'     = n - 1++-- | The convolution kernel.  Its parameters are as follows:+--+-- * Scaling factor, 1\//nh/+--+-- * Bandwidth, /h/+--+-- * A point at which to sample the input, /p/+--+-- * One sample value, /v/+type Kernel =  Double+            -> Double+            -> Double+            -> Double+            -> Double++-- | Epanechnikov kernel for probability density function estimation.+epanechnikovKernel :: Kernel+epanechnikovKernel f h p v+    | abs u <= 1 = f * (1 - u * u)+    | otherwise  = 0+    where u = (v - p) / (h * 0.75)++-- | Gaussian kernel for probability density function estimation.+gaussianKernel :: Kernel+gaussianKernel f h p v = exp (-0.5 * u * u) * g+    where u = (v - p) / h+          g = f * 0.5 * m_2_sqrt_pi * m_1_sqrt_2++-- | Kernel density estimator, providing a non-parametric way of+-- estimating the PDF of a random variable.+estimatePDF :: G.Vector v Double =>+               Kernel           -- ^ Kernel function+            -> Bandwidth        -- ^ Bandwidth, /h/+            -> v Double         -- ^ Sample data+            -> Points           -- ^ Points at which to estimate+            -> U.Vector Double+estimatePDF kernel h sample+    | n < 2     = errorShort "estimatePDF"+    | otherwise = U.map k . fromPoints+  where+    k p = sum . G.map (kernel f h p) $ sample+    f   = 1 / (h * fromIntegral n)+    n   = G.length sample+{-# INLINE estimatePDF #-}++-- | A helper for creating a simple kernel density estimation function+-- with automatically chosen bandwidth and estimation points.+simplePDF :: G.Vector v Double =>+             (Double -> Double) -- ^ Bandwidth function+          -> Kernel             -- ^ Kernel function+          -> Double             -- ^ Bandwidth scaling factor (3 for a Gaussian kernel, 1 for all others)+          -> Int                -- ^ Number of points at which to estimate+          -> v Double           -- ^ sample data+          -> (Points, U.Vector Double)+simplePDF fbw fpdf k numPoints sample =+    (points, estimatePDF fpdf bw sample points)+  where points = choosePoints numPoints (bw*k) sample+        bw     = bandwidth fbw sample+{-# INLINE simplePDF #-}++-- | Simple Epanechnikov kernel density estimator.  Returns the+-- uniformly spaced points from the sample range at which the density+-- function was estimated, and the estimates at those points.+epanechnikovPDF :: G.Vector v Double =>+                   Int          -- ^ Number of points at which to estimate+                -> v Double     -- ^ Data sample+                -> (Points, U.Vector Double)+epanechnikovPDF = simplePDF epanechnikovBW epanechnikovKernel 1++-- | Simple Gaussian kernel density estimator.  Returns the uniformly+-- spaced points from the sample range at which the density function+-- was estimated, and the estimates at those points.+gaussianPDF :: G.Vector v Double =>+               Int              -- ^ Number of points at which to estimate+            -> v Double         -- ^ Data sample+            -> (Points, U.Vector Double)+gaussianPDF = simplePDF gaussianBW gaussianKernel 3++errorShort :: String -> a+errorShort func = error ("Statistics.KernelDensity." ++ func +++                        ": at least two points required")++-- $references+--+-- * Deheuvels, P. (1977) Estimation non paramétrique de la densité+--   par histogrammes+--   généralisés. Mhttp://archive.numdam.org/article/RSA_1977__25_3_5_0.pdf>
+ Statistics/Sample/Normalize.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE FlexibleContexts #-}++-- |+-- Module    : Statistics.Sample.Normalize+-- Copyright : (c) 2017 Gregory W. Schwartz+-- License   : BSD3+--+-- Maintainer  : gsch@mail.med.upenn.edu+-- Stability   : experimental+-- Portability : portable+--+-- Functions for normalizing samples.++module Statistics.Sample.Normalize+    (+      standardize+    ) where++import Statistics.Sample+import qualified Data.Vector.Generic  as G+import qualified Data.Vector          as V+import qualified Data.Vector.Unboxed  as U+import qualified Data.Vector.Storable as S++-- | /O(n)/ Normalize a sample using standard scores:+--+--   \[ z = \frac{x - \mu}{\sigma} \]+--+--   Where μ is sample mean and σ is standard deviation computed from+--   unbiased variance estimation. If sample to small to compute σ or+--   it's equal to 0 @Nothing@ is returned.+standardize :: (G.Vector v Double) => v Double -> Maybe (v Double)+standardize xs+  | G.length xs < 2 = Nothing+  | sigma == 0      = Nothing+  | otherwise       = Just $ G.map (\x -> (x - mu) / sigma) xs+  where+    mu    = mean   xs+    sigma = stdDev xs+{-# INLINABLE  standardize #-}+{-# SPECIALIZE standardize :: V.Vector Double -> Maybe (V.Vector Double) #-}+{-# SPECIALIZE standardize :: U.Vector Double -> Maybe (U.Vector Double) #-}+{-# SPECIALIZE standardize :: S.Vector Double -> Maybe (S.Vector Double) #-}
+ Statistics/Sample/Powers.hs view
@@ -0,0 +1,211 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric,+    FlexibleContexts #-}+-- |+-- Module    : Statistics.Sample.Powers+-- Copyright : (c) 2009, 2010 Bryan O'Sullivan+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Very fast statistics over simple powers of a sample.  These can all+-- be computed efficiently in just a single pass over a sample, with+-- that pass subject to stream fusion.+--+-- The tradeoff is that some of these functions are less numerically+-- robust than their counterparts in the 'Statistics.Sample' module.+-- Where this is the case, the alternatives are noted.++module Statistics.Sample.Powers+    (+    -- * Types+      Powers++    -- * Constructor+    , powers++    -- * Descriptive functions+    , order+    , count+    , sum++    -- * Statistics of location+    , mean++    -- * Statistics of dispersion+    , variance+    , stdDev+    , varianceUnbiased++    -- * Functions over central moments+    , centralMoment+    , skewness+    , kurtosis++    -- * References+    -- $references+    ) where++import Control.Monad.ST+import Data.Data             (Data, Typeable)+import Data.Vector.Unboxed   ((!))+import GHC.Generics          (Generic)+import Numeric.SpecFunctions (choose)+import Prelude hiding (sum)+import Statistics.Function   (indexed)+import qualified Data.Vector          as V+import qualified Data.Vector.Generic  as G+import qualified Data.Vector.Storable as SV+import qualified Data.Vector.Unboxed  as U+import qualified Data.Vector.Unboxed.Mutable as MU+import qualified Statistics.Sample.Internal  as S++newtype Powers = Powers (U.Vector Double)+    deriving (Eq, Read, Show, Typeable, Data, Generic)++-- | O(/n/) Collect the /n/ simple powers of a sample.+--+-- Functions computed over a sample's simple powers require at least a+-- certain number (or /order/) of powers to be collected.+--+-- * To compute the /k/th 'centralMoment', at least /k/ simple powers+--   must be collected.+--+-- * For the 'variance', at least 2 simple powers are needed.+--+-- * For 'skewness', we need at least 3 simple powers.+--+-- * For 'kurtosis', at least 4 simple powers are required.+--+-- This function is subject to stream fusion.+powers :: G.Vector v Double =>+          Int                   -- ^ /n/, the number of powers, where /n/ >= 2.+       -> v Double+       -> Powers+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+    l = k + 1+{-# SPECIALIZE powers :: Int -> U.Vector  Double -> Powers #-}+{-# SPECIALIZE powers :: Int -> V.Vector  Double -> Powers #-}+{-# SPECIALIZE powers :: Int -> SV.Vector Double -> Powers #-}++-- | The order (number) of simple powers collected from a 'sample'.+order :: Powers -> Int+order (Powers pa) = U.length pa - 1++-- | Compute the /k/th central moment of a sample.  The central+-- moment is also known as the moment about the mean.+centralMoment :: Int -> Powers -> Double+centralMoment k p@(Powers pa)+    | k < 0 || k > order p =+                  error ("Statistics.Sample.Powers.centralMoment: "+                         ++ "invalid argument")+    | k == 0    = 1+    | otherwise = (/n) . S.sum . U.map go . indexed . U.take (k+1) $ pa+  where+    go (i , e) = (k `choose` i) * ((-m) ^ (k-i)) * e+    n = U.head pa+    m = mean p++-- | Maximum likelihood estimate of a sample's variance.  Also known+-- as the population variance, where the denominator is /n/.  This is+-- the second central moment of the sample.+--+-- This is less numerically robust than the variance function in the+-- 'Statistics.Sample' module, but the number is essentially free to+-- compute if you have already collected a sample's simple powers.+--+-- Requires 'Powers' with 'order' at least 2.+variance :: Powers -> Double+variance = centralMoment 2++-- | Standard deviation.  This is simply the square root of the+-- maximum likelihood estimate of the variance.+stdDev :: Powers -> Double+stdDev = sqrt . variance++-- | Unbiased estimate of a sample's variance.  Also known as the+-- sample variance, where the denominator is /n/-1.+--+-- Requires 'Powers' with 'order' at least 2.+varianceUnbiased :: Powers -> Double+varianceUnbiased p@(Powers pa)+    | n > 1     = variance p * n / (n-1)+    | otherwise = 0+  where n = U.head pa++-- | Compute the skewness of a sample. This is a measure of the+-- asymmetry of its distribution.+--+-- A sample with negative skew is said to be /left-skewed/.  Most of+-- its mass is on the right of the distribution, with the tail on the+-- left.+--+-- > skewness . powers 3 $ U.to [1,100,101,102,103]+-- > ==> -1.497681449918257+--+-- A sample with positive skew is said to be /right-skewed/.+--+-- > skewness . powers 3 $ U.to [1,2,3,4,100]+-- > ==> 1.4975367033335198+--+-- A sample's skewness is not defined if its 'variance' is zero.+--+-- Requires 'Powers' with 'order' at least 3.+skewness :: Powers -> Double+skewness p = centralMoment 3 p * variance p ** (-1.5)++-- | Compute the excess kurtosis of a sample.  This is a measure of+-- the \"peakedness\" of its distribution.  A high kurtosis indicates+-- that the sample's variance is due more to infrequent severe+-- deviations than to frequent modest deviations.+--+-- A sample's excess kurtosis is not defined if its 'variance' is+-- zero.+--+-- Requires 'Powers' with 'order' at least 4.+kurtosis :: Powers -> Double+kurtosis p = centralMoment 4 p / (v * v) - 3+    where v = variance p++-- | The number of elements in the original 'Sample'.  This is the+-- sample's zeroth simple power.+count :: Powers -> Int+count (Powers pa) = floor $ U.head pa++-- | The sum of elements in the original 'Sample'.  This is the+-- sample's first simple power.+sum :: Powers -> Double+sum (Powers pa) = pa ! 1++-- | The arithmetic mean of elements in the original 'Sample'.+--+-- This is less numerically robust than the mean function in the+-- 'Statistics.Sample' module, but the number is essentially free to+-- compute if you have already collected a sample's simple powers.+mean :: Powers -> Double+mean p@(Powers pa)+    | n == 0    = 0+    | otherwise = sum p / n+    where n     = U.head pa++-- $references+--+-- * Besset, D.H. (2000) Elements of statistics.+--   /Object-oriented implementation of numerical methods/+--   ch. 9, pp. 311&#8211;331.+--   <http://www.elsevier.com/wps/product/cws_home/677916>+--+-- * Anderson, G. (2009) Compute /k/th central moments in one+--   pass. /quantblog/. <http://quantblog.wordpress.com/2009/02/07/compute-kth-central-moments-in-one-pass/>
+ Statistics/Test/ChiSquared.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE FlexibleContexts #-}+-- | Pearson's chi squared test.+module Statistics.Test.ChiSquared (+    chi2test+  , chi2testCont+  , module Statistics.Test.Types+  ) where++import Prelude hiding (sum)++import Statistics.Distribution+import Statistics.Distribution.ChiSquared+import Statistics.Function        (square)+import Statistics.Sample.Internal (sum)+import Statistics.Test.Types+import Statistics.Types+import qualified Data.Vector as V+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Unboxed as U++++-- | Generic form of Pearson chi squared tests for binned data. Data+--   sample is supplied in form of tuples (observed quantity,+--   expected number of events). Both must be positive.+--+--   This test should be used only if all bins have expected values of+--   at least 5.+chi2test :: (G.Vector v (Int,Double), G.Vector v Double)+         => Int                 -- ^ Number of additional degrees of+                                --   freedom. One degree of freedom+                                --   is due to the fact that the are+                                --   N observation in total and+                                --   accounted for automatically.+         -> v (Int,Double)      -- ^ Observation and expectation.+         -> Maybe (Test ChiSquared)+chi2test ndf vec+  | ndf <  0  = error $ "Statistics.Test.ChiSquare.chi2test: negative NDF " ++ show ndf+  | n   > 0   = Just Test+              { testSignificance = mkPValue $ complCumulative d chi2+              , testStatistics   = chi2+              , testDistribution = chiSquared ndf+              }+  | otherwise = Nothing+  where+    n     = G.length vec - ndf - 1+    chi2  = sum $ G.map (\(o,e) -> square (fromIntegral o - e) / e) vec+    d     = chiSquared n+{-# INLINABLE  chi2test #-}+{-# SPECIALIZE+    chi2test :: Int -> U.Vector (Int,Double) -> Maybe (Test ChiSquared) #-}+{-# SPECIALIZE+    chi2test :: Int -> V.Vector (Int,Double) -> Maybe (Test ChiSquared) #-}+++-- | Chi squared test for data with normal errors. Data is supplied in+--   form of pair (observation with error, and expectation).+chi2testCont+  :: (G.Vector v (Estimate NormalErr Double, Double), G.Vector v 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 ndf+              }+  | otherwise = Nothing+  where+    n     = G.length vec - ndf - 1+    chi2  = sum $ G.map (\(Estimate o (NormalErr s),e) -> square (o - e) / s) vec+    d     = chiSquared n
+ Statistics/Test/Internal.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE FlexibleContexts #-}+module Statistics.Test.Internal (+    rank+  , rankUnsorted  +  , splitByTags  +  ) where++import Data.Ord+import           Data.Vector.Generic           ((!))+import qualified Data.Vector.Generic         as G+import qualified Data.Vector.Generic.Mutable as M+import Statistics.Function+++-- Private data type for unfolding+data Rank v a = Rank {+      rankCnt :: {-# UNPACK #-} !Int        -- Number of ranks to return+    , rankVal :: {-# UNPACK #-} !Double     -- Rank to return+    , rankNum :: {-# UNPACK #-} !Double     -- Current rank+    , rankVec :: v a                        -- Remaining vector+    }++-- | Calculate rank of every element of sample. In case of ties ranks+--   are averaged. Sample should be already sorted in ascending order.+--+--   Rank is index of element in the sample, numeration starts from 1.+--   In case of ties average of ranks of equal elements is assigned+--   to each+--+-- >>> rank (==) (fromList [10,20,30::Int])+-- > fromList [1.0,2.0,3.0]+--+-- >>> 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)+     => (a -> a -> Bool)        -- ^ Equivalence relation+     -> v a                     -- ^ Vector to rank+     -> v Double+rank eq vec = G.unfoldr go (Rank 0 (-1) 1 vec)+  where+    go (Rank 0 _ r v)+      | G.null v  = Nothing+      | otherwise =+          case G.length h of+            1 -> Just (r, Rank 0 0 (r+1) rest)+            n -> go Rank { rankCnt = n+                         , rankVal = 0.5 * (r*2 + fromIntegral (n-1))+                         , rankNum = r + fromIntegral n+                         , rankVec = rest+                         }+          where+            (h,rest) = G.span (eq $ G.head v) v+    go (Rank n val r v) = Just (val, Rank (n-1) val r v)+{-# INLINE rank #-}++-- | Compute rank of every element of vector. Unlike rank it doesn't+--   require sample to be sorted.+rankUnsorted :: ( Ord a+                , G.Vector v a+                , G.Vector v Int+                , G.Vector v Double+                , G.Vector v (Int, a)+                )+             => v a+             -> v Double+rankUnsorted xs = G.create $ do+    -- Put ranks into their original positions+    -- NOTE: backpermute will do wrong thing+    vec <- M.new n+    for 0 n $ \i ->+      M.unsafeWrite vec (index ! i) (ranks ! i)+    return vec+  where+    n = G.length xs+    -- Calculate ranks for sorted array+    ranks = rank (==) sorted+    -- Sort vector and retain original indices of elements+    (index, sorted)+      = G.unzip+      $ sortBy (comparing snd)+      $ indexed xs+{-# INLINE rankUnsorted #-}+++-- | Split tagged vector+splitByTags :: (G.Vector v a, G.Vector v (Bool,a)) => v (Bool,a) -> (v a, v a)+splitByTags vs = (G.map snd a, G.map snd b)+  where+    (a,b) = G.unstablePartition fst vs+{-# INLINE splitByTags #-}
+ Statistics/Test/KolmogorovSmirnov.hs view
@@ -0,0 +1,288 @@+{-# LANGUAGE FlexibleContexts #-}+-- |+-- Module    : Statistics.Test.KolmogorovSmirnov+-- Copyright : (c) 2011 Aleksey Khudyakov+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Kolmogov-Smirnov tests are non-parametric tests for assessing+-- whether given sample could be described by distribution or whether+-- two samples have the same distribution. It's only applicable to+-- continuous distributions.+module Statistics.Test.KolmogorovSmirnov (+    -- * Kolmogorov-Smirnov test+    kolmogorovSmirnovTest+  , kolmogorovSmirnovTestCdf+  , kolmogorovSmirnovTest2+    -- * Evaluate statistics+  , kolmogorovSmirnovCdfD+  , kolmogorovSmirnovD+  , kolmogorovSmirnov2D+    -- * Probablities+  , kolmogorovSmirnovProbability+    -- * References+    -- $references+  , module Statistics.Test.Types+  ) where++import Control.Monad (when)+import Prelude hiding (exponent, sum)+import Statistics.Distribution (Distribution(..))+import Statistics.Function (gsort, unsafeModify)+import Statistics.Matrix (center, for, fromVector)+import qualified Statistics.Matrix as Mat+import Statistics.Test.Types+import Statistics.Types (mkPValue)+import qualified Data.Vector          as V+import qualified Data.Vector.Storable as S+import qualified Data.Vector.Unboxed  as U+import qualified Data.Vector.Generic  as G+import           Data.Vector.Generic    ((!))+import qualified Data.Vector.Unboxed.Mutable as M+++----------------------------------------------------------------+-- Test+----------------------------------------------------------------++-- | Check that sample could be described by distribution. Returns+--   @Nothing@ is sample is empty+--+--   This test uses Marsaglia-Tsang-Wang exact algorithm for+--   calculation of p-value.+kolmogorovSmirnovTest :: (Distribution d, G.Vector v Double)+                      => d        -- ^ Distribution+                      -> v Double -- ^ Data sample+                      -> Maybe (Test ())+{-# INLINE kolmogorovSmirnovTest #-}+kolmogorovSmirnovTest d+  = kolmogorovSmirnovTestCdf (cumulative d)+++-- | Variant of 'kolmogorovSmirnovTest' which uses CDF in form of+--   function.+kolmogorovSmirnovTestCdf :: (G.Vector v Double)+                         => (Double -> Double) -- ^ CDF of distribution+                         -> v Double           -- ^ Data sample+                         -> Maybe (Test ())+{-# INLINE kolmogorovSmirnovTestCdf #-}+kolmogorovSmirnovTestCdf cdf sample+  | G.null sample = Nothing+  | otherwise     = Just Test+      { testSignificance = mkPValue $ 1 - prob+      , testStatistics   = d+      , testDistribution = ()+      }+  where+    d    = kolmogorovSmirnovCdfD cdf sample+    prob = kolmogorovSmirnovProbability (G.length sample) d+++-- | Two sample Kolmogorov-Smirnov test. It tests whether two data+--   samples could be described by the same distribution without+--   making any assumptions about it. If either of samples is empty+--   returns Nothing.+--+--   This test uses approximate formula for computing p-value.+kolmogorovSmirnovTest2 :: (G.Vector v Double)+                       => v Double -- ^ Sample 1+                       -> v Double -- ^ Sample 2+                       -> Maybe (Test ())+kolmogorovSmirnovTest2 xs1 xs2+  | G.null xs1 || G.null xs2 = Nothing+  | otherwise                = Just Test+      { testSignificance = mkPValue $ 1 - prob d+      , testStatistics   = d+      , testDistribution = ()+      }+  where+    d    = kolmogorovSmirnov2D xs1 xs2+         * (en + 0.12 + 0.11/en)+    -- Effective number of data points+    n1   = fromIntegral (G.length xs1)+    n2   = fromIntegral (G.length xs2)+    en   = sqrt $ n1 * n2 / (n1 + n2)+    --+    prob z+      | z <  0    = error "kolmogorovSmirnov2D: internal error"+      | z == 0    = 0+      | z <  1.18 = let y = exp( -1.23370055013616983 / (z*z) )+                    in  2.25675833419102515 * sqrt( -log y ) * (y + y**9 + y**25 + y**49)+      | otherwise = let x = exp(-2 * z * z)+                    in  1 - 2*(x - x**4 + x**9)+{-# INLINABLE  kolmogorovSmirnovTest2 #-}+{-# SPECIALIZE kolmogorovSmirnovTest2 :: U.Vector Double -> U.Vector Double -> Maybe (Test ()) #-}+{-# SPECIALIZE kolmogorovSmirnovTest2 :: V.Vector Double -> V.Vector Double -> Maybe (Test ()) #-}+{-# SPECIALIZE kolmogorovSmirnovTest2 :: S.Vector Double -> S.Vector Double -> Maybe (Test ()) #-}+-- FIXME: Find source for approximation for D++++----------------------------------------------------------------+-- Kolmogorov's statistic+----------------------------------------------------------------++-- | Calculate Kolmogorov's statistic /D/ for given cumulative+--   distribution function (CDF) and data sample. If sample is empty+--   returns 0.+kolmogorovSmirnovCdfD :: G.Vector v Double+                      => (Double -> Double) -- ^ CDF function+                      -> v Double           -- ^ Sample+                      -> Double+kolmogorovSmirnovCdfD cdf sample+  | G.null sample = 0+  | otherwise     = G.maximum+                  $ G.zipWith3 (\p a b -> abs (p-a) `max` abs (p-b))+                    ps steps (G.tail steps)+  where+    xs = gsort sample+    n  = G.length xs+    --+    ps    = G.map cdf xs+    steps = G.map (/ fromIntegral n)+          $ G.generate (n+1) fromIntegral+{-# INLINABLE  kolmogorovSmirnovCdfD #-}+{-# SPECIALIZE kolmogorovSmirnovCdfD :: (Double -> Double) -> U.Vector Double -> Double #-}+{-# SPECIALIZE kolmogorovSmirnovCdfD :: (Double -> Double) -> V.Vector Double -> Double #-}+{-# SPECIALIZE kolmogorovSmirnovCdfD :: (Double -> Double) -> S.Vector Double -> Double #-}+++-- | Calculate Kolmogorov's statistic /D/ for given cumulative+--   distribution function (CDF) and data sample. If sample is empty+--   returns 0.+kolmogorovSmirnovD :: (Distribution d, G.Vector v Double)+                   => d         -- ^ Distribution+                   -> v Double  -- ^ Sample+                   -> Double+kolmogorovSmirnovD d = kolmogorovSmirnovCdfD (cumulative d)+{-# INLINE kolmogorovSmirnovD #-}+++-- | Calculate Kolmogorov's statistic /D/ for two data samples. If+--   either of samples is empty returns 0.+kolmogorovSmirnov2D :: (G.Vector v Double)+                    => v Double   -- ^ First sample+                    -> v Double   -- ^ Second sample+                    -> Double+kolmogorovSmirnov2D sample1 sample2+  | G.null sample1 || G.null sample2 = 0+  | otherwise                        = worker 0 0 0+  where+    xs1 = gsort sample1+    xs2 = gsort sample2+    n1  = G.length xs1+    n2  = G.length xs2+    en1 = fromIntegral n1+    en2 = fromIntegral n2+    -- Find new index+    skip x i xs = go (i+1)+      where go n | n >= G.length xs = n+                 | xs ! n == x      = go (n+1)+                 | otherwise        = n+    -- Main loop+    worker d i1 i2+      | i1 >= n1 || i2 >= n2 = d+      | otherwise            = worker d' i1' i2'+      where+        d1  = xs1 ! i1+        d2  = xs2 ! i2+        i1' | d1 <= d2  = skip d1 i1 xs1+            | otherwise = i1+        i2' | d2 <= d1  = skip d2 i2 xs2+            | otherwise = i2+        d'  = max d (abs $ fromIntegral i1' / en1 - fromIntegral i2' / en2)+{-# INLINABLE  kolmogorovSmirnov2D #-}+{-# SPECIALIZE kolmogorovSmirnov2D :: U.Vector Double -> U.Vector Double -> Double #-}+{-# SPECIALIZE kolmogorovSmirnov2D :: V.Vector Double -> V.Vector Double -> Double #-}+{-# SPECIALIZE kolmogorovSmirnov2D :: S.Vector Double -> S.Vector Double -> Double #-}++++-- | Calculate cumulative probability function for Kolmogorov's+--   distribution with /n/ parameters or probability of getting value+--   smaller than /d/ with n-elements sample.+--+--   It uses algorithm by Marsgalia et. al. and provide at least+--   7-digit accuracy.+kolmogorovSmirnovProbability :: Int    -- ^ Size of the sample+                             -> Double -- ^ D value+                             -> Double+kolmogorovSmirnovProbability n d+  -- Avoid potentially lengthy calculations for large N and D > 0.999+  | s > 7.24 || (s > 3.76 && n > 99) = 1 - 2 * exp( -(2.000071 + 0.331 / sqrt n' + 1.409 / n') * s)+  -- Exact computation+  | otherwise = fini $ KSMatrix 0 matrix `power` n+  where+    s  = n' * d * d+    n' = fromIntegral n++    size = 2*k - 1+    k    = floor (n' * d) + 1+    h    = fromIntegral k - n' * d+    -- Calculate initial matrix+    matrix =+      let m = U.create $ do+            mat <- M.new (size*size)+            -- Fill matrix with 0 and 1s+            for 0 size $ \row ->+              for 0 size $ \col -> do+                let val | row + 1 >= col = 1+                        | otherwise      = 0 :: Double+                M.write mat (row * size + col) val+            -- Correct left column/bottom row+            for 0 size $ \i -> do+              let delta = h ^^ (i + 1)+              unsafeModify mat (i    * size)         (subtract delta)+              unsafeModify mat (size * size - 1 - i) (subtract delta)+            -- Correct corner element if needed+            when (2*h > 1) $ do+              unsafeModify mat ((size - 1) * size) (+ ((2*h - 1) ^ size))+            -- Divide diagonals by factorial+            let divide g num+                  | num == size = return ()+                  | otherwise   = do for num size $ \i ->+                                       unsafeModify mat (i * (size + 1) - num) (/ g)+                                     divide (g * fromIntegral (num+2)) (num+1)+            divide 2 1+            return mat+      in fromVector size size m+    -- Last calculation+    fini (KSMatrix e m) = loop 1 (center m) e+      where+        loop i ss eQ+          | i  > n       = ss * 10 ^^ eQ+          | ss' < 1e-140 = loop (i+1) (ss' * 1e140) (eQ - 140)+          | otherwise    = loop (i+1)  ss'           eQ+          where ss' = ss * fromIntegral i / fromIntegral n++data KSMatrix = KSMatrix Int Mat.Matrix+++multiply :: KSMatrix -> KSMatrix -> KSMatrix+multiply (KSMatrix e1 m1) (KSMatrix e2 m2) = KSMatrix (e1+e2) (Mat.multiply m1 m2)++power :: KSMatrix -> Int -> KSMatrix+power mat 1 = mat+power mat n = avoidOverflow res+  where+    mat2 = power mat (n `quot` 2)+    pow  = multiply mat2 mat2+    res | odd n     = multiply pow mat+        | otherwise = pow++avoidOverflow :: KSMatrix -> KSMatrix+avoidOverflow ksm@(KSMatrix e m)+  | center m > 1e140 = KSMatrix (e + 140) (Mat.map (* 1e-140) m)+  | otherwise        = ksm+++----------------------------------------------------------------++-- $references+--+-- * G. Marsaglia, W. W. Tsang, J. Wang (2003) Evaluating Kolmogorov's+--   distribution, Journal of Statistical Software, American+--   Statistical Association, vol. 8(i18).
+ Statistics/Test/KruskalWallis.hs view
@@ -0,0 +1,101 @@+-- |+-- Module    : Statistics.Test.KruskalWallis+-- Copyright : (c) 2014 Danny Navarro+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+module Statistics.Test.KruskalWallis+  ( -- * Kruskal-Wallis test+    kruskalWallisTest+    -- ** Building blocks+  , kruskalWallisRank+  , kruskalWallis+  , module Statistics.Test.Types+  ) where++import Data.Ord (comparing)+import Data.Foldable (foldMap)+import qualified Data.Vector.Unboxed as U+import Statistics.Function (sort, sortBy, square)+import Statistics.Distribution (complCumulative)+import Statistics.Distribution.ChiSquared (chiSquared)+import Statistics.Types+import Statistics.Test.Types+import Statistics.Test.Internal (rank)+import Statistics.Sample+import qualified Statistics.Sample.Internal as Sample(sum)+++-- | Kruskal-Wallis ranking.+--+-- All values are replaced by the absolute rank in the combined samples.+--+-- The samples and values need not to be ordered but the values in the result+-- are ordered. Assigned ranks (ties are given their average rank).+kruskalWallisRank :: (U.Unbox a, Ord a) => [U.Vector a] -> [U.Vector Double]+kruskalWallisRank samples = groupByTags+                          . sortBy (comparing fst)+                          . U.zip tags+                          $ rank (==) joinSample+  where+    (tags,joinSample) = U.unzip+                      . sortBy (comparing snd)+                      $ foldMap (uncurry tagSample) $ zip [(1::Int)..] samples+    tagSample t = U.map (\x -> (t,x))++    groupByTags xs+        | U.null xs = []+        | otherwise = sort (U.map snd ys) : groupByTags zs+      where+        (ys,zs) = U.span ((==) (fst $ U.head xs) . fst) xs+++-- | The Kruskal-Wallis Test.+--+-- In textbooks the output value is usually represented by 'K' or 'H'. This+-- function already does the ranking.+kruskalWallis :: (U.Unbox a, Ord a) => [U.Vector a] -> Double+kruskalWallis samples = (nTot - 1) * numerator / denominator+  where+    -- Total number of elements in all samples+    nTot    = fromIntegral $ sumWith rsamples U.length+    -- Average rank of all samples+    avgRank = (nTot + 1) / 2+    --+    numerator = sumWith rsamples $ \sample ->+        let n = fromIntegral $ U.length sample+        in  n * square (mean sample - avgRank)+    denominator = sumWith rsamples $ \sample ->+        Sample.sum $ U.map (\r -> square (r - avgRank)) sample++    rsamples = kruskalWallisRank samples+++-- | Perform Kruskal-Wallis Test for the given samples and required+-- significance. For additional information check 'kruskalWallis'. This is just+-- a helper function.+--+-- It uses /Chi-Squared/ distribution for approximation as long as the sizes are+-- larger than 5. Otherwise the test returns 'Nothing'.+kruskalWallisTest :: (Ord a, U.Unbox a) => [U.Vector a] -> Maybe (Test ())+kruskalWallisTest []      = Nothing+kruskalWallisTest samples+  -- We use chi-squared approximation here+  | all (>4) ns = Just Test { testSignificance = mkPValue $ complCumulative d k+                            , testStatistics   = k+                            , testDistribution = ()+                            }+  | otherwise   = Nothing+  where+    k  = kruskalWallis samples+    ns = map U.length samples+    d  = chiSquared (length ns - 1)++-- * Helper functions++sumWith :: Num a => [Sample] -> (Sample -> a) -> a+sumWith samples f = Prelude.sum $ fmap f samples+{-# INLINE sumWith #-}
+ Statistics/Test/MannWhitneyU.hs view
@@ -0,0 +1,238 @@+-- |+-- Module    : Statistics.Test.MannWhitneyU+-- Copyright : (c) 2010 Neil Brown+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Mann-Whitney U test (also know as Mann-Whitney-Wilcoxon and+-- Wilcoxon rank sum test) is a non-parametric test for assessing+-- whether two samples of independent observations have different+-- mean.+module Statistics.Test.MannWhitneyU (+    -- * Mann-Whitney U test+    mannWhitneyUtest+  , mannWhitneyU+  , mannWhitneyUCriticalValue+  , mannWhitneyUSignificant+    -- ** Wilcoxon rank sum test+  , wilcoxonRankSums+  , module Statistics.Test.Types+    -- * References+    -- $references+  ) where++import Control.Applicative ((<$>))+import Data.List (findIndex)+import Data.Ord (comparing)+import Numeric.SpecFunctions (choose)+import Prelude hiding (sum)+import Statistics.Distribution (quantile)+import Statistics.Distribution.Normal (standard)+import Statistics.Function (sortBy)+import Statistics.Sample.Internal (sum)+import Statistics.Test.Internal (rank, splitByTags)+import Statistics.Test.Types (TestResult(..), PositionTest(..), significant)+import Statistics.Types (PValue,pValue)+import qualified Data.Vector.Unboxed as U++-- | The Wilcoxon Rank Sums Test.+--+-- This test calculates the sum of ranks for the given two samples.+-- The samples are ordered, and assigned ranks (ties are given their+-- average rank), then these ranks are summed for each sample.+--+-- The return value is (W₁, W₂) where W₁ is the sum of ranks of the first sample+-- and W₂ is the sum of ranks of the second sample.  This test is trivially transformed+-- into the Mann-Whitney U test.  You will probably want to use 'mannWhitneyU'+-- and the related functions for testing significance, but this function is exposed+-- for completeness.+wilcoxonRankSums :: (Ord a, U.Unbox a) => U.Vector a -> U.Vector a -> (Double, Double)+wilcoxonRankSums xs1 xs2 = (sum ranks1, sum ranks2)+  where+    -- Ranks for each sample+    (ranks1,ranks2) = splitByTags $ U.zip tags (rank (==) joinSample)+    -- Sorted and tagged sample+    (tags,joinSample) = U.unzip+                      $ sortBy (comparing snd)+                      $ tagSample True xs1 U.++ tagSample False xs2+    -- Add tag to a sample+    tagSample t = U.map (\x -> (t,x))++++-- | The Mann-Whitney U Test.+--+-- This is sometimes known as the Mann-Whitney-Wilcoxon U test, and+-- confusingly many sources state that the Mann-Whitney U test is the same as+-- the Wilcoxon's rank sum test (which is provided as 'wilcoxonRankSums').+-- The Mann-Whitney U is a simple transform of Wilcoxon's rank sum test.+--+-- Again confusingly, different sources state reversed definitions for U₁+-- and U₂, so it is worth being explicit about what this function returns.+-- Given two samples, the first, xs₁, of size n₁ and the second, xs₂,+-- of size n₂, this function returns (U₁, U₂)+-- where U₁ = W₁ - (n₁(n₁+1))\/2+-- and U₂ = W₂ - (n₂(n₂+1))\/2,+-- where (W₁, W₂) is the return value of @wilcoxonRankSums xs1 xs2@.+--+-- Some sources instead state that U₁ and U₂ should be the other way round, often+-- expressing this using U₁' = n₁n₂ - U₁ (since U₁ + U₂ = n₁n₂).+--+-- All of which you probably don't care about if you just feed this into 'mannWhitneyUSignificant'.+mannWhitneyU :: (Ord a, U.Unbox a) => U.Vector a -> U.Vector a -> (Double, Double)+mannWhitneyU xs1 xs2+  = (fst summedRanks - (n1*(n1 + 1))/2+    ,snd summedRanks - (n2*(n2 + 1))/2)+  where+    n1 = fromIntegral $ U.length xs1+    n2 = fromIntegral $ U.length xs2++    summedRanks = wilcoxonRankSums xs1 xs2++-- | Calculates the critical value of Mann-Whitney U for the given sample+-- sizes and significance level.+--+-- This function returns the exact calculated value of U for all sample sizes;+-- it does not use the normal approximation at all.  Above sample size 20 it is+-- generally recommended to use the normal approximation instead, but this function+-- will calculate the higher critical values if you need them.+--+-- The algorithm to generate these values is a faster, memoised version of the+-- simple unoptimised generating function given in section 2 of \"The Mann Whitney+-- Wilcoxon Distribution Using Linked Lists\"+mannWhitneyUCriticalValue+  :: (Int, Int)     -- ^ The sample size+  -> PValue Double  -- ^ The p-value (e.g. 0.05) for which you want the critical value.+  -> Maybe Int      -- ^ The critical value (of U).+mannWhitneyUCriticalValue (m, n) p+  | m < 1 || n < 1 = Nothing    -- Sample must be nonempty+  | p' <= 1        = Nothing    -- p-value is too small. Null hypothesis couldn't be disproved+  | otherwise      = findIndex (>= p')+                   $ take (m*n)+                   $ tail+                   $ alookup !! (m+n-2) !! (min m n - 1)+  where+    mnCn = (m+n) `choose` n+    p'   = mnCn * pValue p+++{-+-- Original function, without memoisation, from Cheung and Klotz:+-- Double is needed to avoid integer overflows.+a :: Int -> Int -> Int -> Double+a u bigN m+  | u < 0            = 0+  | u >= m * n       = bigN `choose` m+  | m == 1 || n == 1 = fromIntegral (u + 1)+  | otherwise        = a  u      (bigN - 1)  m+                     + a (u - n) (bigN - 1) (m-1)+  where+    n = bigN - m+-}++-- Memoised version of the original a function, above.+--+-- Doubles are stored to avoid integer overflow. 32-bit Ints begin to+-- overflow for bigN as small as 33 (64-bit one at 66) while Double to+-- go to infinity till bigN=1029+--+--+-- outer list is indexed by big N - 2+-- inner list by (m-1) (we know m < bigN)+-- innermost list by u+--+-- So: (alookup !! (bigN - 2) !! (m - 1) ! u) == a u bigN m+alookup :: [[[Double]]]+alookup = gen 2 [1 : repeat 2]+  where+    gen bigN predBigNList+       = let bigNlist = [ [ amemoed u m+                          | u <- [0 .. m*(bigN-m)]+                          ] ++ repeat (bigN `choose` m)+                        | m <- [1 .. (bigN-1)]] -- has bigN-1 elements+         in bigNlist : gen (bigN+1) bigNlist+      where+        amemoed :: Int -> Int -> Double+        amemoed u m+          | m == 1 || n == 1 = fromIntegral (u + 1)+          | otherwise        = mList !! u+                             + if u < n then 0 else predmList !! (u-n)+          where+            n = bigN - m+            (predmList : mList : _) = drop (m-2) predBigNList+            -- Lists for m-1 and m respectively. i-th list correspond to m=i+1+            --+            -- We know that predBigNList has bigN - 2 elements+            -- (and we know that n > 1 therefore bigN > m + 1)+            -- So bigN - 2 >= m, i.e. predBigNList must have at least m elements+            -- elements, so dropping (m-2) must leave at least 2+++-- | Calculates whether the Mann Whitney U test is significant.+--+-- If both sample sizes are less than or equal to 20, the exact U critical value+-- (as calculated by 'mannWhitneyUCriticalValue') is used.  If either sample is+-- larger than 20, the normal approximation is used instead.+--+-- If you use a one-tailed test, the test indicates whether the first sample is+-- significantly larger than the second.  If you want the opposite, simply reverse+-- the order in both the sample size and the (U₁, U₂) pairs.+mannWhitneyUSignificant+  :: PositionTest     -- ^ Perform one-tailed test (see description above).+  -> (Int, Int)       -- ^ The samples' size from which the (U₁,U₂) values were derived.+  -> PValue Double    -- ^ The p-value at which to test (e.g. 0.05)+  -> (Double, Double) -- ^ The (U₁, U₂) values from 'mannWhitneyU'.+  -> Maybe TestResult -- ^ Return 'Nothing' if the sample was too+                      --   small to make a decision.+mannWhitneyUSignificant test (in1, in2) pVal (u1, u2)+  -- Use normal approximation+  | in1 > 20 || in2 > 20 =+    let mean  = n1 * n2 / 2     -- (u1+u2) / 2+        sigma = sqrt $ n1*n2*(n1 + n2 + 1) / 12+        z     = (mean - u1) / sigma+    in Just $ case test of+                AGreater      -> significant $ z     < quantile standard p+                BGreater      -> significant $ (-z)  < quantile standard p+                SamplesDiffer -> significant $ abs z > abs (quantile standard (p/2))+  -- Use exact critical value+  | otherwise = do crit <- fromIntegral <$> mannWhitneyUCriticalValue (in1, in2) pVal+                   return $ case test of+                              AGreater      -> significant $ u2        <= crit+                              BGreater      -> significant $ u1        <= crit+                              SamplesDiffer -> significant $ min u1 u2 <= crit+  where+    n1 = fromIntegral in1+    n2 = fromIntegral in2+    p  = pValue pVal+++-- | Perform Mann-Whitney U Test for two samples and required+-- significance. For additional information check documentation of+-- 'mannWhitneyU' and 'mannWhitneyUSignificant'. This is just a helper+-- function.+--+-- One-tailed test checks whether first sample is significantly larger+-- than second. Two-tailed whether they are significantly different.+mannWhitneyUtest+  :: (Ord a, U.Unbox a)+  => PositionTest     -- ^ Perform one-tailed test (see description above).+  -> PValue Double    -- ^ The p-value at which to test (e.g. 0.05)+  -> U.Vector a       -- ^ First sample+  -> U.Vector a       -- ^ Second sample+  -> Maybe TestResult -- ^ Return 'Nothing' if the sample was too small to+                      --   make a decision.+mannWhitneyUtest ontTail p smp1 smp2 =+  mannWhitneyUSignificant ontTail (n1,n2) p $ mannWhitneyU smp1 smp2+    where+      n1 = U.length smp1+      n2 = U.length smp2++-- $references+--+-- * Cheung, Y.K.; Klotz, J.H. (1997) The Mann Whitney Wilcoxon+--   distribution using linked lists. /Statistica Sinica/+--   7:805&#8211;813.+-- <http://www3.stat.sinica.edu.tw/statistica/oldpdf/A7n316.pdf>.
+ Statistics/Test/StudentT.hs view
@@ -0,0 +1,149 @@+{-# LANGUAGE FlexibleContexts, Rank2Types, ScopedTypeVariables #-}+-- | Student's T-test is for assessing whether two samples have+--   different mean. This module contain several variations of+--   T-test. It's a parametric tests and assumes that samples are+--   normally distributed.+module Statistics.Test.StudentT+    (+      studentTTest+    , welchTTest+    , pairedTTest+    , module Statistics.Test.Types+    ) where++import Statistics.Distribution hiding (mean)+import Statistics.Distribution.StudentT+import Statistics.Sample (mean, varianceUnbiased)+import Statistics.Test.Types+import Statistics.Types    (mkPValue,PValue)+import Statistics.Function (square)+import qualified Data.Vector.Generic  as G+import qualified Data.Vector.Unboxed  as U+import qualified Data.Vector.Storable as S+import qualified Data.Vector          as V++++-- | Two-sample Student's t-test. It assumes that both samples are+--   normally distributed and have same variance. Returns @Nothing@ if+--   sample sizes are not sufficient.+studentTTest :: (G.Vector v Double)+             => PositionTest  -- ^ one- or two-tailed test+             -> v Double      -- ^ Sample A+             -> v Double      -- ^ Sample B+             -> Maybe (Test StudentT)+studentTTest test sample1 sample2+  | G.length sample1 < 2 || G.length sample2 < 2 = Nothing+  | otherwise                                    = Just Test+      { testSignificance = significance test t ndf+      , testStatistics   = t+      , testDistribution = studentT ndf+      }+  where+    (t, ndf) = tStatistics True sample1 sample2+{-# INLINABLE  studentTTest #-}+{-# SPECIALIZE studentTTest :: PositionTest -> U.Vector Double -> U.Vector Double -> Maybe (Test StudentT) #-}+{-# SPECIALIZE studentTTest :: PositionTest -> S.Vector Double -> S.Vector Double -> Maybe (Test StudentT) #-}+{-# SPECIALIZE studentTTest :: PositionTest -> V.Vector Double -> V.Vector Double -> Maybe (Test StudentT) #-}++-- | Two-sample Welch's t-test. It assumes that both samples are+--   normally distributed but doesn't assume that they have same+--   variance. Returns @Nothing@ if sample sizes are not sufficient.+welchTTest :: (G.Vector v Double)+           => PositionTest  -- ^ one- or two-tailed test+           -> v Double      -- ^ Sample A+           -> v Double      -- ^ Sample B+           -> Maybe (Test StudentT)+welchTTest test sample1 sample2+  | G.length sample1 < 2 || G.length sample2 < 2 = Nothing+  | otherwise                                    = Just Test+      { testSignificance = significance test t ndf+      , testStatistics   = t+      , testDistribution = studentT ndf+      }+  where+    (t, ndf) = tStatistics False sample1 sample2+{-# INLINABLE  welchTTest #-}+{-# SPECIALIZE welchTTest :: PositionTest -> U.Vector Double -> U.Vector Double -> Maybe (Test StudentT) #-}+{-# SPECIALIZE welchTTest :: PositionTest -> S.Vector Double -> S.Vector Double -> Maybe (Test StudentT) #-}+{-# SPECIALIZE welchTTest :: PositionTest -> V.Vector Double -> V.Vector Double -> Maybe (Test StudentT) #-}++-- | Paired two-sample t-test. Two samples are paired in a+-- within-subject design. Returns @Nothing@ if sample size is not+-- sufficient.+pairedTTest :: forall v. (G.Vector v (Double, Double), G.Vector v 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), G.Vector v Double)+                  => v (Double, Double)+                  -> (Double, Double)+{-# INLINE tStatisticsPaired #-}+tStatisticsPaired sample = (t, ndf)+  where+    -- t-statistics+    t = let d    = G.map (uncurry (-)) sample+            sumd = G.sum d+        in sumd / sqrt ((n * G.sum (G.map square d) - square sumd) / ndf)+    -- degree of freedom+    ndf = n - 1+    n   = fromIntegral $ G.length sample
+ Statistics/Test/Types.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE DeriveFunctor, DeriveDataTypeable,DeriveGeneric  #-}+module Statistics.Test.Types (+    Test(..)+  , isSignificant+  , TestResult(..)+  , significant+  , PositionTest(..)+  ) where++import Control.DeepSeq  (NFData(..))+import Data.Data (Typeable, Data)+import GHC.Generics++import Statistics.Types (PValue)+++-- | Result of hypothesis testing+data TestResult = Significant    -- ^ Null hypothesis should be rejected+                | NotSignificant -- ^ Data is compatible with hypothesis+                  deriving (Eq,Ord,Show,Typeable,Data,Generic)++instance NFData   TestResult++++-- | Result of statistical test.+data Test distr = Test+  { testSignificance :: !(PValue Double)+    -- ^ Probability of getting value of test statistics at least as+    --   extreme as measured.+  , testStatistics   :: !Double+    -- ^ Statistic used for test.+  , testDistribution :: distr+    -- ^ Distribution of test statistics if null hypothesis is correct.+  }+  deriving (Eq,Ord,Show,Typeable,Data,Generic,Functor)++instance (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 NFData   PositionTest++-- | significant if parameter is 'True', not significant otherwise+significant :: Bool -> TestResult+significant True  = Significant+significant False = NotSignificant
+ Statistics/Test/WilcoxonT.hs view
@@ -0,0 +1,246 @@+{-# LANGUAGE ViewPatterns #-}+-- |+-- Module    : Statistics.Test.WilcoxonT+-- Copyright : (c) 2010 Neil Brown+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- The Wilcoxon matched-pairs signed-rank test is non-parametric test+-- which could be used to test whether two related samples have+-- different means.+module Statistics.Test.WilcoxonT (+    -- * Wilcoxon signed-rank matched-pair test+    -- ** Test+    wilcoxonMatchedPairTest+    -- ** Building blocks+  , wilcoxonMatchedPairSignedRank+  , wilcoxonMatchedPairSignificant+  , wilcoxonMatchedPairSignificance+  , wilcoxonMatchedPairCriticalValue+  , module Statistics.Test.Types+    -- * References+    -- $references+  ) where++++--+--+--+-- Note that: wilcoxonMatchedPairSignedRank == (\(x, y) -> (y, x)) . flip wilcoxonMatchedPairSignedRank+-- The samples are zipped together: if one is longer than the other, both are truncated+-- The value returned is the pair (T+, T-).  T+ is the sum of positive ranks (the+-- These values mean little by themselves, and should be combined with the 'wilcoxonSignificant'+-- function in this module to get a meaningful result.+-- ranks of the differences where the first parameter is higher) whereas T- is+-- the sum of negative ranks (the ranks of the differences where the second parameter is higher).+-- to the length of the shorter sample.++import 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+import Statistics.Types -- (CL,pValue,getPValue)+import Statistics.Distribution+import Statistics.Distribution.Normal+++-- | Calculate (n,T⁺,T⁻) values for both samples. Where /n/ is reduced+--   sample where equal pairs are removed.+wilcoxonMatchedPairSignedRank :: (Ord a, Num a, U.Unbox a) => U.Vector (a,a) -> (Int, Double, Double)+wilcoxonMatchedPairSignedRank ab+  = (nRed, sum ranks1, negate (sum ranks2))+  where+    -- Positive and negative ranks+    (ranks1, ranks2) = splitByTags+                     $ U.zip tags (rank ((==) `on` abs) diffs)+    -- Sorted list of differences+    diffsSorted = sortBy (comparing abs)    -- Sort the differences by absolute difference+                $ U.filter  (/= 0)          -- Remove equal elements+                $ U.map (uncurry (-)) ab    -- Work out differences+    nRed = U.length diffsSorted+    -- Sign tags and differences+    (tags,diffs) = U.unzip+                 $ U.map (\x -> (x>0 , x))   -- Attach tags to distribution elements+                 $ diffsSorted++++-- | The coefficients for x^0, x^1, x^2, etc, in the expression+-- \prod_{r=1}^s (1 + x^r).  See the Mitic paper for details.+--+-- We can define:+-- f(1) = 1 + x+-- f(r) = (1 + x^r)*f(r-1)+--      = f(r-1) + x^r * f(r-1)+-- The effect of multiplying the equation by x^r is to shift+-- all the coefficients by r down the list.+--+-- This list will be processed lazily from the head.+coefficients :: Int -> [Integer]+coefficients 1 = [1, 1] -- 1 + x+coefficients r = let coeffs = coefficients (r-1)+                     (firstR, rest) = splitAt r coeffs+  in firstR ++ add rest coeffs+  where+    add (x:xs) (y:ys) = x + y : add xs ys+    add xs [] = xs+    add [] ys = ys++-- This list will be processed lazily from the head.+summedCoefficients :: Int -> [Double]+summedCoefficients n+  | n < 1     = error "Statistics.Test.WilcoxonT.summedCoefficients: nonpositive sample size"+  | n > 1023  = error "Statistics.Test.WilcoxonT.summedCoefficients: sample is too large (see bug #18)"+  | otherwise = map fromIntegral $ scanl1 (+) $ coefficients n++++-- | Tests whether a given result from a Wilcoxon signed-rank matched-pairs test+-- is significant at the given level.+--+-- This function can perform a one-tailed or two-tailed test.  If the first+-- parameter to this function is 'TwoTailed', the test is performed two-tailed to+-- check if the two samples differ significantly.  If the first parameter is+-- 'OneTailed', the check is performed one-tailed to decide whether the first sample+-- (i.e. the first sample you passed to 'wilcoxonMatchedPairSignedRank') is+-- greater than the second sample (i.e. the second sample you passed to+-- 'wilcoxonMatchedPairSignedRank').  If you wish to perform a one-tailed test+-- in the opposite direction, you can either pass the parameters in a different+-- order to 'wilcoxonMatchedPairSignedRank', or simply swap the values in the resulting+-- pair before passing them to this function.+wilcoxonMatchedPairSignificant+  :: PositionTest          -- ^ How to compare two samples+  -> PValue Double         -- ^ The p-value at which to test (e.g. @mkPValue 0.05@)+  -> (Int, Double, Double) -- ^ The (n,T⁺, T⁻) values from 'wilcoxonMatchedPairSignedRank'.+  -> Maybe TestResult      -- ^ Return 'Nothing' if the sample was too+                           --   small to make a decision.+wilcoxonMatchedPairSignificant test pVal (sampleSize, tPlus, tMinus) =+  case test of+    -- According to my nearest book (Understanding Research Methods and Statistics+    -- by Gary W. Heiman, p590), to check that the first sample is bigger you must+    -- use the absolute value of T- for a one-tailed check:+    AGreater      -> do crit <- wilcoxonMatchedPairCriticalValue sampleSize pVal+                        return $ significant $ abs tMinus <= fromIntegral crit+    BGreater      -> do crit <- wilcoxonMatchedPairCriticalValue sampleSize pVal+                        return $ significant $ abs tPlus <= fromIntegral crit+    -- Otherwise you must use the value of T+ and T- with the smallest absolute value:+    --+    -- Note that in absence of ties sum of |T+| and |T-| is constant+    -- so by selecting minimal we are performing two-tailed test and+    -- look and both tails of distribution of T.+    SamplesDiffer -> do crit <- wilcoxonMatchedPairCriticalValue sampleSize (mkPValue $ p/2)+                        return $ significant $ t <= fromIntegral crit+  where+    t = min (abs tPlus) (abs tMinus)+    p = pValue pVal+++-- | Obtains the critical value of T to compare against, given a sample size+-- and a p-value (significance level).  Your T value must be less than or+-- equal to the return of this function in order for the test to work out+-- significant.  If there is a Nothing return, the sample size is too small to+-- make a decision.+--+-- 'wilcoxonSignificant' tests the return value of 'wilcoxonMatchedPairSignedRank'+-- for you, so you should use 'wilcoxonSignificant' for determining test results.+--  However, this function is useful, for example, for generating lookup tables+-- for Wilcoxon signed rank critical values.+--+-- The return values of this function are generated using the method+-- detailed in the Mitic's paper. According to that paper, the results+-- may differ from other published lookup tables, but (Mitic claims)+-- the values obtained by this function will be the correct ones.+wilcoxonMatchedPairCriticalValue ::+     Int                -- ^ The sample size+  -> PValue Double      -- ^ The p-value (e.g. @mkPValue 0.05@) for which you want the critical value.+  -> Maybe Int          -- ^ The critical value (of T), or Nothing if+                        --   the sample is too small to make a decision.+wilcoxonMatchedPairCriticalValue n pVal+  | n < 100   =+      case subtract 1 <$> findIndex (> m) (summedCoefficients n) of+        Just k | k < 0     -> Nothing+               | otherwise -> Just k+        Nothing  -> error "Statistics.Test.WilcoxonT.wilcoxonMatchedPairCriticalValue: impossible happened"+  | otherwise =+     case quantile (normalApprox n) p of+       z | z < 0     -> Nothing+         | otherwise -> Just (round z)+  where+    p = pValue pVal+    m = (2 ** fromIntegral n) * p+++-- | Works out the significance level (p-value) of a T value, given a sample+-- size and a T value from the Wilcoxon signed-rank matched-pairs test.+--+-- See the notes on 'wilcoxonCriticalValue' for how this is calculated.+wilcoxonMatchedPairSignificance+  :: Int           -- ^ The sample size+  -> Double        -- ^ The value of T for which you want the significance.+  -> PValue Double -- ^ The significance (p-value).+wilcoxonMatchedPairSignificance n t+  = mkPValue p+  where+    p | n < 100   = (summedCoefficients n !! floor t) / 2 ** fromIntegral n+      | otherwise = cumulative (normalApprox n) t+++-- | Normal approximation for Wilcoxon T statistics+normalApprox :: Int -> NormalDistribution+normalApprox ni+  = normalDistr m s+  where+    m = n * (n + 1) / 4+    s = sqrt $ (n * (n + 1) * (2*n + 1)) / 24+    n = fromIntegral ni+++-- | The Wilcoxon matched-pairs signed-rank test. The samples are+-- zipped together: if one is longer than the other, both are+-- truncated to the length of the shorter sample.+--+-- For one-tailed test it tests whether first sample is significantly+-- greater than the second. For two-tailed it checks whether they+-- significantly differ+--+-- Check 'wilcoxonMatchedPairSignedRank' and+-- 'wilcoxonMatchedPairSignificant' for additional information.+wilcoxonMatchedPairTest+  :: (Ord a, Num a, U.Unbox a)+  => PositionTest     -- ^ Perform one-tailed test.+  -> U.Vector (a,a)   -- ^ Sample of pairs+  -> Test ()          -- ^ Return 'Nothing' if the sample was too+                      --   small to make a decision.+wilcoxonMatchedPairTest test pairs =+  Test { testSignificance = pVal+       , testStatistics   = t+       , testDistribution = ()+       }+  where+    (n,tPlus,tMinus) = wilcoxonMatchedPairSignedRank pairs+    (t,pVal) = case test of+                 AGreater      -> (abs tMinus, wilcoxonMatchedPairSignificance n (abs tMinus))+                 BGreater      -> (abs tPlus,  wilcoxonMatchedPairSignificance n (abs tPlus ))+                 -- Since we take minimum of T+,T- we can't get more+                 -- that p=0.5 and can multiply it by 2 without risk+                 -- of error.+                 SamplesDiffer -> let t' = min (abs tMinus) (abs tPlus)+                                      p  = wilcoxonMatchedPairSignificance n t'+                                  in (t', mkPValue $ min 1 $ 2 * pValue p)+++-- $references+--+-- * \"Critical Values for the Wilcoxon Signed Rank Statistic\", Peter+--   Mitic, The Mathematica Journal, volume 6, issue 3, 1996+--   (<http://www.mathematica-journal.com/issue/v6i3/article/mitic/contents/63mitic.pdf>)
+ Statistics/Transform.hs view
@@ -0,0 +1,176 @@+{-# LANGUAGE BangPatterns, FlexibleContexts #-}+-- |+-- Module    : Statistics.Transform+-- Copyright : (c) 2011 Bryan O'Sullivan+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Fourier-related transformations of mathematical functions.+--+-- These functions are written for simplicity and correctness, not+-- speed.  If you need a fast FFT implementation for your application,+-- you should strongly consider using a library of FFTW bindings+-- instead.++module Statistics.Transform+    (+    -- * Type synonyms+      CD+    -- * Discrete cosine transform+    , dct+    , dct_+    , idct+    , idct_+    -- * Fast Fourier transform+    , fft+    , ifft+    ) where++import Control.Monad (when)+import Control.Monad.ST (ST)+import Data.Bits (shiftL, shiftR)+import Data.Complex (Complex(..), conjugate, realPart)+import Numeric.SpecFunctions (log2)+import qualified Data.Vector.Generic         as G+import qualified Data.Vector.Generic.Mutable as M+import qualified Data.Vector.Unboxed         as U+import qualified Data.Vector                 as V++type CD = Complex Double++-- | Discrete cosine transform (DCT-II).+dct :: (G.Vector v CD, G.Vector v Double, G.Vector v Int) => v Double -> v Double+dct = dctWorker . G.map (:+0)+{-# INLINABLE  dct #-}+{-# SPECIAlIZE dct :: U.Vector Double -> U.Vector Double #-}+{-# SPECIAlIZE dct :: V.Vector Double -> V.Vector Double #-}++-- | Discrete cosine transform (DCT-II). Only real part of vector is+--   transformed, imaginary part is ignored.+dct_ :: (G.Vector v CD, G.Vector v Double, G.Vector v Int) => v CD -> v Double+dct_ = dctWorker . G.map (\(i :+ _) -> i :+ 0)+{-# INLINABLE  dct_ #-}+{-# SPECIAlIZE dct_ :: U.Vector CD -> U.Vector Double #-}+{-# SPECIAlIZE dct_ :: V.Vector CD -> V.Vector Double#-}++dctWorker :: (G.Vector v CD, G.Vector v Double, G.Vector v Int) => v CD -> v Double+{-# INLINE dctWorker #-}+dctWorker xs+  -- length 1 is special cased because shuffle algorithms fail for it.+  | G.length xs == 1 = G.map ((2*) . realPart) xs+  | vectorOK xs      = G.map realPart $ G.zipWith (*) weights (fft interleaved)+  | otherwise        = error "Statistics.Transform.dct: bad vector length"+  where+    interleaved = G.backpermute xs $ G.enumFromThenTo 0 2 (len-2) G.+++                                     G.enumFromThenTo (len-1) (len-3) 1+    weights = G.cons 2 . G.generate (len-1) $ \x ->+              2 * exp ((0:+(-1))*fi (x+1)*pi/(2*n))+      where n = fi len+    len = G.length xs++++-- | Inverse discrete cosine transform (DCT-III). It's inverse of+-- 'dct' only up to scale parameter:+--+-- > (idct . dct) x = (* length x)+idct :: (G.Vector v CD, G.Vector v Double) => v Double -> v Double+idct = idctWorker . G.map (:+0)+{-# INLINABLE  idct #-}+{-# SPECIAlIZE idct :: U.Vector Double -> U.Vector Double #-}+{-# SPECIAlIZE idct :: V.Vector Double -> V.Vector Double #-}++-- | Inverse discrete cosine transform (DCT-III). Only real part of vector is+--   transformed, imaginary part is ignored.+idct_ :: (G.Vector v CD, G.Vector v Double) => v CD -> v Double+idct_ = idctWorker . G.map (\(i :+ _) -> i :+ 0)+{-# INLINABLE  idct_ #-}+{-# SPECIAlIZE idct_ :: U.Vector CD -> U.Vector Double #-}+{-# SPECIAlIZE idct_ :: V.Vector CD -> V.Vector Double #-}++idctWorker :: (G.Vector v CD, G.Vector v Double) => v CD -> v Double+{-# INLINE idctWorker #-}+idctWorker xs+  | vectorOK xs = G.generate len interleave+  | otherwise   = error "Statistics.Transform.dct: bad vector length"+  where+    interleave z | even z    = vals `G.unsafeIndex` halve z+                 | otherwise = vals `G.unsafeIndex` (len - halve z - 1)+    vals = G.map realPart . ifft $ G.zipWith (*) weights xs+    weights+      = G.cons n+      $ G.generate (len - 1) $ \x -> 2 * n * exp ((0:+1) * fi (x+1) * pi/(2*n))+      where n = fi len+    len = G.length xs++++-- | Inverse fast Fourier transform.+ifft :: G.Vector v CD => v CD -> v CD+ifft xs+  | vectorOK xs = G.map ((/fi (G.length xs)) . conjugate) . fft . G.map conjugate $ xs+  | otherwise   = error "Statistics.Transform.ifft: bad vector length"+{-# INLINABLE  ifft #-}+{-# SPECIAlIZE ifft :: U.Vector CD -> U.Vector CD #-}+{-# SPECIAlIZE ifft :: V.Vector CD -> V.Vector CD #-}++-- | Radix-2 decimation-in-time fast Fourier transform.+fft :: G.Vector v CD => v CD -> v CD+fft v | vectorOK v  = G.create $ do mv <- G.thaw v+                                    mfft mv+                                    return mv+      | otherwise   = error "Statistics.Transform.fft: bad vector length"+{-# INLINABLE  fft #-}+{-# SPECIAlIZE fft :: U.Vector CD -> U.Vector CD #-}+{-# SPECIAlIZE fft :: V.Vector CD -> V.Vector CD #-}++-- Vector length must be power of two. It's not checked+mfft :: (M.MVector v CD) => v s CD -> ST s ()+{-# INLINE mfft #-}+mfft vec = bitReverse 0 0+ where+  bitReverse i j | i == len-1 = stage 0 1+                 | otherwise  = do+    when (i < j) $ M.swap vec i j+    let inner k l | k <= l    = inner (k `shiftR` 1) (l-k)+                  | otherwise = bitReverse (i+1) (l+k)+    inner (len `shiftR` 1) j+  stage l !l1 | l == m    = return ()+              | otherwise = do+    let !l2 = l1 `shiftL` 1+        !e  = -6.283185307179586/fromIntegral l2+        flight j !a | j == l1   = stage (l+1) l2+                    | otherwise = do+          let butterfly i | i >= len  = flight (j+1) (a+e)+                          | otherwise = do+                let i1 = i + l1+                xi1 :+ yi1 <- M.read vec i1+                let !c = cos a+                    !s = sin a+                    d  = (c*xi1 - s*yi1) :+ (s*xi1 + c*yi1)+                ci <- M.read vec i+                M.write vec i1 (ci - d)+                M.write vec i (ci + d)+                butterfly (i+l2)+          butterfly j+    flight 0 0+  len = M.length vec+  m   = log2 len+++----------------------------------------------------------------+-- Helpers+----------------------------------------------------------------++fi :: Int -> CD+fi = fromIntegral++halve :: Int -> Int+halve = (`shiftR` 1)++vectorOK :: G.Vector v a => v a -> Bool+{-# INLINE vectorOK #-}+vectorOK v = (1 `shiftL` log2 n) == n where n = G.length v
+ Statistics/Types.hs view
@@ -0,0 +1,480 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}+-- |+-- Module    : Statistics.Types+-- Copyright : (c) 2009 Bryan O'Sullivan+-- License   : BSD3+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- Data types common used in statistics+module Statistics.Types+    ( -- * 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 Control.DeepSeq              (NFData(..))+import Data.Data                    (Data,Typeable)+import Data.Maybe                   (fromMaybe)+import Data.Vector.Unboxed          (Unbox)+import Data.Vector.Unboxed.Deriving (derivingUnbox)+import GHC.Generics                 (Generic)++#if __GLASGOW_HASKELL__ == 704+import qualified Data.Vector.Generic+import qualified Data.Vector.Generic.Mutable+#endif++import Statistics.Internal+import Statistics.Types.Internal+import Statistics.Distribution+import Statistics.Distribution.Normal+++----------------------------------------------------------------+-- Data type for confidence level+----------------------------------------------------------------++-- |+-- Confidence level. In context of confidence intervals it's+-- probability of said interval covering true value of measured+-- value. In context of statistical tests it's @1-α@ where α is+-- significance of test.+--+-- Since confidence level are usually close to 1 they are stored as+-- @1-CL@ internally. There are two smart constructors for @CL@:+-- 'mkCL' and 'mkCLFromSignificance' (and corresponding variant+-- returning @Maybe@). First creates @CL@ from confidence level and+-- second from @1 - CL@ or significance level.+--+-- >>> cl95+-- mkCLFromSignificance 0.05+--+-- Prior to 0.14 confidence levels were passed to function as plain+-- @Doubles@. Use 'mkCL' to convert them to @CL@.+newtype CL a = CL a+               deriving (Eq, Typeable, Data, Generic)++instance Show a => Show (CL a) where+  showsPrec n (CL p) = defaultShow1 "mkCLFromSignificance" p n+instance (Num a, Ord a, Read a) => Read (CL a) where+  readPrec = defaultReadPrecM1 "mkCLFromSignificance" mkCLFromSignificanceE++instance 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 0.05+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 0.05)+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 0.05+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 0.05)+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 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+#if __GLASGOW_HASKELL__ >= 708+               , Typeable, Data+#endif+               )++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 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 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)+++-- | 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 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+
+ benchmark/bench.hs view
@@ -0,0 +1,71 @@+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
@@ -0,0 +1,339 @@+## 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 districution.++ * Avoid loss of precision when computing CDF for geometric districution. 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 with estimates, confidence intervals, confidence levels and+p-value. Also API for statistical tests is changed.++ * Module `Statistis.Types` now contains new data types for estimates,+   upper/lower bounds, confidence level, and p-value.++	- `CL` for representing confidence level+	- `PValue` for representing p-values+	- `Estimate` data type moved here from `Statistis.Resampling.Bootstrap` and+      now parametrized by type of error.+	- `NormalError` — represents normal error.+    - `ConfInt` — generic confidence interval+    - `UpperLimit`,`LowerLimit` for upper/lower limits.++ * New API for statistical tests. Instead of simply return significant/not+   significant it returns p-value, test statistics and distribution of test+   statistics if it's available. Tests also return `Nothing` instead of throwing+   error if sample size is not sufficient. Fixes #25.++ * `Statistics.Tests.Types.TestType` data type dropped++ * New smart constructors for distributions are added. They return `Nothing` if+   parameters are outside of allowed range.++ * Serialization instances (`Show/Read, Binary, ToJSON/FromJSON`) for+   distributions no longer allows to create data types with invalid+   parameters. They will fail to parse. Cached values are not serialized either+   so `Binary` instances changed normal and F-distributions.++   Encoding to JSON changed for Normal, F-distribution, and χ²+   distributions. However data created using older statistics will be+   successfully decoded.++   Fixes #59.++ * Statistics.Resample.Bootstrap uses new data types for central estimates.++ * Function for calculation of confidence intervals for Poisson and binomial+   distribution added in `Statistics.ConfidenceInt`++ * Tests of position now allow to ask whether first sample on average larger+   than second, second larger than first or whether they differ significantly.+   Affects Wilcoxon-T, Mann-Whitney-U, and Student-T tests.++ * API for bootstrap changed. New data types added.++ * Bug fixes for #74, #81, #83, #92, #94++ * `complCumulative` added for many distributions.++++## Changes in 0.13.3.0++ * Kernel density estimation and FFT use generic versions now.++ * Code for calculation of Spearman and Pearson correlation added. Modules+   `Statistics.Correlation.Spearman` and `Statistics.Correlation.Pearson`.++ * Function for calculation covariance added in `Statistics.Sample`.++ * `Statistics.Function.pair` added. It zips vector and check that lengths are+   equal.++ * New functions added to `Statistics.Matrix`++ * Laplace distribution added.+++## Changes in 0.13.2.3++ * Vector dependency restored to >=0.10+++## Changes in 0.13.2.2++ * Vector dependency lowered to >=0.9+++## Changes in 0.13.2.1++ * Vector dependency bumped to >=0.10+++## Changes in 0.13.2.0++ * Support for regression bootstrap added+++## Changes in 0.13.1.1++ * Fix for out of bound access in bootstrap (see `bos/criterion#52`)+++## Changes in 0.13.1.0++  * All types now support JSON encoding and decoding.+++## Changes in 0.12.0.0++  * The `Statistics.Math` module has been removed, after being+    deprecated for several years.  Use the+    [math-functions](http://hackage.haskell.org/package/math-functions)+    package instead.++  * The `Statistics.Test.NonParametric` module has been removed, after+    being deprecated for several years.++  * Added support for Kendall's tau.++  * Added support for OLS regression.++  * Added basic 2D matrix support.++  * Added the Kruskal-Wallis test.++## Changes in 0.11.0.3++  * Fixed a subtle bug in calculation of the jackknifed unbiased variance.++  * The test suite now requires QuickCheck 2.7.++  * We now calculate quantiles for normal distribution in a more+    numerically stable way (bug #64).++## Changes in 0.10.6.0++  * The Estimator type has become an algebraic data type.  This allows+    the jackknife function to potentially use more efficient jackknife+    implementations.++  * jackknifeMean, jackknifeStdDev, jackknifeVariance,+    jackknifeVarianceUnb: new functions.  These have O(n) cost instead+    of the O(n^2) cost of the standard jackknife.++  * The mean function has been renamed to welfordMean; a new+    implementation of mean has better numerical accuracy in almost all+    cases.++## Changes in 0.10.5.2++  * histogram correctly chooses range when all elements in the sample are same+    (bug #57)+++## Changes in 0.10.5.1++  * Bug fix for S.Distributions.Normal.standard introduced in 0.10.5.0 (Bug #56)+++## Changes in 0.10.5.0++  * Enthropy type class for distributions is added.++  * Probability and probability density of distribution is given in+    log domain too.++## Changes in 0.10.4.0++  * Support for versions of GHC older than 7.2 is discontinued.++  * All datatypes now support 'Data.Binary' and 'GHC.Generics'.++## Changes in 0.10.3.0++  * Bug fixes++## Changes in 0.10.2.0++  * Bugs in DCT and IDCT are fixed.++  * Accesors for uniform distribution are added.++  * ContGen instances for all continuous distribtuions are added.++  * Beta distribution is added.++  * Constructor for improper gamma distribtuion is added.++  * Binomial distribution allows zero trials.++  * Poisson distribution now accept zero parameter.++  * Integer overflow in caculation of Wilcoxon-T test is fixed.++  * Bug in 'ContGen' instance for normal distribution is fixed.++## Changes in 0.10.1.0++  * Kolmogorov-Smirnov nonparametric test added.++  * Pearson chi squared test added.++  * Type class for generating random variates for given distribution+    is added.++  * Modules 'Statistics.Math' and 'Statistics.Constants' are moved to+    the `math-functions` package. They are still available but marked+    as deprecated.+++## Changes in 0.10.0.1++  * `dct` and `idct` now have type `Vector Double -> Vector Double`+++## Changes in 0.10.0.0++  * The type classes Mean and Variance are split in two. This is+    required for distributions which do not have finite variance or+    mean.++  * The S.Sample.KernelDensity module has been renamed, and+    completely rewritten to be much more robust.  The older module+    oversmoothed multi-modal data.  (The older module is still+    available under the name S.Sample.KernelDensity.Simple).++  * Histogram computation is added, in S.Sample.Histogram.++  * Discrete Fourie transform is added, in S.Transform++  * Root finding is added, in S.Math.RootFinding.++  * The complCumulative function is added to the Distribution+    class in order to accurately assess probalities P(X>x) which are+    used in one-tailed tests.++  * A stdDev function is added to the Variance class for+    distributions.++  * The constructor S.Distribution.normalDistr now takes standard+    deviation instead of variance as its parameter.++  * A bug in S.Quantile.weightedAvg is fixed. It produced a wrong+    answer if a sample contained only one element.++  * Bugs in quantile estimations for chi-square and gamma distribution+    are fixed.++  * Integer overlow in mannWhitneyUCriticalValue is fixed. It+    produced incorrect critical values for moderately large+    samples. Something around 20 for 32-bit machines and 40 for 64-bit+    ones.++  * A bug in mannWhitneyUSignificant is fixed. If either sample was+    larger than 20, it produced a completely incorrect answer.++  * One- and two-tailed tests in S.Tests.NonParametric are selected+    with sum types instead of Bool.++  * Test results returned as enumeration instead of `Bool`.++  * Performance improvements for Mann-Whitney U and Wilcoxon tests.++  * Module `S.Tests.NonParamtric` is split into `S.Tests.MannWhitneyU`+    and `S.Tests.WilcoxonT`++  * sortBy is added to S.Function.++  * Mean and variance for gamma distribution are fixed.++  * Much faster cumulative probablity functions for Poisson and+    hypergeometric distributions.++  * Better density functions for gamma and Poisson distributions.++  * Student-T, Fisher-Snedecor F-distributions and Cauchy-Lorentz+    distrbution are added.++  * The function S.Function.create is removed. Use generateM from+    the vector package instead.++  * Function to perform approximate comparion of doubles is added to+    S.Function.Comparison++  * Regularized incomplete beta function and its inverse are added to+    S.Function
+ examples/kde/KDE.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE OverloadedStrings #-}++import Control.Applicative ((<$>))+import Statistics.Sample.KernelDensity (kde)+import Text.Hastache (MuType(..), defaultConfig, hastacheFile)+import Text.Hastache.Context (mkStrContext)+import qualified Data.Attoparsec.ByteString as B+import qualified Data.Attoparsec.ByteString.Char8 as A+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L+import qualified Data.Vector.Unboxed as U+import qualified Data.Text.Lazy.IO as TL++csv = do+  B.takeTill A.isEndOfLine+  (A.double `A.sepBy` A.char ',') `A.sepBy` A.endOfLine++main = do+  waits <- (either error (U.fromList . map last . filter (not.null)) .+            A.parseOnly csv) <$> B.readFile "data/faithful.csv"+  let xs = map (\(a,b) -> [a,b]) . U.toList . uncurry U.zip . kde 64 $ waits+      context "data" = MuVariable . show $ xs+  s <- hastacheFile defaultConfig "kde.tpl" (mkStrContext context)+  TL.writeFile "kde.html" s
+ examples/kde/data/faithful.csv view
@@ -0,0 +1,273 @@+eruption,wait+3.6,79+1.8,54+3.333,74+2.283,62+4.533,85+2.883,55+4.7,88+3.6,85+1.95,51+4.35,85+1.833,54+3.917,84+4.2,78+1.75,47+4.7,83+2.167,52+1.75,62+4.8,84+1.6,52+4.25,79+1.8,51+1.75,47+3.45,78+3.067,69+4.533,74+3.6,83+1.967,55+4.083,76+3.85,78+4.433,79+4.3,73+4.467,77+3.367,66+4.033,80+3.833,74+2.017,52+1.867,48+4.833,80+1.833,59+4.783,90+4.35,80+1.883,58+4.567,84+1.75,58+4.533,73+3.317,83+3.833,64+2.1,53+4.633,82+2,59+4.8,75+4.716,90+1.833,54+4.833,80+1.733,54+4.883,83+3.717,71+1.667,64+4.567,77+4.317,81+2.233,59+4.5,84+1.75,48+4.8,82+1.817,60+4.4,92+4.167,78+4.7,78+2.067,65+4.7,73+4.033,82+1.967,56+4.5,79+4,71+1.983,62+5.067,76+2.017,60+4.567,78+3.883,76+3.6,83+4.133,75+4.333,82+4.1,70+2.633,65+4.067,73+4.933,88+3.95,76+4.517,80+2.167,48+4,86+2.2,60+4.333,90+1.867,50+4.817,78+1.833,63+4.3,72+4.667,84+3.75,75+1.867,51+4.9,82+2.483,62+4.367,88+2.1,49+4.5,83+4.05,81+1.867,47+4.7,84+1.783,52+4.85,86+3.683,81+4.733,75+2.3,59+4.9,89+4.417,79+1.7,59+4.633,81+2.317,50+4.6,85+1.817,59+4.417,87+2.617,53+4.067,69+4.25,77+1.967,56+4.6,88+3.767,81+1.917,45+4.5,82+2.267,55+4.65,90+1.867,45+4.167,83+2.8,56+4.333,89+1.833,46+4.383,82+1.883,51+4.933,86+2.033,53+3.733,79+4.233,81+2.233,60+4.533,82+4.817,77+4.333,76+1.983,59+4.633,80+2.017,49+5.1,96+1.8,53+5.033,77+4,77+2.4,65+4.6,81+3.567,71+4,70+4.5,81+4.083,93+1.8,53+3.967,89+2.2,45+4.15,86+2,58+3.833,78+3.5,66+4.583,76+2.367,63+5,88+1.933,52+4.617,93+1.917,49+2.083,57+4.583,77+3.333,68+4.167,81+4.333,81+4.5,73+2.417,50+4,85+4.167,74+1.883,55+4.583,77+4.25,83+3.767,83+2.033,51+4.433,78+4.083,84+1.833,46+4.417,83+2.183,55+4.8,81+1.833,57+4.8,76+4.1,84+3.966,77+4.233,81+3.5,87+4.366,77+2.25,51+4.667,78+2.1,60+4.35,82+4.133,91+1.867,53+4.6,78+1.783,46+4.367,77+3.85,84+1.933,49+4.5,83+2.383,71+4.7,80+1.867,49+3.833,75+3.417,64+4.233,76+2.4,53+4.8,94+2,55+4.15,76+1.867,50+4.267,82+1.75,54+4.483,75+4,78+4.117,79+4.083,78+4.267,78+3.917,70+4.55,79+4.083,70+2.417,54+4.183,86+2.217,50+4.45,90+1.883,54+1.85,54+4.283,77+3.95,79+2.333,64+4.15,75+2.35,47+4.933,86+2.9,63+4.583,85+3.833,82+2.083,57+4.367,82+2.133,67+4.35,74+2.2,54+4.45,83+3.567,73+4.5,73+4.15,88+3.817,80+3.917,71+4.45,83+2,56+4.283,79+4.767,78+4.533,84+1.85,58+4.25,83+1.983,43+2.25,60+4.75,75+4.117,81+2.15,46+4.417,90+1.817,46+4.467,74
+ examples/kde/kde.html view
@@ -0,0 +1,28 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">+<html>+ <head>+    <meta http-equiv="Content-Type" content="text/html; charset=utf-8">+    <title>Kernel density</title>+    <!--[if lte IE 8]><script language="javascript" type="text/javascript" src="http://people.iola.dk/olau/flot/excanvas.min.js"></script><![endif]-->+    <script language="javascript" type="text/javascript" src="https://ajax.googleapis.com/ajax/libs/jquery/1.6.4/jquery.min.js"></script>+    <script language="javascript" type="text/javascript" src="http://people.iola.dk/olau/flot/jquery.flot.js"></script>+ </head>+    <body>+    <h1>Kernel density</h1>++    <div id="placeholder" style="width:600px;height:450px;"></div>++    <p>This is a 64-point kernel density estimate+      of <a href="http://stat.ethz.ch/R-manual/R-patched/library/datasets/html/faithful.html">wait+        times between eruptions</a> of+      the <a href="http://en.wikipedia.org/wiki/Old_Faithful">Old+      Faithful</a> geyser.</p>++<script type="text/javascript">+$(function () {+    $.plot($("#placeholder"), [ [[37.7,2.5161110551039025e-4],[38.709523809523816,4.447091645179541e-4],[39.71904761904762,8.89495267293151e-4],[40.72857142857143,1.6826638124416372e-3],[41.73809523809524,2.915853030152525e-3],[42.747619047619054,4.617384776241099e-3],[43.75714285714286,6.707125941058233e-3],[44.766666666666666,9.002680047224753e-3],[45.77619047619048,1.1289358222230473e-2],[46.78571428571429,1.3413998627118355e-2],[47.7952380952381,1.5334009498412205e-2],[48.804761904761904,1.7084636391985843e-2],[49.81428571428572,1.869160073198233e-2],[50.82380952380953,2.0093659237928833e-2],[51.833333333333336,2.1129704241951732e-2],[52.84285714285714,2.160813072660192e-2],[53.852380952380955,2.142690467760544e-2],[54.86190476190477,2.0663894588783302e-2],[55.871428571428574,1.9554774751720513e-2],[56.88095238095238,1.835784852185525e-2],[57.89047619047619,1.721364996782301e-2],[58.900000000000006,1.611898372722214e-2],[59.90952380952381,1.5018622544779535e-2],[60.91904761904762,1.3900964326230551e-2],[61.92857142857143,1.2803755503590803e-2],[62.938095238095244,1.175952549012556e-2],[63.94761904761905,1.0778427101353434e-2],[64.95714285714286,9.90254113687662e-3],[65.96666666666667,9.263754969613376e-3],[66.97619047619048,9.065069215913515e-3],[67.9857142857143,9.489824501493842e-3],[68.9952380952381,1.062157012231642e-2],[70.0047619047619,1.2443698406039176e-2],[71.01428571428572,1.4902887084493477e-2],[72.02380952380952,1.7957646715371086e-2],[73.03333333333333,2.155509535870428e-2],[74.04285714285714,2.5555036677672206e-2],[75.05238095238096,2.967437285217729e-2],[76.06190476190477,3.3517062326339185e-2],[77.07142857142857,3.6695760198314636e-2],[78.08095238095238,3.897328209325028e-2],[79.0904761904762,4.0310862807977195e-2],[80.1,4.076878209020111e-2],[81.10952380952381,4.034443197900639e-2],[82.11904761904762,3.8916020257382e-2],[83.12857142857143,3.6371579849283686e-2],[84.13809523809525,3.2813879362105385e-2],[85.14761904761905,2.8641170617233373e-2],[86.15714285714286,2.440986212690428e-2],[87.16666666666667,2.0578794105541566e-2],[88.17619047619047,1.7329418869432917e-2],[89.18571428571428,1.4578610745209346e-2],[90.1952380952381,1.2139322012628417e-2],[91.20476190476191,9.885013669357134e-3],[92.21428571428572,7.807129857922685e-3],[93.22380952380952,5.966284588636623e-3],[94.23333333333333,4.415584046924452e-3],[95.24285714285715,3.1632654187895254e-3],[96.25238095238095,2.1821132245726424e-3],[97.26190476190476,1.43459816068524e-3],[98.27142857142857,8.875453007766301e-4],[99.28095238095239,5.128125355532956e-4],[100.2904761904762,2.8384986932914304e-4],[101.3,1.768029983316066e-4]] ]);+});+</script>++ </body>+</html>
+ examples/kde/kde.tpl view
@@ -0,0 +1,28 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">+<html>+ <head>+    <meta http-equiv="Content-Type" content="text/html; charset=utf-8">+    <title>Kernel density</title>+    <!--[if lte IE 8]><script language="javascript" type="text/javascript" src="http://people.iola.dk/olau/flot/excanvas.min.js"></script><![endif]-->+    <script language="javascript" type="text/javascript" src="https://ajax.googleapis.com/ajax/libs/jquery/1.6.4/jquery.min.js"></script>+    <script language="javascript" type="text/javascript" src="http://people.iola.dk/olau/flot/jquery.flot.js"></script>+ </head>+    <body>+    <h1>Kernel density</h1>++    <div id="placeholder" style="width:600px;height:450px;"></div>++    <p>This is a 64-point kernel density estimate+      of <a href="http://stat.ethz.ch/R-manual/R-patched/library/datasets/html/faithful.html">wait+        times between eruptions</a> of+      the <a href="http://en.wikipedia.org/wiki/Old_Faithful">Old+      Faithful</a> geyser.</p>++<script type="text/javascript">+$(function () {+    $.plot($("#placeholder"), [ {{data}} ]);+});+</script>++ </body>+</html>
+ statistics-skinny.cabal view
@@ -0,0 +1,176 @@+name:           statistics-skinny+version:        0.15.2.0+synopsis:       A library of statistical types, data, and functions+description:+  This library provides a number of common functions and types useful+  in statistics.  We focus on high performance, numerical robustness,+  and use of good algorithms.  Where possible, we provide+  references to the statistical literature.+  .+  The library's facilities can be divided into four broad categories:+  .+  * Working with widely used discrete and continuous probability+    distributions.  (There are dozens of exotic distributions in use;+    we focus on the most common.)+  .+  * Computing with sample data: quantile estimation, kernel density+    estimation, histograms, bootstrap methods, significance testing,+    and regression and autocorrelation analysis.+  .+  * Random variate generation under several different distributions.+  .+  * Common statistical tests for significant differences between+    samples.++license:        BSD2+license-file:   LICENSE+homepage:       https://github.com/bos/statistics+bug-reports:    https://github.com/bos/statistics/issues+author:         Bryan O'Sullivan <bos@serpentine.com>, Alexey Khudaykov <alexey.skladnoy@gmail.com>+maintainer:     Vanessa McHale <vamchale@gmail.com>+copyright:      2009-2014 Bryan O'Sullivan+category:       Math, Statistics+build-type:     Simple+cabal-version:  >= 1.10+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++tested-with:+    GHC ==7.10.3+     || ==8.0.2+     || ==8.2.2+     || ==8.4.4+     || ==8.6.5+     || ==8.8.3+     || ==8.10.1+  , GHCJS ==8.4+++library+  exposed-modules:+    Statistics.Autocorrelation+    Statistics.ConfidenceInt+    Statistics.Correlation+    Statistics.Correlation.Kendall+    Statistics.Distribution+    Statistics.Distribution.Beta+    Statistics.Distribution.Binomial+    Statistics.Distribution.CauchyLorentz+    Statistics.Distribution.ChiSquared+    Statistics.Distribution.DiscreteUniform+    Statistics.Distribution.Exponential+    Statistics.Distribution.FDistribution+    Statistics.Distribution.Gamma+    Statistics.Distribution.Geometric+    Statistics.Distribution.Hypergeometric+    Statistics.Distribution.Laplace+    Statistics.Distribution.Normal+    Statistics.Distribution.Poisson+    Statistics.Distribution.StudentT+    Statistics.Distribution.Transform+    Statistics.Distribution.Uniform+    Statistics.Function+    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.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+  default-language:+    Haskell98+  other-modules:+    Statistics.Distribution.Poisson.Internal+    Statistics.Internal+    Statistics.Test.Internal+    Statistics.Types.Internal+  build-depends: base                    >= 4.8 && < 5+               , base-orphans            >= 0.6 && <0.9+                 --+               , math-functions          >= 0.3+               , mwc-random              >= 0.13.0.0+                 --+               , async                   >= 2.2.2 && <2.3+               , deepseq                 >= 1.1.0.2+               , primitive               >= 0.3+               , dense-linear-algebra    >= 0.1 && <0.2+               , vector                  >= 0.10+               , vector-algorithms       >= 0.4+               , vector-th-unbox+               , data-default-class      >= 0.1.2+  if !impl(ghcjs)+    build-depends:+      monad-par               >= 0.3.4+  -- Older GHC+  if impl(ghc < 7.6)+    build-depends:+      ghc-prim+  ghc-options: -O2 -Wall -fwarn-tabs -funbox-strict-fields++test-suite statistics-tests+  type:           exitcode-stdio-1.0+  hs-source-dirs: tests+  main-is:        tests.hs+  other-modules:+    Tests.ApproxEq+    Tests.Correlation+    Tests.Distribution+    Tests.Function+    Tests.Helpers+    Tests.KDE+    Tests.Matrix+    Tests.Matrix.Types+    Tests.NonParametric+    Tests.NonParametric.Table+    Tests.Orphanage+    Tests.Parametric+    Tests.Serialization+    Tests.Transform+    Tests.Quantile+  default-language:+    Haskell98+  ghc-options:+    -Wall -threaded -rtsopts -fsimpl-tick-factor=500+  build-depends: base+               , statistics-skinny+               , dense-linear-algebra+               , QuickCheck >= 2.7.5+               , erf+               , ieee754 >= 0.7.3+               , math-functions+               , mwc-random+               , primitive+               , tasty+               , tasty-hunit+               , tasty-quickcheck+               , tasty-expected-failure+               , vector+               , vector-algorithms++source-repository head+  type:     git+  location: https://github.com/vmchale/statistics
+ tests/Tests/ApproxEq.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances, TypeFamilies #-}++module Tests.ApproxEq+    (+      ApproxEq(..)+    ) where++import Data.Complex (Complex(..), realPart)+import Data.List (intersperse)+import Data.Maybe (catMaybes)+import Numeric.MathFunctions.Constants (m_epsilon)+import Statistics.Matrix hiding (map, toList)+import Test.QuickCheck+import qualified Data.Vector as V+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Unboxed as U+import qualified Statistics.Matrix as M++class (Eq a, Show a) => ApproxEq a where+    type Bounds a++    eq   :: Bounds a -> a -> a -> Bool+    eql  :: Bounds a -> a -> a -> Property+    eql eps a b = counterexample (show a ++ " /=~ " ++ show b) (eq eps a b)++    (=~)  :: a -> a -> Bool++    (==~) :: a -> a -> Property+    a ==~ b = counterexample (show a ++ " /=~ " ++ show b) (a =~ b)++instance ApproxEq Double where+    type Bounds Double = Double++    eq eps a b+      | a == 0 && b == 0 = True+      | otherwise        = abs (a - b) <= eps * max (abs a) (abs b)+    (=~)  = eq m_epsilon++instance ApproxEq (Complex Double) where+    type Bounds (Complex Double) = Double++    eq eps a@(ar :+ ai) b@(br :+ bi)+      | a == 0 && b == 0 = True+      | otherwise        = abs (ar - br) <= eps * d+                        && abs (ai - bi) <= eps * d+      where+        d = max (realPart $ abs a) (realPart $ abs b)++    (=~)  = eq m_epsilon++instance ApproxEq [Double] where+    type Bounds [Double] = Double++    eq  eps (x:xs) (y:ys) = eq eps x y && eq eps xs ys+    eq  _   []     []     = True+    eq  _   _      _      = False++    eql   = eqll length id id+    (=~)  = eq m_epsilon+    (==~) = eql m_epsilon++instance ApproxEq (U.Vector Double) where+    type Bounds (U.Vector Double) = Double++    eq    = eqv+    (=~)  = eq m_epsilon+    eql   = eqlv+    (==~) = eqlv m_epsilon++instance ApproxEq (V.Vector Double) where+    type Bounds (V.Vector Double) = Double++    eq    = eqv+    (=~)  = eq m_epsilon+    eql   = eqlv+    (==~) = eqlv m_epsilon++instance ApproxEq Matrix where+    type Bounds Matrix = Double++    eq eps (Matrix r1 c1 v1) (Matrix r2 c2 v2) =+      (r1,c1) == (r2,c2) && eq eps v1 v2+    (=~)  = eq m_epsilon+    eql eps a b = eqll dimension M.toList (`quotRem` cols a) eps a b+    (==~) = eql m_epsilon++eqv :: (ApproxEq a, G.Vector v Bool, G.Vector v a) =>+       Bounds a -> v a -> v a -> Bool+eqv eps a b = G.length a == G.length b && G.and (G.zipWith (eq eps) a b)++eqlv :: (ApproxEq [a], G.Vector v a) => Bounds [a] -> v a -> v a -> Property+eqlv eps a b = eql eps (G.toList a) (G.toList b)++eqll :: (ApproxEq l, ApproxEq a, Show c, Show d, Eq d, Bounds l ~ Bounds a) =>+        (l -> d) -> (l -> [a]) -> (Int -> c) -> Bounds l -> l -> l -> Property+eqll dim toList coord eps a b = counterexample fancy $ eq eps a b+  where+    fancy+      | la /= lb  = "size mismatch: " ++ show la ++ " /= " ++ show lb+      | length summary < length full = summary+      | otherwise = full+    summary = concat . intersperse ", " . catMaybes $+              zipWith3 whee (map coord [(0::Int)..]) xs ys+    full | '\n' `elem` sa = sa ++ "  /=~\n" ++ sb+         | otherwise      = sa ++ " /=~" ++ sb+    (sa, sb) = (show a, show b)+    (xs, ys) = (toList a, toList b)+    (la, lb) = (dim a, dim b)+    whee i x y | eq eps x y = Nothing+               | otherwise  = Just $ show i ++ ": " ++ show x ++ " /=~ " ++ show y
+ tests/Tests/Correlation.hs view
@@ -0,0 +1,167 @@+{-#LANGUAGE BangPatterns #-}++module Tests.Correlation+    ( tests ) where++import Control.Arrow (Arrow(..))+import qualified Data.Vector as V+import Statistics.Correlation+import Statistics.Correlation.Kendall+import Test.QuickCheck ((==>),Property,counterexample)+import Test.Tasty+import Test.Tasty.QuickCheck+import Test.Tasty.HUnit++import Tests.ApproxEq++----------------------------------------------------------------+-- Tests list+----------------------------------------------------------------++tests :: TestTree+tests = testGroup "Correlation"+    [ testProperty "Pearson correlation"           testPearson+    , testProperty "Spearman correlation is scale invariant" testSpearmanScale+    , testProperty "Spearman correlation, nonlinear"         testSpearmanNonlinear+    , testProperty "Kendall test -- general"       testKendall+    , testCase     "Kendall test -- special cases" testKendallSpecial+    ]+++----------------------------------------------------------------+-- Pearson's correlation+----------------------------------------------------------------++testPearson :: [(Double,Double)] -> Property+testPearson sample+  = (length sample > 1) ==> (exact ~= fast)+  where+    (~=) = eql 1e-12+    exact = exactPearson $ map (realToFrac *** realToFrac) sample+    fast  = pearson $ V.fromList sample++exactPearson :: [(Rational,Rational)] -> Double+exactPearson sample+  = realToFrac cov / sqrt (realToFrac (varX * varY))+  where+    (xs,ys) = unzip sample+    n       = fromIntegral $ length sample+    -- Mean+    muX  = sum xs / n+    muY  = sum ys / n+    -- Mean of squares+    muX2 = sum (map (\x->x*x) xs) / n+    muY2 = sum (map (\x->x*x) ys) / n+    -- Covariance+    cov  = sum (zipWith (*) [x - muX | x<-xs] [y - muY | y<-ys]) / n+    varX = muX2 - muX*muX+    varY = muY2 - muY*muY++----------------------------------------------------------------+-- Spearman's correlation+----------------------------------------------------------------++-- Test that Spearman correlation is scale invariant+testSpearmanScale :: [(Double,Double)] -> Double -> Property+testSpearmanScale xs a+  = and [ length xs > 1       -- Enough to calculate underflow+        , a /= 0+        , not (isNaN c1)+        , not (isNaN c2)+        , not (isNaN c3)+        , not (isNaN c4)+        ]+  ==> ( counterexample (show xs2)+      $ counterexample (show xs3)+      $ counterexample (show xs4)+      $ counterexample (show (c1,c2,c3,c4))+      $ and [ c1 == c4+           , c1 == signum a * c2+           , c1 == signum a * c3+           ]+      )+  where+    xs2 = map ((*a) *** id  ) xs+    xs3 = map (id   *** (*a)) xs+    xs4 = map ((*a) *** (*a)) xs+    c1 = spearman $ V.fromList xs+    c2 = spearman $ V.fromList xs2+    c3 = spearman $ V.fromList xs3+    c4 = spearman $ V.fromList xs4++-- Test that Spearman correlation allows to transform sample with+testSpearmanNonlinear :: [(Double,Double)] -> Property+testSpearmanNonlinear sample0+  = and [ length sample0 > 1+        , not (isNaN c1)+        , not (isNaN c2)+        , not (isNaN c3)+        , not (isNaN c4)+        ]+  ==> ( counterexample (show sample0)+      $ counterexample (show sample1)+      $ counterexample (show sample2)+      $ counterexample (show sample3)+      $ counterexample (show sample4)+      $ counterexample (show (c1,c2,c3,c4))+      $ and [ c1 == c2+            , c1 == c3+            , c1 == c4+            ]+      )+  where+    -- We need to stretch sample into [-10 .. 10] range to avoid+    -- problems with under/overflows etc.+    stretch xs+      | a == b = xs+      | otherwise = [ (x - a - 10) * 20 / (a - b) | x <- xs ]+      where+        a = minimum xs+        b = maximum xs+    sample1 = uncurry zip $ (stretch *** stretch) $ unzip sample0+    sample2 = map (exp *** id ) sample1+    sample3 = map (id  *** exp) sample1+    sample4 = map (exp *** exp) sample1+    c1 = spearman $ V.fromList sample1+    c2 = spearman $ V.fromList sample2+    c3 = spearman $ V.fromList sample3+    c4 = spearman $ V.fromList sample4+++----------------------------------------------------------------+-- Kendall's correlation+----------------------------------------------------------------++testKendall :: [(Double, Double)] -> Bool+testKendall xy | isNaN r1 = isNaN r2+               | otherwise = r1 == r2+  where+    r1 = kendallBruteForce xy+    r2 = kendall $ V.fromList xy++testKendallSpecial :: Assertion+testKendallSpecial = vs @=? map (\(xs, ys) -> kendall $ V.fromList $ zip xs ys) d+  where+    (d, vs) = unzip testData+    testData :: [(([Double], [Double]), Double)]+    testData = [ (([1, 2, 3, 1, 2], [1, 2, 1, 5, 2]), -0.375)+               , (([1, 1, 1, 3, 3], [3, 3, 3, 2, 5]), 0)+               ]+++kendallBruteForce :: [(Double, Double)] -> Double+kendallBruteForce xy = (n_c - n_d) / sqrt ((n_0 - n_1) * (n_0 - n_2))+  where+    allPairs = f xy+    (n_c, n_d, n_1, n_2) = foldl g (0,0,0,0) allPairs+    n_0 = fromIntegral.length $ allPairs+    g (!nc, !nd, !n1, !n2) ((x1, y1), (x2, y2))+      | (x2 - x1) * (y2 - y1) > 0 = (nc+1, nd, n1, n2)+      | (x2 - x1) * (y2 - y1) < 0 = (nc, nd+1, n1, n2)+      | otherwise = if x1 == x2+                       then if y1 == y2+                               then (nc, nd, n1+1, n2+1)+                               else (nc, nd, n1+1, n2)+                       else (nc, nd, n1, n2+1)+    f (x:xs) = zip (repeat x) xs ++ f xs+    f _ = []
+ tests/Tests/Distribution.hs view
@@ -0,0 +1,402 @@+{-# LANGUAGE FlexibleInstances, ScopedTypeVariables,+    ViewPatterns #-}+module Tests.Distribution (tests) where++import Control.Applicative ((<$))+import qualified Control.Exception as E+import Data.List (find)+import Data.Typeable (Typeable)+import Numeric.MathFunctions.Constants (m_tiny,m_huge,m_epsilon)+import Numeric.MathFunctions.Comparison+import Statistics.Distribution+import Statistics.Distribution.Beta           (BetaDistribution)+import Statistics.Distribution.Binomial       (BinomialDistribution)+import Statistics.Distribution.CauchyLorentz+import Statistics.Distribution.ChiSquared     (ChiSquared)+import Statistics.Distribution.Exponential    (ExponentialDistribution)+import Statistics.Distribution.FDistribution  (FDistribution,fDistribution)+import Statistics.Distribution.Gamma          (GammaDistribution,gammaDistr)+import Statistics.Distribution.Geometric+import Statistics.Distribution.Hypergeometric+import Statistics.Distribution.Laplace        (LaplaceDistribution)+import Statistics.Distribution.Normal         (NormalDistribution)+import Statistics.Distribution.Poisson        (PoissonDistribution)+import Statistics.Distribution.StudentT+import Statistics.Distribution.Transform      (LinearTransform)+import Statistics.Distribution.Uniform        (UniformDistribution)+import Statistics.Distribution.DiscreteUniform (DiscreteUniform)+import Test.Tasty                 (TestTree, testGroup)+import Test.Tasty.QuickCheck      (testProperty)+import Test.Tasty.ExpectedFailure (ignoreTest)+import Test.QuickCheck as QC+import Test.QuickCheck.Monadic as QC+import Text.Printf (printf)++import Tests.ApproxEq  (ApproxEq(..))+import Tests.Helpers   (T(..), Double01(..), testAssertion, typeName)+import Tests.Helpers   (monotonicallyIncreasesIEEE,isDenorm)+import Tests.Orphanage ()++-- | Tests for all distributions+tests :: TestTree+tests = testGroup "Tests for all distributions"+  [ contDistrTests (T :: T BetaDistribution        )+  , contDistrTests (T :: T CauchyDistribution      )+  , contDistrTests (T :: T ChiSquared              )+  , contDistrTests (T :: T ExponentialDistribution )+  , contDistrTests (T :: T GammaDistribution       )+  , contDistrTests (T :: T LaplaceDistribution     )+  , contDistrTests (T :: T NormalDistribution      )+  , contDistrTests (T :: T UniformDistribution     )+  , contDistrTests (T :: T StudentT                )+  , contDistrTests (T :: T (LinearTransform NormalDistribution))+  , contDistrTests (T :: T FDistribution           )++  , discreteDistrTests (T :: T BinomialDistribution       )+  , discreteDistrTests (T :: T GeometricDistribution      )+  , discreteDistrTests (T :: T GeometricDistribution0     )+  , discreteDistrTests (T :: T HypergeometricDistribution )+  , discreteDistrTests (T :: T PoissonDistribution        )+  , discreteDistrTests (T :: T DiscreteUniform            )++  , unitTests+  ]++----------------------------------------------------------------+-- Tests+----------------------------------------------------------------++-- Tests for continuous distribution+contDistrTests :: (Param d, ContDistr d, QC.Arbitrary d, Typeable d, Show d) => T d -> TestTree+contDistrTests t = testGroup ("Tests for: " ++ typeName t) $+  cdfTests t +++  [ testProperty "PDF sanity"              $ pdfSanityCheck     t+  ] +++  [ (if quantileIsInvCDF_enabled t then id else ignoreTest)+  $ testProperty "Quantile is CDF inverse" $ quantileIsInvCDF t+  , testProperty "quantile fails p<0||p>1" $ quantileShouldFail t+  , testProperty "log density check"       $ logDensityCheck    t+  , testProperty "complQuantile"           $ complQuantileCheck t+  ]++-- Tests for discrete distribution+discreteDistrTests :: (Param d, DiscreteDistr d, QC.Arbitrary d, Typeable d, Show d) => T d -> TestTree+discreteDistrTests t = testGroup ("Tests for: " ++ typeName t) $+  cdfTests t +++  [ testProperty "Prob. sanity"         $ probSanityCheck       t+  , testProperty "CDF is sum of prob."  $ discreteCDFcorrect    t+  , testProperty "Discrete CDF is OK"   $ cdfDiscreteIsCorrect  t+  , testProperty "log probabilty check" $ logProbabilityCheck   t+  ]++-- Tests for distributions which have CDF+cdfTests :: (Param d, Distribution d, QC.Arbitrary d, Show d) => T d -> [TestTree]+cdfTests t =+  [ testProperty "C.D.F. sanity"        $ cdfSanityCheck         t+  , testProperty "CDF limit at +inf"    $ cdfLimitAtPosInfinity  t+  , testProperty "CDF limit at -inf"    $ cdfLimitAtNegInfinity  t+  , testProperty "CDF at +inf = 1"      $ cdfAtPosInfinity       t+  , testProperty "CDF at -inf = 1"      $ cdfAtNegInfinity       t+  , testProperty "CDF is nondecreasing" $ cdfIsNondecreasing     t+  , testProperty "1-CDF is correct"     $ cdfComplementIsCorrect t+  ]+++----------------------------------------------------------------++-- CDF is in [0,1] range+cdfSanityCheck :: (Distribution d) => T d -> d -> Double -> Bool+cdfSanityCheck _ d x = c >= 0 && c <= 1+  where c = cumulative d x++-- CDF never decreases+cdfIsNondecreasing :: (Distribution d) => T d -> d -> Double -> Double -> Bool+cdfIsNondecreasing _ d = monotonicallyIncreasesIEEE $ cumulative d++-- cumulative d +∞ = 1+cdfAtPosInfinity :: (Distribution d) => T d -> d -> Bool+cdfAtPosInfinity _ d+  = cumulative d (1/0) == 1++-- cumulative d - ∞ = 0+cdfAtNegInfinity :: (Distribution d) => T d -> d -> Bool+cdfAtNegInfinity _ d+  = cumulative d (-1/0) == 0++-- CDF limit at +∞ is 1+cdfLimitAtPosInfinity :: (Param d, Distribution d) => T d -> d -> Bool+cdfLimitAtPosInfinity _ d+  = Just 1.0 == find (>=1) probs+  where+    probs = map (cumulative d)+          $ takeWhile (< (m_huge/2))+          $ iterate (*1.4) 1++-- CDF limit at -∞ is 0+cdfLimitAtNegInfinity :: (Param d, Distribution d) => T d -> d -> Bool+cdfLimitAtNegInfinity _ d+  = Just 0 == find (<=0) probs+  where+    probs = map (cumulative d)+          $ takeWhile (> (-m_huge/2))+          $ iterate (*1.4) (-1)+++-- CDF's complement is implemented correctly+cdfComplementIsCorrect :: (Distribution d, Param d) => T d -> d -> Double -> Property+cdfComplementIsCorrect _ d x+  = counterexample ("err. tolerance = " ++ show tol)+  $ counterexample ("difference     = " ++ show delta)+  $ delta <= tol+  where+    tol   = prec_complementCDF d+    delta = 1 - (cumulative d x + complCumulative d x)++-- CDF for discrete distribution uses <= for comparison+cdfDiscreteIsCorrect :: (Param d, DiscreteDistr d) => T d -> d -> Property+cdfDiscreteIsCorrect _ d+  = counterexample (unlines badN)+  $ null badN+  where+    -- We are checking that:+    --+    -- > CDF(i) - CDF(i-e) = P(i)+    --+    -- 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.+    badN = [ printf "N=%3i    p[i]=%g\tp[i+1]=%g\tdP=%g\trelerr=%g" i p p1 dp ((p1-p-dp) / max p1 dp)+           | i <- [0 .. 100]+           , let p      = cumulative d $ fromIntegral i - 1e-6+                 p1     = cumulative d $ fromIntegral i+                 dp     = probability d i+                 relerr = ((p1 - p) - dp) / max p1 dp+           , p  > m_tiny || p == 0+           , p1 > m_tiny+           , dp > m_tiny+           , relerr > tol+           ]+    tol = prec_discreteCDF d++logDensityCheck :: (ContDistr d) => T d -> d -> Double -> Property+logDensityCheck _ d x+  = not (isDenorm x)+  ==> ( counterexample (printf "density    = %g" p)+      $ counterexample (printf "logDensity = %g" logP)+      $ counterexample (printf "log p      = %g" (log p))+      $ counterexample (printf "eps        = %g" (abs (logP - log p) / max (abs (log p)) (abs logP)))+      $ 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+           ,  (ulpDistance (log p) logP <= 32)+           || (ulpDistance p (exp logP) <= 32)+           ])+  where+    p    = density d x+    logP = logDensity d x++-- 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)+  -- 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+        ] ==> (abs (x1 - x0) < 1e-6)+  where+    x0 = quantile      d (1 - p)+    x1 = complQuantile d p++-- Quantile is inverse of CDF+quantileIsInvCDF :: (Param d, ContDistr d) => T d -> d -> Double01 -> Property+quantileIsInvCDF _ d (Double01 p) =+  and [ p > m_tiny+      , p < 1+      , x > m_tiny+      , dens > 0+      ] ==>+    ( counterexample (printf "Quantile      = %g" x )+    $ counterexample (printf "Probability   = %g" p )+    $ counterexample (printf "Probability'  = %g" p')+    $ counterexample (printf "Rel. error    = %g" (relativeError p p'))+    $ counterexample (printf "Abs. error    = %e" (abs $ p - p'))+    $ counterexample (printf "Expected err. = %g" err)+    $ counterexample (printf "Distance      = %i" (ulpDistance p p'))+    $ counterexample (printf "Err/est       = %g" (fromIntegral (ulpDistance p p') / err))+    $ ulpDistance p p' <= round err+    )+  where+    -- Algorithm for error estimation is taken from here+    --+    -- http://sepulcarium.org/posts/2012-07-19-rounding_effect_on_inverse.html+    dens = density    d x+    err  = eps + eps' * abs (x / p) * dens+    --+    x    = quantile   d p+    p'   = cumulative d x+    (eps,eps') = prec_quantile_CDF d++-- Test that quantile fails if p<0 or p>1+quantileShouldFail :: (ContDistr d) => T d -> d -> Double -> Property+quantileShouldFail _ d p =+  p < 0 || p > 1 ==> QC.monadicIO $ do r <- QC.run $ E.catch+                                              (False <$ (return $! quantile d p))+                                              (\(_ :: E.SomeException) -> return True)+                                       QC.assert r+++-- Probability is in [0,1] range+probSanityCheck :: (DiscreteDistr d) => T d -> d -> Int -> Bool+probSanityCheck _ d x = p >= 0 && p <= 1+  where p = probability d x++-- Check that discrete CDF is correct+discreteCDFcorrect :: (DiscreteDistr d) => T d -> d -> Int -> Int -> Property+discreteCDFcorrect _ d a b+  = counterexample (printf "CDF   = %g" p1)+  $ counterexample (printf "Sum   = %g" p2)+  $ counterexample (printf "Delta = %g" (abs (p1 - p2)))+  $ abs (p1 - p2) < 3e-10+  -- Avoid too large differeneces. Otherwise there is to much to sum+  --+  -- Absolute difference is used guard againist precision loss when+  -- close values of CDF are subtracted+  where+    n  = min a b+    m  = n + (abs (a - b) `mod` 100)+    p1 = cumulative d (fromIntegral m + 0.5) - cumulative d (fromIntegral n - 0.5)+    p2 = sum $ map (probability d) [n .. m]++logProbabilityCheck :: (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)))+  $ or [ p == 0     && logP == (-1/0)+       , p < 1e-308 && logP < 609+         -- To avoid problems with roundtripping error in case+         -- when density is computed as exponent of logDensity we+         -- accept either inequality+       ,  (ulpDistance (log p) logP <= 32)+       || (ulpDistance p (exp logP) <= 32)+       ]+  where+    p    = probability d x+    logP = logProbability d x+++-- | Parameters for distribution testing. Some distribution require+--   relaxing parameters a bit+class Param a where+  -- | Whether quantileIsInvCDF is enabled+  quantileIsInvCDF_enabled :: T a -> Bool+  quantileIsInvCDF_enabled _ = True+  -- | 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++instance Param StudentT where+  -- FIXME: disabled unless incompleteBeta troubles are sorted out+  quantileIsInvCDF_enabled _ = False+instance Param BetaDistribution where+  -- FIXME: See https://github.com/bos/statistics/issues/161 for details+  quantileIsInvCDF_enabled _ = False+instance Param FDistribution where+  -- FIXME: disabled unless incompleteBeta troubles are sorted out+  quantileIsInvCDF_enabled _ = False+  -- We compute CDF and complement using same method so precision+  -- should be very good here.+  prec_complementCDF _ = 2 * m_epsilon++instance Param ChiSquared where+  prec_quantile_CDF _ = (32,32)++instance Param BinomialDistribution where+  prec_discreteCDF _ = 1e-13+instance Param CauchyDistribution+instance Param DiscreteUniform+instance Param ExponentialDistribution+instance Param GammaDistribution+instance Param GeometricDistribution+instance Param GeometricDistribution0+instance Param HypergeometricDistribution+instance Param LaplaceDistribution+instance Param NormalDistribution+instance Param PoissonDistribution+instance Param UniformDistribution+instance Param a => Param (LinearTransform a)++++----------------------------------------------------------------+-- Unit tests+----------------------------------------------------------------++unitTests :: TestTree+unitTests = testGroup "Unit tests"+  [ testAssertion "density (gammaDistr 150 1/150) 1 == 4.883311" $+      4.883311418525483 =~ density (gammaDistr 150 (1/150)) 1+    -- Student-T+  , testStudentPDF 0.3  1.34  0.0648215  -- PDF+  , testStudentPDF 1    0.42  0.27058+  , testStudentPDF 4.4  0.33  0.352994+  , testStudentCDF 0.3  3.34  0.757146   -- CDF+  , testStudentCDF 1    0.42  0.626569+  , testStudentCDF 4.4  0.33  0.621739+    -- Student-T General+  , testStudentUnstandardizedPDF 0.3    1.2  4      0.45 0.0533456  -- PDF+  , testStudentUnstandardizedPDF 4.3  (-2.4) 3.22 (-0.6) 0.0971141+  , testStudentUnstandardizedPDF 3.8    0.22 7.62   0.14 0.0490523+  , testStudentUnstandardizedCDF 0.3    1.2  4      0.45 0.458035   -- CDF+  , testStudentUnstandardizedCDF 4.3  (-2.4) 3.22 (-0.6) 0.698001+  , testStudentUnstandardizedCDF 3.8    0.22 7.62   0.14 0.496076+    -- F-distribution+  , testFdistrPDF  1  3   3     (1/(6 * pi)) -- PDF+  , testFdistrPDF  2  2   1.2   0.206612+  , testFdistrPDF  10 12  8     0.000385613179281892790166+  , testFdistrCDF  1  3   3     0.81830988618379067153 -- CDF+  , testFdistrCDF  2  2   1.2   0.545455+  , testFdistrCDF  10 12  8     0.99935509863451408041+  ]+  where+    -- Student-T+    testStudentPDF ndf x exact+      = testAssertion (printf "density (studentT %f) %f ~ %f" ndf x exact)+      $ eq 1e-5  exact  (density (studentT ndf) x)+    testStudentCDF ndf x exact+      = testAssertion (printf "cumulative (studentT %f) %f ~ %f" ndf x exact)+      $ eq 1e-5  exact  (cumulative (studentT ndf) x)+    -- Student-T General+    testStudentUnstandardizedPDF ndf mu sigma x exact+      = testAssertion (printf "density (studentTUnstandardized %f %f %f) %f ~ %f" ndf mu sigma x exact)+      $ eq 1e-5  exact  (density (studentTUnstandardized ndf mu sigma) x)+    testStudentUnstandardizedCDF ndf mu sigma x exact+      = testAssertion (printf "cumulative (studentTUnstandardized %f %f %f) %f ~ %f" ndf mu sigma x exact)+      $ eq 1e-5  exact  (cumulative (studentTUnstandardized ndf mu sigma) x)+    -- F-distribution+    testFdistrPDF n m x exact+      = testAssertion (printf "density (fDistribution %i %i) %f ~ %f [got %f]" n m x exact d)+      $ eq 1e-5  exact d+      where d = density (fDistribution n m) x+    testFdistrCDF n m x exact+      = testAssertion (printf "cumulative (fDistribution %i %i) %f ~ %f [got %f]" n m x exact d)+      $ eq 1e-5  exact d+      where d = cumulative (fDistribution n m) x
+ tests/Tests/Function.hs view
@@ -0,0 +1,29 @@+module Tests.Function ( tests ) where++import Statistics.Function+import Test.Tasty+import Test.Tasty.QuickCheck+import Test.QuickCheck+import Tests.Helpers+import qualified Data.Vector.Unboxed as U+++tests :: TestTree+tests = testGroup "S.Function"+  [ testProperty  "Sort is sort"                p_sort+  , testAssertion "nextHighestPowerOfTwo is OK" p_nextHighestPowerOfTwo+  ]+++p_sort :: [Double] -> Property+p_sort xs =+  not (null xs) ==> U.all (uncurry (<=)) (U.zip v $ U.tail v)+    where+      v = sort $ U.fromList xs++p_nextHighestPowerOfTwo :: Bool+p_nextHighestPowerOfTwo+  = all (\(good, is) -> all ((==good) . nextHighestPowerOfTwo) is) lists+  where+    pows  = [1 .. 17 :: Int]+    lists = [ (2^m, [2^n+1 .. 2^m]) | (n,m) <- pows `zip` tail pows ]
+ tests/Tests/Helpers.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE ScopedTypeVariables #-}+-- | Helpers for testing+module Tests.Helpers (+    -- * helpers+    T(..)+  , typeName+  , Double01(..)+    -- * IEEE 754+  , isDenorm+    -- * Generic QC tests+  , monotonicallyIncreases+  , monotonicallyIncreasesIEEE+    -- * HUnit helpers+  , testAssertion+  , testEquality+    -- * QC helpers+  , small+  , unsquare+  , shrinkFixedList+  ) where++import Data.Typeable+import Numeric.MathFunctions.Constants (m_tiny)+import Test.Tasty+import Test.Tasty.HUnit+import Test.QuickCheck+import qualified Numeric.IEEE     as IEEE+import qualified Test.Tasty.HUnit as HU++-- | Phantom typed value used to select right instance in QC tests+data T a = T++-- | String representation of type name+typeName :: Typeable a => T a -> String+typeName = show . typeOf . typeParam+  where+    typeParam :: T a -> a+    typeParam _ = undefined++-- | Check if Double denormalized+isDenorm :: Double -> Bool+isDenorm x = let ax = abs x in ax > 0 && ax < m_tiny++-- | Generates Doubles in range [0,1]+newtype Double01 = Double01 Double+                   deriving (Show)+instance Arbitrary Double01 where+  arbitrary = do+    (_::Int, x) <- fmap properFraction arbitrary+    return $ Double01 x++----------------------------------------------------------------+-- Generic QC+----------------------------------------------------------------++-- Check that function is nondecreasing+monotonicallyIncreases :: (Ord a, Ord b) => (a -> b) -> a -> a -> Bool+monotonicallyIncreases f x1 x2 = f (min x1 x2) <= f (max x1 x2)++-- Check that function is nondecreasing taking rounding errors into+-- account.+--+-- In fact funstion is allowed to decrease less than one ulp in order+-- to guard againist problems with excess precision. On x86 FPU works+-- with 80-bit numbers but doubles are 64-bit so rounding happens+-- whenever values are moved from registers to memory+monotonicallyIncreasesIEEE :: (Ord a, IEEE.IEEE b)  => (a -> b) -> a -> a -> Bool+monotonicallyIncreasesIEEE f x1 x2 =+  y1 <= y2 || (y1 - y2) < y2 * IEEE.epsilon+  where+    y1 = f (min x1 x2)+    y2 = f (max x1 x2)++----------------------------------------------------------------+-- HUnit helpers+----------------------------------------------------------------++testAssertion :: String -> Bool -> TestTree+testAssertion str cont = testCase str $ HU.assertBool str cont++testEquality :: (Show a, Eq a) => String -> a -> a -> TestTree+testEquality msg a b = testCase msg $ HU.assertEqual msg a b++unsquare :: (Arbitrary a, Show a, Testable b) => (a -> b) -> Property+unsquare = forAll (small arbitrary)++small :: Gen a -> Gen a+small act = sized $ \n -> resize (smallish n) act+  where smallish = round . (sqrt :: Double -> Double) . fromIntegral . abs++shrinkFixedList :: (a -> [a]) -> [a] -> [[a]]+shrinkFixedList shr (x:xs) = map (:xs) (shr x) ++ map (x:) (shrinkFixedList shr xs)+shrinkFixedList _   []     = []
+ tests/Tests/KDE.hs view
@@ -0,0 +1,43 @@+-- | Tests for Kernel density estimates.+module Tests.KDE (+  tests+  )where++import Data.Vector.Unboxed             ((!))+import Numeric.Sum                     (kbn, sumVector)+import Statistics.Sample.KernelDensity+import Test.Tasty                      (TestTree, testGroup)+import Test.Tasty.QuickCheck           (testProperty)+import Test.QuickCheck                 (Property, (==>), counterexample)+import Text.Printf                     (printf)+import qualified Data.Vector.Unboxed as U+++tests :: TestTree+tests = testGroup "KDE"+  [ testProperty "integral(PDF) == 1" t_densityIsPDF+  ]++t_densityIsPDF :: [Double] -> Property+t_densityIsPDF vec+  = not (null vec) ==> test+  where+    (xs,ys)  = kde 4096 (U.fromList vec)+    step     = (xs ! 1) - (xs ! 0)+    integral = integratePDF step ys+    --+    test = counterexample (printf "Integral %f" integral)+         $ abs (1 - integral) <= 1e-3++++integratePDF :: Double -> U.Vector Double -> Double+integratePDF step vec+  = step * sumVector kbn (U.zipWith (*) vec weights)+  where+    n       = U.length vec+    weights = U.generate n go+      where+        go i | i == 0    = 0.5+             | i == n-1  = 0.5+             | otherwise = 1
+ tests/Tests/Math/Tables.hs view
@@ -0,0 +1,47 @@+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 view
@@ -0,0 +1,51 @@+#!/usr/bin/python+"""+"""++from mpmath import *++def printListLiteral(lines) :+    print "  [" + "\n  , ".join(lines) + "\n  ]"++################################################################+# Generate header+print "module Tests.Math.Tables where"+print++################################################################+## Generate table for logGamma+print "tableLogGamma :: [(Double,Double)]"+print "tableLogGamma ="++gammaArg = [ 1.25e-6, 6.82e-5, 2.46e-4, 8.8e-4,  3.12e-3, 2.67e-2,+             7.77e-2, 0.234,   0.86,    1.34,    1.89,    2.45,+             3.65,    4.56,    6.66,    8.25,    11.3,    25.6,+             50.4,    123.3,   487.4,   853.4,   2923.3,  8764.3,+             1.263e4, 3.45e4,  8.234e4, 2.348e5, 8.343e5, 1.23e6,+             ]+printListLiteral(+    [ '(%.15f, %.20g)' % (x, log(gamma(x))) for x in gammaArg ]+    )+++################################################################+## Generate table for incompleteBeta++print "tableIncompleteBeta :: [(Double,Double,Double,Double)]"+print "tableIncompleteBeta ="++incompleteBetaArg = [+    (2,    3,    0.03),+    (2,    3,    0.23),+    (2,    3,    0.76),+    (4,    2.3,  0.89),+    (1,    1,    0.55),+    (0.3,  12.2, 0.11),+    (13.1, 9.8,  0.12),+    (13.1, 9.8,  0.42),+    (13.1, 9.8,  0.92),+    ]+printListLiteral(+    [ '(%.15f, %.15f, %.15f, %.20g)' % (p,q,x, betainc(p,q,0,x, regularized=True))+      for (p,q,x) in incompleteBetaArg+      ])
+ tests/Tests/Matrix.hs view
@@ -0,0 +1,41 @@+module Tests.Matrix (tests) where++import Statistics.Matrix hiding (map)+import Statistics.Matrix.Algorithms+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.QuickCheck (testProperty)+import Test.QuickCheck+import Tests.ApproxEq (ApproxEq(..))+import Tests.Matrix.Types+import qualified Data.Vector.Unboxed as U++t_row :: Mat Double -> Gen Property+t_row ms@(Mat r _ xs) = do+  i <- choose (0,r-1)+  return $ row (fromMat ms) i === U.fromList (xs !! i)++t_column :: Mat Double -> Gen Property+t_column ms@(Mat _ c xs) = do+  i <- choose (0,c-1)+  return $ column (fromMat ms) i === U.fromList (map (!! i) xs)++t_center :: Mat Double -> Property+t_center ms@(Mat r c xs) =+  (xs !! (r `quot` 2)) !! (c `quot` 2) === center (fromMat ms)++t_transpose :: Matrix -> Property+t_transpose m = U.concat (map (column n) [0..rows m-1]) === toVector m+  where n = transpose m++t_qr :: Matrix -> Property+t_qr a = hasNaN p .||. eql 1e-10 a p+  where p = uncurry multiply (qr a)++tests :: TestTree+tests = testGroup "Matrix"+  [ testProperty "t_row" t_row+  , testProperty "t_column" t_column+  , testProperty "t_center" t_center+  , testProperty "t_transpose" t_transpose+  , testProperty "t_qr" t_qr+  ]
+ tests/Tests/Matrix/Types.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE DeriveFunctor #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Tests.Matrix.Types+    (+      Mat(..)+    , fromMat+    , toMat+    ) where++import Control.Monad (join)+import Control.Applicative ((<$>), (<*>))+import Statistics.Matrix (Matrix(..), fromList)+import Test.QuickCheck+import Tests.Helpers (shrinkFixedList, small)+import qualified Data.Vector.Unboxed as U++data Mat a = Mat { mrows :: Int , mcols :: Int+                 , asList :: [[a]] }+              deriving (Eq, Ord, Show, Functor)++fromMat :: Mat Double -> Matrix+fromMat (Mat r c xs) = fromList r c (concat xs)++toMat :: Matrix -> Mat Double+toMat (Matrix r c v) = Mat r c . split . U.toList $ v+  where split xs@(_:_) = let (h,t) = splitAt c xs+                         in h : split t+        split []       = []++instance (Arbitrary a) => Arbitrary (Mat a) where+    arbitrary = small $ join (arbMat <$> arbitrary <*> arbitrary)+    shrink (Mat r c xs) = Mat r c <$> shrinkFixedList (shrinkFixedList shrink) xs++arbMat :: (Arbitrary a) => Positive (Small Int) -> Positive (Small Int)+       -> Gen (Mat a)+arbMat (Positive (Small r)) (Positive (Small c)) =+    Mat r c <$> vectorOf r (vector c)++instance Arbitrary Matrix where+    arbitrary = fromMat <$> arbitrary+    -- shrink    = map fromMat . shrink . toMat
+ tests/Tests/NonParametric.hs view
@@ -0,0 +1,303 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ViewPatterns     #-}+-- Tests for Statistics.Test.NonParametric+module Tests.NonParametric (tests) where++import Statistics.Distribution.Normal (standard)+import Statistics.Test.KolmogorovSmirnov+import Statistics.Test.MannWhitneyU+import Statistics.Test.KruskalWallis+import Statistics.Test.WilcoxonT+import Statistics.Types (PValue,pValue,mkPValue)++import Test.Tasty                (testGroup)+import Test.Tasty.HUnit+import Tests.ApproxEq            (eq)+import Tests.Helpers             (testAssertion, testEquality)+import Tests.NonParametric.Table (tableKSD, tableKS2D)+import qualified Test.Tasty          as Tst+import qualified Data.Vector.Unboxed as U+++tests :: Tst.TestTree+tests = testGroup "Nonparametric tests"+        $ concat [ mannWhitneyTests+                 , wilcoxonSumTests+                 , wilcoxonPairTests+                 , kruskalWallisRankTests+                 , kruskalWallisTests+                 , kolmogorovSmirnovDTest+                 ]++----------------------------------------------------------------++mannWhitneyTests :: [Tst.TestTree]+mannWhitneyTests = zipWith test [(0::Int)..] testData +++  [ testEquality "Mann-Whitney U Critical Values, m=1"+      (replicate (20*3) Nothing)+      [mannWhitneyUCriticalValue (1,x) (mkPValue p) | x <- [1..20], p <- [0.005,0.01,0.025]]+  , testEquality "Mann-Whitney U Critical Values, m=2, p=0.025"+      (replicate 7 Nothing ++ map Just [0,0,0,0,1,1,1,1,1,2,2,2,2])+      [mannWhitneyUCriticalValue (2,x) (mkPValue 0.025) | x <- [1..20]]+  , testEquality "Mann-Whitney U Critical Values, m=6, p=0.05"+      (replicate 1 Nothing ++ map Just [0, 2,3,5,7,8,10,12,14,16,17,19,21,23,25,26,28,30,32])+      [mannWhitneyUCriticalValue (6,x) (mkPValue 0.05) | x <- [1..20]]+  , testEquality "Mann-Whitney U Critical Values, m=20, p=0.025"+      (replicate 1 Nothing ++ map Just [2,8,14,20,27,34,41,48,55,62,69,76,83,90,98,105,112,119,127])+      [mannWhitneyUCriticalValue (20,x) (mkPValue 0.025) | x <- [1..20]]+  ]+  where+    test n (a, b, c, d)+      = testCase "Mann-Whitney" $ do+          assertEqual ("Mann-Whitney U "     ++ show n) c us+          assertEqual ("Mann-Whitney U Sig " ++ show n) d ss+      where+        us = mannWhitneyU (U.fromList a) (U.fromList b)+        ss = mannWhitneyUSignificant SamplesDiffer (length a, length b) p005 us+    -- List of (Sample A, Sample B, (Positive Rank, Negative Rank))+    testData :: [([Double], [Double], (Double, Double), Maybe TestResult)]+    testData = [ ( [3,4,2,6,2,5]+                 , [9,7,5,10,6,8]+                 , (2, 34)+                 , Just Significant+                 )+               , ( [540,480,600,590,605]+                 , [760,890,1105,595,940]+                 , (2, 23)+                 , Just Significant+                 )+               , ( [19,22,16,29,24]+                 , [20,11,17,12]+                 , (17, 3)+                 , Just NotSignificant+                 )+               , ( [126,148,85,61, 179,93, 45,189,85,93]+                 , [194,128,69,135,171,149,89,248,79,137]+                 , (35,65)+                 , Just NotSignificant+                 )+               , ( [1..30]+                 , [1..30]+                 , (450,450)+                 , Just NotSignificant+                 )+               , ( [1 .. 30]+                 , [11.5 .. 40 ]+                 , (190.0,710.0)+                 , Just Significant+                 )+               ]++wilcoxonSumTests :: [Tst.TestTree]+wilcoxonSumTests = zipWith test [(0::Int)..] testData+  where+    test n (a, b, c) = testCase "Wilcoxon Sum"+                     $ assertEqual ("Wilcoxon Sum " ++ show n) c (wilcoxonRankSums (U.fromList a) (U.fromList b))+    -- List of (Sample A, Sample B, (Positive Rank, Negative Rank))+    testData :: [([Double], [Double], (Double, Double))]+    testData = [ ( [8.50,9.48,8.65,8.16,8.83,7.76,8.63]+                 , [8.27,8.20,8.25,8.14,9.00,8.10,7.20,8.32,7.70]+                 , (75, 61)+                 )+               , ( [0.45,0.50,0.61,0.63,0.75,0.85,0.93]+                 , [0.44,0.45,0.52,0.53,0.56,0.58,0.58,0.65,0.79]+                 , (71.5, 64.5)+                 )+               ]++wilcoxonPairTests :: [Tst.TestTree]+wilcoxonPairTests = zipWith test [(0::Int)..] testData +++  -- Taken from the Mitic paper:+  [ testAssertion "Sig 16, 35" (to4dp 0.0467 $ wilcoxonMatchedPairSignificance 16 35)+  , testAssertion "Sig 16, 36" (to4dp 0.0523 $ wilcoxonMatchedPairSignificance 16 36)+  , testEquality   "Wilcoxon critical values, p=0.05"+      (replicate 4 Nothing ++ map Just [0,2,3,5,8,10,13,17,21,25,30,35,41,47,53,60,67,75,83,91,100,110,119])+      [wilcoxonMatchedPairCriticalValue x (mkPValue 0.05) | x <- [1..27]]+  , testEquality "Wilcoxon critical values, p=0.025"+      (replicate 5 Nothing ++ map Just [0,2,3,5,8,10,13,17,21,25,29,34,40,46,52,58,65,73,81,89,98,107])+      [wilcoxonMatchedPairCriticalValue x (mkPValue 0.025) | x <- [1..27]]+  , testEquality "Wilcoxon critical values, p=0.01"+      (replicate 6 Nothing ++ map Just [0,1,3,5,7,9,12,15,19,23,27,32,37,43,49,55,62,69,76,84,92])+      [wilcoxonMatchedPairCriticalValue x (mkPValue 0.01) | x <- [1..27]]+  , testEquality "Wilcoxon critical values, p=0.005"+      (replicate 7 Nothing ++ map Just [0,1,3,5,7,9,12,15,19,23,27,32,37,42,48,54,61,68,75,83])+      [wilcoxonMatchedPairCriticalValue x (mkPValue 0.005) | x <- [1..27]]+  ]+  where+    test n (a, b, c) = testEquality ("Wilcoxon Paired " ++ show n) c res+      where res = wilcoxonMatchedPairSignedRank (U.zip (U.fromList a) (U.fromList b))++    -- List of (Sample A, Sample B, (Positive Rank, Negative Rank))+    testData :: [([Double], [Double], (Int,Double, Double))]+    testData = [ ([1..10], [1..10], (0, 0, 0     ))+               , ([1..5],  [6..10], (5, 0, 5*(-3)))+               -- Worked example from the Internet:+               , ( [125,115,130,140,140,115,140,125,140,135]+                 , [110,122,125,120,140,124,123,137,135,145]+                 , ( 9+                   , sum $ filter (> 0) [7,-3,1.5,9,0,-4,8,-6,1.5,-5]+                   , sum $ filter (< 0) [7,-3,1.5,9,0,-4,8,-6,1.5,-5]+                   )+                 )+               -- Worked examples from books/papers:+               , ( [2.4,1.9,2.3,1.9,2.4,2.5]+                 , [2.0,2.1,2.0,2.0,1.8,2.0]+                 , (6, 18, -3)+                 )+               , ( [130,170,125,170,130,130,145,160]+                 , [120,163,120,135,143,136,144,120]+                 , (8, 27, -9)+                 )+               , ( [540,580,600,680,430,740,600,690,605,520]+                 , [760,710,1105,880,500,990,1050,640,595,520]+                 , (9, 3, -42)+                 )+               ]+    to4dp tgt (pValue -> x) = x >= tgt - 0.00005 && x < tgt + 0.00005++----------------------------------------------------------------++kruskalWallisRankTests :: [Tst.TestTree]+kruskalWallisRankTests = zipWith test [(0::Int)..] testData+  where+    test n (a, b) = testCase "Kruskal-Wallis Ranking"+                  $ assertEqual ("Kruskal-Wallis " ++ show n) (map U.fromList b) (kruskalWallisRank $ map U.fromList a)+    testData :: [([[Int]],[[Double]])]+    testData = [ ( [ [68,93,123,83,108,122]+                   , [119,116,101,103,113,84]+                   , [70,68,54,73,81,68]+                   , [61,54,59,67,59,70]+                   ]+                 , [ [8.0,14.0,16.0,19.0,23.0,24.0]+                   , [15.0,17.0,18.0,20.0,21.0,22.0]+                   , [1.5,8.0,8.0,10.5,12.0,13.0]+                   , [1.5,3.5,3.5,5.0,6.0,10.5]+                   ]+                 )+               ]++kruskalWallisTests :: [Tst.TestTree]+kruskalWallisTests = zipWith test [(0::Int)..] testData+  where+    test n (a, b, c) = testCase "Kruskal-Wallis" $ do+        assertEqual ("Kruskal-Wallis " ++ show n) (round100 b) (round100 kw)+        assertEqual ("Kruskal-Wallis Sig " ++ show n) c kwt+      where+        kw  = kruskalWallis $ map U.fromList a+        kwt = isSignificant p005 `fmap` kruskalWallisTest (map U.fromList a)+        round100 :: Double -> Integer+        round100 = round . (*100)++    testData :: [([[Double]], Double, Maybe TestResult)]+    testData = [ ( [ [68,93,123,83,108,122]+                   , [119,116,101,103,113,84]+                   , [70,68,54,73,81,68]+                   , [61,54,59,67,59,70]+                   ]+                 , 16.03+                 , Just Significant+                 )+               , ( [ [5,5,3,5,5,5,5]+                   , [5,5,5,5,7,5,5]+                   , [5,5,6,5,5,5,5]+                   , [4,5,5,5,6,5,5]+                   ]+               , 2.24+               , Just NotSignificant+               )+               , ( [ [36,48,5,67,53]+                   , [49,33,60,2,55]+                   , [71,31,140,59,42]+                   ]+                 , 1.22+                 , Just NotSignificant+                 )+               , ( [ [6,38,3,17,11,30,15,16,25,5]+                   , [34,28,42,13,40,31,9,32,39,27]+                   , [13,35,19,4,29,0,7,33,18,24]+                   ]+                 , 6.10+                 , Just Significant+                 )+               ]+++----------------------------------------------------------------+-- K-S test+----------------------------------------------------------------+++kolmogorovSmirnovDTest :: [Tst.TestTree]+kolmogorovSmirnovDTest =+  [ testAssertion "K-S D statistics" $+    and [ eq 1e-6 (kolmogorovSmirnovD standard (toU sample)) reference+        | (reference,sample) <- tableKSD+        ]+  , testAssertion "K-S 2-sample statistics" $+    and [ eq 1e-6 (kolmogorovSmirnov2D (toU xs) (toU ys)) reference+        | (reference,xs,ys) <- tableKS2D+        ]+  , testAssertion "K-S probability" $+    and [ eq 1e-14 (kolmogorovSmirnovProbability n d) p+        | (d,n,p) <- testData+        ]+  ]+  where+    toU = U.fromList+    -- Test data for the calculation of cumulative probability+    -- P(D[n] < d).+    --+    -- Test data is:+    --    (D[n], n, p)+    -- Table is generated using sample program from paper+    testData :: [(Double,Int,Double)]+    testData =+      [ (0.09           ,    3, 0                   )+      , (0.2            ,    3, 0.00177777777777778 )+      , (0.301          ,    3, 0.116357025777778   )+      , (0.392          ,    3, 0.383127210666667   )+      , (0.5003         ,    3, 0.667366306558667   )+      , (0.604          ,    3, 0.861569877333333   )+      , (0.699          ,    3, 0.945458198         )+      , (0.802          ,    3, 0.984475216         )+      , (0.9            ,    3, 0.998               )+      , (0.09           ,    5, 0                   )+      , (0.2            ,    5, 0.0384              )+      , (0.301          ,    5, 0.33993786080016    )+      , (0.392          ,    5, 0.66931908083712    )+      , (0.5003         ,    5, 0.888397260183794   )+      , (0.604          ,    5, 0.971609957879808   )+      , (0.699          ,    5, 0.994331075994008   )+      , (0.802          ,    5, 0.999391366368064   )+      , (0.9            ,    5, 0.99998             )+      , (0.09           ,    8, 3.37615237575e-06   )+      , (0.2            ,    8, 0.151622071801758   )+      , (0.301          ,    8, 0.613891042670582   )+      , (0.392          ,    8, 0.871491561427005   )+      , (0.5003         ,    8, 0.977534089199071   )+      , (0.604          ,    8, 0.997473116268255   )+      , (0.699          ,    8, 0.999806082005123   )+      , (0.802          ,    8, 0.999995133786947   )+      , (0.9            ,    8, 0.99999998          )+      , (0.09           ,   10, 3.89639433093119e-05)+      , (0.2            ,   10, 0.25128096          )+      , (0.301          ,   10, 0.732913126355935   )+      , (0.392          ,   10, 0.932185254518767   )+      , (0.5003         ,   10, 0.992276179340446   )+      , (0.604          ,   10, 0.999495533516769   )+      , (0.699          ,   10, 0.999979691783985   )+      , (0.802          ,   10, 0.999999801409237   )+      , (0.09           ,   20, 0.00794502217168886 )+      , (0.2            ,   20, 0.647279826376584   )+      , (0.301          ,   20, 0.958017466965765   )+      , (0.392          ,   20, 0.997206424843499   )+      , (0.5003         ,   20, 0.999962641414228   )+      , (0.09           ,   30, 0.0498147538075168  )+      , (0.2            ,   30, 0.842030838984526   )+      , (0.301          ,   30, 0.993403560017612   )+      , (0.392          ,   30, 0.99988478803318    )+      , (0.09           ,  100, 0.629367974413669   )+      ]++p005 :: PValue Double+p005 = mkPValue 0.05
+ tests/Tests/NonParametric/Table.hs view
@@ -0,0 +1,39 @@+module Tests.NonParametric.Table (+      tableKSD+    , tableKS2D+    ) where++-- Table for Kolmogorov-Smirnov statistics for standard normal+-- distribution. Generated using R.+--+-- First element of tuple is D second is sample for which it was+-- calculated.+tableKSD :: [(Double,[Double])]+tableKSD =+  [ (0.2012078,[1.360645,-0.3151904,-1.245443,0.1741977,-0.1421206,-1.798246,1.171594,-1.335844,-5.050093e-2,1.030063,-1.849005,0.6491455,-0.7028004])+  , (0.2569956,[0.3884734,-1.227821,-0.4166262,0.429118,-0.9280124,0.8025867,-0.6703089,-0.2124872,0.1224496,0.1087734,-4.285284e-2,-1.039936,-0.7071956])+  , (0.1960356,[-1.814745,-0.6327167,0.7082493,0.6264716,1.02061,-0.4094635,0.821026,-0.4255047,-0.4820728,-0.2239833,0.648517,1.114283,0.3610216])+  , (0.2095746,[0.187011,0.1805498,0.4448389,0.6065506,0.2308673,0.5292549,-1.489902,-1.455191,0.5449396,-0.1436403,-0.7977073,-0.2693545,0.8260888,-1.474473,-2.158696e-2,-0.1455387])+  , (0.1922603,[0.5772317,-1.255561,1.605823,0.4923361,0.2470848,1.176101,-0.3767689,-0.6896885,0.4509345,-0.5048447,0.9436534,1.025599,0.2998393,-3.415219e-2,1.264315,-1.44433,-1.646449e-2])+  , (0.2173401,[1.812807,-0.8687497,-0.5710508,1.003647,1.142621,0.6546577,-6.083323e-3,1.628574e-2,1.067499,-1.953143,-0.6060077,1.90859,-0.7480553,0.6715162,-0.928759,1.862,1.604621,-0.2171044,-0.1835918])+  , (0.2510541,[-0.4769572,1.062319,0.9952284,1.198086,1.015589,-0.4154523,-0.6711762,1.202902,0.2217098,5.381759e-2,0.6679715,0.2551287,-0.1371492])+  , (0.1996022,[1.158607,-0.7354863,1.526559,-0.7855418,-2.82999,-0.6045106,-0.1830228,0.3306812,-0.819657,-1.223715,0.2536423,-0.4155781,1.447042])+  , (0.2284761,[1.239965,0.8187093,0.5199788,1.172072,0.748259,1.869376e-2,0.1625921,-1.712065,0.7043582,-1.702702,-0.4792806,-0.1023351,0.1187189])+  , (0.2337866,[0.9417261,-0.1024297,-0.7354359,1.099991,0.801984,-0.3745397,-1.749564,1.795771,1.099963,-0.605557,-2.035897,1.893603,-0.3468928,-0.2593938,2.100988,0.9665698,0.8757091,0.7696328,0.8730729,-0.3990352,2.04361,-0.4617864,-0.155021,2.15774,0.2687795,-0.9853512,-0.3264898,1.260026,4.267695,-0.5571145,0.6307067,-0.1691405,-1.730686])+  , (0.3389167,[2.025542,-1.542641,-1.090238,3.99027,9.949129e-2,-0.8974433,-2.508418,6.390346,-2.675515,1.154459,1.688072,2.220727,-0.4743102])+  , (0.4920231,[0.5192906,-3.260813,-1.245185,1.693084,3.561318,4.058924,2.27063,0.9446943,4.794159,-3.423733,0.8240817,0.644059,0.900175,1.932513,1.024586,2.82823,2.072192,-0.353231,-0.4319673,1.505952,1.0199,4.555054,2.364929,5.531467,3.279415,3.19821,2.726925,1.680027,-0.9041334,-0.8246765,-1.343979,8.454955,1.354581])+  , (0.6727408,[-6.705672,-3.193988,-4.612611,-3.207994,-5.070172,-6.141169,-0.397149,-4.093359,-1.204801,-3.986585,-2.724662,0.9868107,-6.295266,-5.95839,-6.35114,-1.679555,-2.635889,-4.050329,1.557428,-2.548465,-0.9073924,-1.502018,-4.535688,-4.158818,-8.833434,-5.944697,-1.569672,-4.70399,-7.832059,-4.093708,-8.393417,-2.085432,-7.06495,-0.4230419,-3.046822,-3.23895,-0.9265873,-9.227822,3.293713,-5.593577,-5.942398,-4.358421,2.660044,-4.301572,-1.258879,0.1499903,3.572833,-3.19844,0.8652432,-0.3025793,-1.576673,-7.666265,-6.751463,-1.398944,-2.690656,-1.429654,7.508364e-2,0.7998344,-3.562074,-1.021431,1.342968,2.110244,-7.561497,-2.372083,-3.649193,-5.7723,-1.068083,0.7537809,-4.569546,-1.198005,-5.638384,-1.227226,-1.195852,-1.118175,-9.130527,0.9675821,-2.497391,0.5988562,-1.965783,-4.25741,-6.547006,-1.459294,-2.380556,-3.977307,-7.809006,-4.276819,-4.028746,-9.055546,-3.599239,-1.470512,-8.253329,-1.351687,-4.269324,-6.140353,-6.30808,-1.834091,-3.135146,-9.391791,3.117815,-5.554733,-2.556769,-3.287376,-2.064013,-5.741995,-5.047918,-4.808841,-1.488526,-0.2351115,-5.760833,-2.722929,-7.012353,2.281171,-3.890514,-1.516824,-1.41011,-1.828457,-5.561244,-3.472142,-10.16919,-0.4369042,-5.698953,-4.587462,-4.897086])+  ]++-- Table for 2-sample Kolmogorov-Smirnov statistics. Generated using R+--+-- First element is D, second and third are samples+tableKS2D :: [(Double,[Double],[Double])]+tableKS2D =+  [ (0.2820513,[-0.4212928,2.146532,0.7585263,-0.5086105,-0.7725486,6.235548e-2,-0.1849861,0.861972,-0.1958534,-3.379697e-2,-1.316854,0.6701269],[0.4957582,0.4241167,0.9822869,0.4504248,-0.1749617,1.178098,-1.117222,-0.859273,0.3073736,0.4344583,-0.4761338,-1.332374,1.487291])+  , (0.2820513,[-0.712252,0.7990333,-0.7968473,1.443609,1.163096,-1.349071,-0.1553941,-2.003104,-0.3400618,-0.7019282,0.183293,-0.2352167],[-0.4622455,-0.8132221,0.1161614,-1.472115e-2,1.001454,-6.557789e-2,-0.2531216,-1.032432,0.4105478,1.749614,0.9722899,5.850942e-2,-0.3352746])+  , (0.2564103,[0.3509882,-0.2982833,1.314731,1.264223,-0.8156374,0.3734029,-3.288915e-2,0.6766016,0.9786335,0.1079949,-0.4211722,1.58656],[0.8024675,7.464538e-2,0.2739861,-2.334255e-2,0.5611802,0.6683374,0.4358206,0.349843,1.207834,1.402578,-0.4049183,0.4286042,1.665129])+  , (0.1833333,[1.376196,9.926384e-2,2.199292,-2.04993,0.5585353,-0.4812132,0.1041527,2.084774,0.71194,-1.398245,-4.458574e-2,1.484945,-1.473182,1.020076,-0.7019646,0.2182066,-1.702963,-0.3522622,-0.8129267,-0.6338972],[-1.020371,0.3323861,1.513288,0.1958708,-1.0723,5.323446e-2,-0.9993713,-0.7046356,-0.6781067,-0.4471603,1.512042,-0.2650665,-4.765228e-2,-1.501205,1.228664,0.5332935,-0.2960315,-0.1509683])+  , (0.5666667,[0.7145305,0.1255674,2.001531,0.1419216],[2.113474,-0.3352839,-0.4962429,-1.386079,0.6404667,-0.7145304,0.1084008,-0.9821421,-2.270472,-1.003846,-0.5644588,2.699695,-1.296494,-0.1538839,1.319094,-1.127544,0.3568889,0.2004726,-1.313291,0.3581084,0.3313498,0.9336278,0.9850203,-1.309506,1.170459,-0.7517466,-1.771269,0.7156381,-1.129691,0.877729])+  , (0.5,[0.6950626,0.1643805,-0.3102472,0.4810762,0.1844602,1.338836,-0.8083386,-0.5482141,0.9532421,-0.2644837],[7.527945,-1.95654,1.513725,-1.318431,2.453895,0.2078194,0.7371092,2.834245,-2.134794,3.938259])+  ]
+ tests/Tests/Orphanage.hs view
@@ -0,0 +1,107 @@+{-# 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.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.DiscreteUniform (DiscreteUniform, discreteUniformAB)+import Statistics.Types++import Test.QuickCheck         as QC+++----------------------------------------------------------------+-- 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 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,102 @@+module Tests.Parametric (tests) where++import Data.Maybe (fromJust)+import Statistics.Test.StudentT+import Statistics.Types+import qualified Data.Vector.Unboxed as U+import Test.Tasty (testGroup)+import Tests.Helpers  (testEquality)+import qualified Test.Tasty as Tst++tests :: Tst.TestTree+tests = testGroup "Parametric tests" studentTTests++-- 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 = 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
+ 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,80 @@+-- |+-- Tests for data serialization instances+module Tests.Serialization where++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.Normal         (NormalDistribution)+import Statistics.Distribution.Poisson        (PoissonDistribution)+import Statistics.Distribution.StudentT+import Statistics.Distribution.Transform      (LinearTransform)+import Statistics.Distribution.Uniform        (UniformDistribution)+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 NormalDistribution      )+  , serializationTests (T :: T UniformDistribution     )+  , 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, Show a, Read a, Arbitrary a)+  => T a -> TestTree+serializationTests t = serializationTests' (typeName t) t++-- Not all types are Typeable, unfortunately+serializationTests'+  :: (Eq a, Show a, Read a, Arbitrary a)+  => String -> T a -> TestTree+serializationTests' name t = testGroup ("Tests for: " ++ name)+  [ testProperty "show/read" (p_showRead t)+  ]++++p_showRead :: (Eq a, Read a, Show a) => T a -> a -> Bool+p_showRead _ a = a == (read . show) a
+ tests/Tests/Transform.hs view
@@ -0,0 +1,149 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE ViewPatterns      #-}+module Tests.Transform+    (+      tests+    ) where++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.Tasty (TestTree, testGroup)+import Test.Tasty.QuickCheck (testProperty)+import Test.QuickCheck ( Positive(..), Arbitrary(..), Blind(..), (==>), Gen+                       , choose, vectorOf, counterexample, forAll)+import Test.QuickCheck.Property (Property(..))+import Tests.Helpers (testAssertion)+import Text.Printf (printf)+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Unboxed as U+++tests :: TestTree+tests = testGroup "fft" [+          testProperty "t_impulse"        t_impulse+        , testProperty "t_impulse_offset" t_impulse_offset+        , testProperty "ifft . fft = id"  (t_fftInverse $ ifft . fft)+        , testProperty "fft . ifft = id"  (t_fftInverse $ fft . ifft)+        , testProperty "idct . dct = id [up to scale]"+            (t_fftInverse (\v -> U.map (/ (2 * fromIntegral (U.length v))) $ idct $ dct v))+        , testProperty "dct . idct = id [up to scale]"+            (t_fftInverse (\v -> U.map (/ (2 * fromIntegral (U.length v))) $ idct $ dct v))+          -- Exact small size DCT+          -- 1+        , testDCT [1] $ [2]+          -- 2+        , testDCT [1,0] $ map (*2) [1, cos (pi/4)   ]+        , testDCT [0,1] $ map (*2) [1, cos (3*pi/4) ]+          -- 4+        , testDCT [1,0,0,0] $ map (*2) [1, cos(  pi/8), cos( 2*pi/8), cos( 3*pi/8)]+        , testDCT [0,1,0,0] $ map (*2) [1, cos(3*pi/8), cos( 6*pi/8), cos( 9*pi/8)]+        , testDCT [0,0,1,0] $ map (*2) [1, cos(5*pi/8), cos(10*pi/8), cos(15*pi/8)]+        , testDCT [0,0,0,1] $ map (*2) [1, cos(7*pi/8), cos(14*pi/8), cos(21*pi/8)]+          -- Exact small size IDCT+          -- 1+        , testIDCT [1] [1]+          -- 2+        , testIDCT [1,0]            [1,         1          ]+        , testIDCT [0,1] $ map (*2) [cos(pi/4), cos(3*pi/4)]+          -- 4+        , testIDCT [1,0,0,0]            [1,            1,            1,            1            ]+        , testIDCT [0,1,0,0] $ map (*2) [cos(   pi/8), cos( 3*pi/8), cos( 5*pi/8), cos( 7*pi/8) ]+        , testIDCT [0,0,1,0] $ map (*2) [cos( 2*pi/8), cos( 6*pi/8), cos(10*pi/8), cos(14*pi/8) ]+        , testIDCT [0,0,0,1] $ map (*2) [cos( 3*pi/8), cos( 9*pi/8), cos(15*pi/8), cos(21*pi/8) ]+        ]++-- A single real-valued impulse at the beginning of an otherwise zero+-- vector should be replicated in every real component of the result,+-- and all the imaginary components should be zero.+t_impulse :: Double -> Positive Int -> Bool+t_impulse k (Positive m) = U.all (c_near i) (fft v)+  where v = i `G.cons` G.replicate (n-1) 0+        i = k :+ 0+        n = 1 `shiftL` (m .&. 6)++-- If a real-valued impulse is offset from the beginning of an+-- otherwise zero vector, the sum-of-squares of each component of the+-- result should equal the square of the impulse.+t_impulse_offset :: Double -> Positive Int -> Positive Int -> Property+t_impulse_offset k (Positive x) (Positive m)+  -- For numbers smaller than 1e-162 their square underflows and test+  -- fails spuriously+  = abs k >= 1e-100 ==> U.all ok (fft v)+  where v = G.concat [G.replicate xn 0, G.singleton i, G.replicate (n-xn-1) 0]+        ok (re :+ im) = within ulps (re*re + im*im) (k*k)+        i  = k :+ 0+        xn = x `rem` n+        n  = 1 `shiftL` (m .&. 6)++-- Test that (ifft . fft ≈ id)+--+-- Approximate equality here is tricky. Smaller values of vector tend+-- to have large relative error. Thus we should test that vectors as+-- whole are approximate equal.+t_fftInverse :: (HasNorm (U.Vector a), U.Unbox a, Num a, Show a, Arbitrary a)+             => (U.Vector a -> U.Vector a) -> Property+t_fftInverse roundtrip =+  forAll (Blind <$> genFftVector) $ \(Blind x) ->+    let n  = G.length x+        x' = roundtrip x+        d  = G.zipWith (-) x x'+        nd = vectorNorm d+        nx = vectorNorm x+    in counterexample "Original vector"+     $ counterexample (show x )+     $ counterexample "Transformed one"+     $ counterexample (show x')+     $ counterexample (printf "Length = %i" n)+     $ counterexample (printf "|x - x'| / |x| = %.6g" (nd / nx))+     $ nd <= 3e-14 * nx++-- Test discrete cosine transform+testDCT :: [Double] -> [Double] -> TestTree+testDCT (U.fromList -> vec) (U.fromList -> res)+  = testAssertion ("DCT test for " ++ show vec)+  $ vecEqual 3e-14 (dct vec) res++-- Test inverse discrete cosine transform+testIDCT :: [Double] -> [Double] -> TestTree+testIDCT (U.fromList -> vec) (U.fromList -> res)+  = testAssertion ("IDCT test for " ++ show vec)+  $ vecEqual 3e-14 (idct vec) res++++----------------------------------------------------------------++-- With an error tolerance of 8 ULPs, a million QuickCheck tests are+-- likely to all succeed. With a tolerance of 7, we fail around the+-- half million mark.+ulps :: Int+ulps = 8++c_near :: CD -> CD -> Bool+c_near (a :+ b) (c :+ d) = within ulps a c && within ulps b d++-- Arbitrary vector for FFT od DCT+genFftVector :: (U.Unbox a, Arbitrary a) => Gen (U.Vector a)+genFftVector = do+  n <- (2^)  <$> choose (1,9::Int)    -- Size of vector+  G.fromList <$> vectorOf n arbitrary -- Vector to transform++-- Ad-hoc type class for calculation of vector norm+class HasNorm a where+  vectorNorm :: a -> Double++instance HasNorm (U.Vector Double) where+  vectorNorm = sqrt . sumVector kbn . U.map (\x -> x*x)++instance HasNorm (U.Vector CD) where+  vectorNorm = sqrt . sumVector kbn . U.map (\(x :+ y) -> x*x + y*y)++-- Approximate equality for vectors+vecEqual :: Double -> U.Vector Double -> U.Vector Double -> Bool+vecEqual ε v u+  = vectorNorm (U.zipWith (-) v u) < ε * vectorNorm v
+ tests/tests.hs view
@@ -0,0 +1,26 @@+import Test.Tasty (defaultMain,testGroup)++import qualified Tests.Distribution+import qualified Tests.Function+import qualified Tests.KDE+import qualified Tests.Matrix+import qualified Tests.NonParametric+import qualified Tests.Parametric+import qualified Tests.Transform+import qualified Tests.Correlation+import qualified Tests.Serialization+import qualified Tests.Quantile++main :: IO ()+main = defaultMain $ testGroup "statistics"+  [ Tests.Distribution.tests+  , Tests.Function.tests+  , Tests.KDE.tests+  , Tests.Matrix.tests+  , Tests.NonParametric.tests+  , Tests.Parametric.tests+  , Tests.Transform.tests+  , Tests.Correlation.tests+  , Tests.Serialization.tests+  , Tests.Quantile.tests+  ]
+ tests/utils/Makefile view
@@ -0,0 +1,9 @@+C       = gcc+CFLAGS  = -W -Wall -O2 -std=c99+LDFLAGS = -lfftw3++.PHONY: all clean++all : fftw+clean :+	rm -rf fftw *.o
+ tests/utils/fftw.c view
@@ -0,0 +1,46 @@+/* Generate some test cases using fftw3  */+#include <stdlib.h>+#include <stdio.h>+#include <fftw3.h>++void dump_vector(int n, double* vec) {+    for(int i = 0; i < n; i++)+        printf("%20.15f ", vec[i]);+    printf("\n");+}++void dct(int flag, int n) {+    double* in  = malloc( n * sizeof(double));+    double* out = malloc( n * sizeof(double));+    //+    fftw_plan plan = fftw_plan_r2r_1d(n, in, out, flag, FFTW_ESTIMATE);+    for( int k = 0; k < n; k++) {+        // Init input vector+        for( int i = 0; i < n; i++)+            in[i] = 0;+        in[k] = 1;+        // Perform DFT+        fftw_execute(plan);+        // Print results+        dump_vector(n, in );+        dump_vector(n, out);+        printf("\n");+    }+    //+    free(in);+    free(out);+    fftw_destroy_plan(plan);+}++int main(void)+{+    printf("DCT II (the DCT)\n");+    dct( FFTW_REDFT10, 2);+    dct( FFTW_REDFT10, 4);+    +    printf("DCT III (Inverse DCT)\n");+    dct( FFTW_REDFT01, 2);+    dct( FFTW_REDFT01, 4);+    +    return 0;    +}