module Data.Monoid.Statistics.Numeric (
CountG(..)
, Count
, asCount
, MeanKBN(..)
, asMeanKBN
, WelfordMean(..)
, asWelfordMean
, MeanKahan(..)
, asMeanKahan
, Variance(..)
, asVariance
, Max(..)
, Min(..)
, MaxD(..)
, MinD(..)
, BinomAcc(..)
, asBinomAcc
, CalcCount(..)
, CalcMean(..)
, CalcVariance(..)
, calcStddev
, calcStddevML
) where
import Data.Monoid ((<>))
import Data.Monoid.Statistics.Class
import Data.Data (Typeable,Data)
import Data.Vector.Unboxed (Unbox)
import Data.Vector.Unboxed.Deriving (derivingUnbox)
import Numeric.Sum
import GHC.Generics (Generic)
newtype CountG a = CountG { calcCountN :: a }
deriving (Show,Eq,Ord,Typeable)
type Count = CountG Int
asCount :: CountG a -> CountG a
asCount = id
instance Integral a => Monoid (CountG a) where
mempty = CountG 0
CountG i `mappend` CountG j = CountG (i + j)
instance (Integral a) => StatMonoid (CountG a) b where
singletonMonoid _ = CountG 1
addValue (CountG n) _ = CountG (n + 1)
instance CalcCount (CountG Int) where
calcCount = calcCountN
data MeanKahan = MeanKahan !Int !KahanSum
deriving (Show,Eq,Typeable,Data,Generic)
asMeanKahan :: MeanKahan -> MeanKahan
asMeanKahan = id
instance Monoid MeanKahan where
mempty = MeanKahan 0 mempty
MeanKahan 0 _ `mappend` m = m
m `mappend` MeanKahan 0 _ = m
MeanKahan n1 s1 `mappend` MeanKahan n2 s2 = MeanKahan (n1+n2) (s1<>s2)
instance Real a => StatMonoid MeanKahan a where
addValue (MeanKahan n m) x = MeanKahan (n+1) (addValue m x)
instance CalcCount MeanKahan where
calcCount (MeanKahan n _) = n
instance CalcMean MeanKahan where
calcMean (MeanKahan 0 _) = Nothing
calcMean (MeanKahan n s) = Just (kahan s / fromIntegral n)
data MeanKBN = MeanKBN !Int !KBNSum
deriving (Show,Eq,Typeable,Data,Generic)
asMeanKBN :: MeanKBN -> MeanKBN
asMeanKBN = id
instance Monoid MeanKBN where
mempty = MeanKBN 0 mempty
MeanKBN 0 _ `mappend` m = m
m `mappend` MeanKBN 0 _ = m
MeanKBN n1 s1 `mappend` MeanKBN n2 s2 = MeanKBN (n1+n2) (s1<>s2)
instance Real a => StatMonoid MeanKBN a where
addValue (MeanKBN n m) x = MeanKBN (n+1) (addValue m x)
instance CalcCount MeanKBN where
calcCount (MeanKBN n _) = n
instance CalcMean MeanKBN where
calcMean (MeanKBN 0 _) = Nothing
calcMean (MeanKBN n s) = Just (kbn s / fromIntegral n)
data WelfordMean = WelfordMean !Int
!Double
deriving (Show,Eq,Typeable,Data,Generic)
asWelfordMean :: WelfordMean -> WelfordMean
asWelfordMean = id
instance Monoid WelfordMean where
mempty = WelfordMean 0 0
mappend (WelfordMean 0 _) m = m
mappend m (WelfordMean 0 _) = m
mappend (WelfordMean n x) (WelfordMean k y)
= WelfordMean (n + k) ((x*n' + y*k') / (n' + k'))
where
n' = fromIntegral n
k' = fromIntegral k
instance Real a => StatMonoid WelfordMean a where
addValue (WelfordMean n m) !x
= WelfordMean n' (m + (realToFrac x m) / fromIntegral n')
where
n' = n+1
instance CalcCount WelfordMean where
calcCount (WelfordMean n _) = n
instance CalcMean WelfordMean where
calcMean (WelfordMean 0 _) = Nothing
calcMean (WelfordMean _ m) = Just m
data Variance = Variance !Int
!Double
!Double
deriving (Show,Eq,Typeable)
asVariance :: Variance -> Variance
asVariance = id
instance Monoid Variance where
mempty = Variance 0 0 0
mappend (Variance n1 ta sa) (Variance n2 tb sb)
= Variance (n1+n2) (ta+tb) sumsq
where
na = fromIntegral n1
nb = fromIntegral n2
nom = sqr (ta * nb tb * na)
sumsq | n1 == 0 = sb
| n2 == 0 = sa
| otherwise = sa + sb + nom / ((na + nb) * na * nb)
instance Real a => StatMonoid Variance a where
singletonMonoid x = Variance 1 (realToFrac x) 0
instance CalcCount Variance where
calcCount (Variance n _ _) = n
instance CalcMean Variance where
calcMean (Variance 0 _ _) = Nothing
calcMean (Variance n s _) = Just (s / fromIntegral n)
instance CalcVariance Variance where
calcVariance (Variance n _ s)
| n < 2 = Nothing
| otherwise = Just $! s / fromIntegral (n 1)
calcVarianceML (Variance n _ s)
| n < 1 = Nothing
| otherwise = Just $! s / fromIntegral n
newtype Min a = Min { calcMin :: Maybe a }
deriving (Show,Eq,Ord,Typeable,Data,Generic)
instance Ord a => Monoid (Min a) where
mempty = Min Nothing
Min (Just a) `mappend` Min (Just b) = Min (Just $! min a b)
Min a `mappend` Min Nothing = Min a
Min Nothing `mappend` Min b = Min b
instance (Ord a, a ~ a') => StatMonoid (Min a) a' where
singletonMonoid a = Min (Just a)
newtype Max a = Max { calcMax :: Maybe a }
deriving (Show,Eq,Ord,Typeable,Data,Generic)
instance Ord a => Monoid (Max a) where
mempty = Max Nothing
Max (Just a) `mappend` Max (Just b) = Max (Just $! min a b)
Max a `mappend` Max Nothing = Max a
Max Nothing `mappend` Max b = Max b
instance (Ord a, a ~ a') => StatMonoid (Max a) a' where
singletonMonoid a = Max (Just a)
newtype MinD = MinD { calcMinD :: Double }
deriving (Show,Typeable,Data,Generic)
instance Eq MinD where
MinD a == MinD b
| isNaN a && isNaN b = True
| otherwise = a == b
instance Monoid MinD where
mempty = MinD (0/0)
mappend (MinD x) (MinD y)
| isNaN x = MinD y
| isNaN y = MinD x
| otherwise = MinD (min x y)
instance a ~ Double => StatMonoid MinD a where
singletonMonoid = MinD
newtype MaxD = MaxD { calcMaxD :: Double }
deriving (Show,Typeable,Data,Generic)
instance Eq MaxD where
MaxD a == MaxD b
| isNaN a && isNaN b = True
| otherwise = a == b
instance Monoid MaxD where
mempty = MaxD (0/0)
mappend (MaxD x) (MaxD y)
| isNaN x = MaxD y
| isNaN y = MaxD x
| otherwise = MaxD (max x y)
instance a ~ Double => StatMonoid MaxD a where
singletonMonoid = MaxD
data BinomAcc = BinomAcc { binomAccSuccess :: !Int
, binomAccTotal :: !Int
}
deriving (Show,Eq,Ord,Typeable,Data,Generic)
asBinomAcc :: BinomAcc -> BinomAcc
asBinomAcc = id
instance Monoid BinomAcc where
mempty = BinomAcc 0 0
mappend (BinomAcc n1 m1) (BinomAcc n2 m2) = BinomAcc (n1+n2) (m1+m2)
instance StatMonoid BinomAcc Bool where
addValue (BinomAcc nS nT) True = BinomAcc (nS+1) (nT+1)
addValue (BinomAcc nS nT) False = BinomAcc nS (nT+1)
class CalcCount m where
calcCount :: m -> Int
class CalcMean m where
calcMean :: m -> Maybe Double
class CalcVariance m where
calcVariance :: m -> Maybe Double
calcVarianceML :: m -> Maybe Double
calcStddev :: CalcVariance m => m -> Maybe Double
calcStddev = fmap sqrt . calcVariance
calcStddevML :: CalcVariance m => m -> Maybe Double
calcStddevML = fmap sqrt . calcVarianceML
sqr :: Double -> Double
sqr x = x * x
derivingUnbox "CountG"
[t| forall a. Unbox a => CountG a -> a |]
[| calcCountN |]
[| CountG |]
derivingUnbox "MeanKBN"
[t| MeanKBN -> (Int,Double,Double) |]
[| \(MeanKBN a (KBNSum b c)) -> (a,b,c) |]
[| \(a,b,c) -> MeanKBN a (KBNSum b c) |]
derivingUnbox "WelfordMean"
[t| WelfordMean -> (Int,Double) |]
[| \(WelfordMean a b) -> (a,b) |]
[| \(a,b) -> WelfordMean a b |]
derivingUnbox "Variance"
[t| Variance -> (Int,Double,Double) |]
[| \(Variance a b c) -> (a,b,c) |]
[| \(a,b,c) -> Variance a b c |]
derivingUnbox "MinD"
[t| MinD -> Double |]
[| calcMinD |]
[| MinD |]
derivingUnbox "MaxD"
[t| MaxD -> Double |]
[| calcMaxD |]
[| MaxD |]