Copyright | Copyright (c) 20102017 Alexey Khudyakov <alexey.skladnoy@gmail.com> |
---|---|
License | BSD3 |
Maintainer | Alexey Khudyakov <alexey.skladnoy@gmail.com> |
Stability | experimental |
Safe Haskell | None |
Language | Haskell2010 |
Synopsis
- class Monoid m => StatMonoid m a where
- addValue :: m -> a -> m
- singletonMonoid :: a -> m
- reduceSample :: forall m a f. (StatMonoid m a, Foldable f) => f a -> m
- reduceSampleVec :: forall m a v. (StatMonoid m a, Vector v a) => v a -> m
- class CalcCount a where
- class CalcMean a where
- calcMean :: MonadThrow m => a -> m Double
- class CalcMean a => HasMean a where
- class CalcVariance a where
- calcVariance :: MonadThrow m => a -> m Double
- calcVarianceML :: MonadThrow m => a -> m Double
- calcStddev :: MonadThrow m => a -> m Double
- calcStddevML :: MonadThrow m => a -> m Double
- class CalcVariance a => HasVariance a where
- getVariance :: a -> Double
- getVarianceML :: a -> Double
- getStddev :: a -> Double
- getStddevML :: a -> Double
- newtype CalcViaHas a = CalcViaHas a
- newtype Partial a = Partial a
- partial :: HasCallStack => Partial a -> a
- data SampleError
- data Pair a b = Pair !a !b
Monoid Type class and helpers
class Monoid m => StatMonoid m a where Source #
This type class is used to express parallelizable constant space
algorithms for calculation of statistics. Statistic is function
of type [a]→b
which does not depend on order of elements. (for
example: mean, sum, number of elements, variance, etc).
For many statistics it's possible to possible to construct constant space algorithm which is expressed as fold. Additionally it's usually possible to write function which combine state of fold accumulator to get statistic for union of two samples.
Thus for such algorithm we have value which corresponds to empty sample, function which which corresponds to merging of two samples, and single step of fold. Last one allows to evaluate statistic given data sample and first two form a monoid and allow parallelization: split data into parts, build estimate for each by folding and then merge them using mappend.
Instance must satisfy following laws. If floating point arithmetics is used then equality should be understood as approximate.
1. addValue (addValue y mempty) x == addValue mempty x <> addValue mempty y 2. x <> y == y <> x
addValue :: m -> a -> m Source #
Add one element to monoid accumulator. It's step of fold.
singletonMonoid :: a -> m Source #
State of accumulator corresponding to 1-element sample.
Instances
reduceSample :: forall m a f. (StatMonoid m a, Foldable f) => f a -> m Source #
Calculate statistic over Foldable
. It's implemented in terms of
foldl'. Note that in cases when accumulator is immediately
consumed by polymorphic function such as callMeam
its type
becomes ambiguous. TypeApplication
then could be used to
disambiguate.
>>>
reduceSample @Mean [1,2,3,4]
MeanKBN 4 (KBNSum 10.0 0.0)>>>
calcMean $ reduceSample @Mean [1,2,3,4] :: Maybe Double
Just 2.5
reduceSampleVec :: forall m a v. (StatMonoid m a, Vector v a) => v a -> m Source #
Calculate statistic over vector. Works in same was as
reduceSample
but works for vectors.
Ad-hoc type classes for select statistics
Type classes defined here allows to extract common statistics from estimators. it's assumed that quantities in question are already computed so extraction is cheap.
Error handling
Computation of statistics may fail. For example mean is not defined
for an empty sample. Maybe
could be seen as easy way to handle
this situation. But in many cases most convenient way to handle
failure is to throw an exception. So failure is encoded by using
polymorphic function of type MonadThrow m ⇒ a → m X
.
Maybe types has instance, such as Maybe
, Either
SomeException
, IO
and most transformers
wrapping it. Notably this library defines Partial
monad which
allows to convert failures to exception in pure setting.
>>>
calcMean $ reduceSample @Mean []
*** Exception: EmptySample "Data.Monoid.Statistics.Numeric.MeanKBN: calcMean"
>>>
calcMean $ reduceSample @Mean [] :: Maybe Double
Nothing
>>>
import Control.Exception
>>>
calcMean $ reduceSample @Mean [] :: Either SomeException Double
Left (EmptySample "Data.Monoid.Statistics.Numeric.MeanKBN: calcMean")
Last example uses IO
>>>
calcMean $ reduceSample @Mean []
*** Exception: EmptySample "Data.Monoid.Statistics.Numeric.MeanKBN: calcMean"
Deriving instances
Type classes come in two variants, one that allow failure and one
for use in cases when quantity is always defined. This is not the
case for estimators, but true for distributions and intended for
such use cases. In that case CalcViaHas
could be used to derive
necessary instances.
>>>
:{
data NormalDist = NormalDist !Double !Double deriving (CalcMean,CalcVariance) via CalcViaHas NormalDist instance HasMean NormalDist where getMean (NormalDist mu _) = mu instance HasVariance NormalDist where getVariance (NormalDist _ s) = s getVarianceML (NormalDist _ s) = s :}
class CalcCount a where Source #
Value from which we can efficiently extract number of elements in sample it represents.
class CalcMean a where Source #
Value from which we can efficiently calculate mean of sample or distribution.
calcMean :: MonadThrow m => a -> m Double Source #
Assumed O(1) Returns Nothing
if there isn't enough data to
make estimate or distribution doesn't have defined mean.
\[ \bar{x} = \frac{1}{N}\sum_{i=1}^N{x_i} \]
Instances
CalcMean WelfordMean Source # | |
Defined in Data.Monoid.Statistics.Extra calcMean :: MonadThrow m => WelfordMean -> m Double Source # | |
CalcMean MeanKahan Source # | |
Defined in Data.Monoid.Statistics.Extra | |
CalcMean MeanKB2 Source # | |
Defined in Data.Monoid.Statistics.Extra | |
CalcMean Variance Source # | |
Defined in Data.Monoid.Statistics.Numeric | |
CalcMean WMeanKBN Source # | |
Defined in Data.Monoid.Statistics.Numeric | |
CalcMean WMeanNaive Source # | |
Defined in Data.Monoid.Statistics.Numeric calcMean :: MonadThrow m => WMeanNaive -> m Double Source # | |
CalcMean MeanKBN Source # | |
Defined in Data.Monoid.Statistics.Numeric | |
CalcMean MeanNaive Source # | |
Defined in Data.Monoid.Statistics.Numeric | |
HasMean a => CalcMean (CalcViaHas a) Source # | |
Defined in Data.Monoid.Statistics.Class calcMean :: MonadThrow m => CalcViaHas a -> m Double Source # |
class CalcMean a => HasMean a where Source #
Same as CalcMean
but should never fail
Instances
HasMean a => HasMean (CalcViaHas a) Source # | |
Defined in Data.Monoid.Statistics.Class getMean :: CalcViaHas a -> Double Source # |
class CalcVariance a where Source #
Values from which we can efficiently compute estimate of sample variance or distribution variance. It has two methods: one which applies bias correction to estimate and another that returns maximul likelyhood estimate. For distribution they should return same value.
calcVariance :: MonadThrow m => a -> m Double Source #
Assumed O(1) Calculate unbiased estimate of variance:
\[ \sigma^2 = \frac{1}{N-1}\sum_{i=1}^N(x_i - \bar{x})^2 \]
calcVarianceML :: MonadThrow m => a -> m Double Source #
Assumed O(1) Calculate maximum likelihood estimate of variance:
\[ \sigma^2 = \frac{1}{N}\sum_{i=1}^N(x_i - \bar{x})^2 \]
calcStddev :: MonadThrow m => a -> m Double Source #
Calculate sample standard deviation from unbiased estimation of variance.
calcStddevML :: MonadThrow m => a -> m Double Source #
Calculate sample standard deviation from maximum likelihood estimation of variance.
Instances
CalcVariance Variance Source # | |
Defined in Data.Monoid.Statistics.Numeric calcVariance :: MonadThrow m => Variance -> m Double Source # calcVarianceML :: MonadThrow m => Variance -> m Double Source # calcStddev :: MonadThrow m => Variance -> m Double Source # calcStddevML :: MonadThrow m => Variance -> m Double Source # | |
HasVariance a => CalcVariance (CalcViaHas a) Source # | |
Defined in Data.Monoid.Statistics.Class calcVariance :: MonadThrow m => CalcViaHas a -> m Double Source # calcVarianceML :: MonadThrow m => CalcViaHas a -> m Double Source # calcStddev :: MonadThrow m => CalcViaHas a -> m Double Source # calcStddevML :: MonadThrow m => CalcViaHas a -> m Double Source # |
class CalcVariance a => HasVariance a where Source #
Same as CalcVariance
but never fails
getVariance :: a -> Double Source #
getVarianceML :: a -> Double Source #
getStddev :: a -> Double Source #
getStddevML :: a -> Double Source #
Instances
HasVariance a => HasVariance (CalcViaHas a) Source # | |
Defined in Data.Monoid.Statistics.Class getVariance :: CalcViaHas a -> Double Source # getVarianceML :: CalcViaHas a -> Double Source # getStddev :: CalcViaHas a -> Double Source # getStddevML :: CalcViaHas a -> Double Source # |
newtype CalcViaHas a Source #
Instances
HasVariance a => HasVariance (CalcViaHas a) Source # | |
Defined in Data.Monoid.Statistics.Class getVariance :: CalcViaHas a -> Double Source # getVarianceML :: CalcViaHas a -> Double Source # getStddev :: CalcViaHas a -> Double Source # getStddevML :: CalcViaHas a -> Double Source # | |
HasVariance a => CalcVariance (CalcViaHas a) Source # | |
Defined in Data.Monoid.Statistics.Class calcVariance :: MonadThrow m => CalcViaHas a -> m Double Source # calcVarianceML :: MonadThrow m => CalcViaHas a -> m Double Source # calcStddev :: MonadThrow m => CalcViaHas a -> m Double Source # calcStddevML :: MonadThrow m => CalcViaHas a -> m Double Source # | |
HasMean a => HasMean (CalcViaHas a) Source # | |
Defined in Data.Monoid.Statistics.Class getMean :: CalcViaHas a -> Double Source # | |
HasMean a => CalcMean (CalcViaHas a) Source # | |
Defined in Data.Monoid.Statistics.Class calcMean :: MonadThrow m => CalcViaHas a -> m Double Source # |
Exception handling
Identity monad which is used to encode partial functions for
MonadThrow
based error handling. Its MonadThrow
instance
just throws normal exception.
Partial a |
Instances
Monad Partial Source # | |
Functor Partial Source # | |
Applicative Partial Source # | |
MonadThrow Partial Source # | |
Defined in Data.Monoid.Statistics.Class | |
Eq a => Eq (Partial a) Source # | |
Data a => Data (Partial a) Source # | |
Defined in Data.Monoid.Statistics.Class gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Partial a -> c (Partial a) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Partial a) # toConstr :: Partial a -> Constr # dataTypeOf :: Partial a -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Partial a)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Partial a)) # gmapT :: (forall b. Data b => b -> b) -> Partial a -> Partial a # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Partial a -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Partial a -> r # gmapQ :: (forall d. Data d => d -> u) -> Partial a -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Partial a -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Partial a -> m (Partial a) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Partial a -> m (Partial a) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Partial a -> m (Partial a) # | |
Ord a => Ord (Partial a) Source # | |
Defined in Data.Monoid.Statistics.Class | |
Read a => Read (Partial a) Source # | |
Show a => Show (Partial a) Source # | |
Generic (Partial a) Source # | |
type Rep (Partial a) Source # | |
Defined in Data.Monoid.Statistics.Class |
partial :: HasCallStack => Partial a -> a Source #
Convert error to IO exception. This way one could for example convert case when some statistics is not defined to an exception:
>>>
calcMean $ reduceSample @Mean []
*** Exception: EmptySample "Data.Monoid.Statistics.Numeric.MeanKBN: calcMean"
data SampleError Source #
Exception which is thrown when we can't compute some value
EmptySample String |
|
InvalidSample String String |
|
Instances
Show SampleError Source # | |
Defined in Data.Monoid.Statistics.Class showsPrec :: Int -> SampleError -> ShowS # show :: SampleError -> String # showList :: [SampleError] -> ShowS # | |
Exception SampleError Source # | |
Defined in Data.Monoid.Statistics.Class |
Data types
Strict pair. It allows to calculate two statistics in parallel
Pair !a !b |