module Online.Stats (
Averager,
online,
av,
ma,
absma,
sqma,
std,
cov,
corr,
corrGauss,
beta,
alpha,
autocorr
) where
import Protolude
import qualified Control.Foldl as L
import Control.Foldl (Fold(..))
newtype Averager a b = Averager { _averager :: (a, b)}
instance (Monoid a, Monoid b) => Monoid (Averager a b) where
mempty = Averager (mempty, mempty)
mappend (Averager (s,c)) (Averager (s',c')) = Averager (mappend s s', mappend c c')
online :: (Fractional b) => (a -> b) -> (b -> b) -> Fold a b
online f g = Fold step begin extract
where
begin = Averager (0, 0)
step (Averager (s,c)) a = Averager (g $ s+f a,g $ c+1)
extract (Averager (s,c)) = s/c
av :: (Fractional a) => Fold a a
av = Fold step begin extract
where
begin = Averager (0, 0)
step (Averager (s,c)) a = Averager (s+a,c+1)
extract (Averager (s,c)) = s/c
ma :: (Fractional a) => a -> Fold a a
ma r = online identity (* r)
absma :: (Fractional a) => a -> Fold a a
absma r = online abs (* r)
sqma :: (Fractional a) => a -> Fold a a
sqma r = online (\x -> x*x) (* r)
std :: (Floating a) => a -> Fold a a
std r = (\s ss -> sqrt (ss s**2)) <$> ma r <*> sqma r
cov :: (Floating a) => Fold a a -> Fold (a,a) a
cov m =
(\xy x' y' -> xy x' * y') <$>
L.premap (uncurry (*)) m <*>
L.premap fst m <*>
L.premap snd m
corrGauss :: (Floating a) => a -> Fold (a,a) a
corrGauss r = (\cov' stdx stdy -> cov' / (stdx * stdy)) <$> cov (ma r) <*> L.premap fst (std r) <*> L.premap snd (std r)
corr :: (Floating a) => Fold a a -> Fold a a -> Fold (a,a) a
corr central deviation =
(\cov' stdx stdy -> cov' / (stdx * stdy)) <$>
cov central <*>
L.premap fst deviation <*>
L.premap snd deviation
beta :: (Floating a) => Fold a a -> Fold (a,a) a
beta m =
(\xy x' y' x2 -> (xy x'*y')/(x2 x'*x')) <$>
L.premap (uncurry (*)) m <*>
L.premap fst m <*>
L.premap snd m <*>
L.premap (\(x,_) -> x*x) m
alpha :: (Floating a) => Fold a a -> Fold (a,a) a
alpha m =
(\y b x -> y b * x) <$>
L.premap fst m <*> beta m <*> L.premap snd m
autocorr :: (Floating a, RealFloat a) => Fold a a -> Fold (a,a) a -> Fold a a
autocorr central corrf =
case central of
(Fold mStep mBegin mDone) ->
case corrf of
(Fold dStep dBegin dDone) ->
let begin = (mBegin, dBegin)
step (mAcc,dAcc) a = (mStep mAcc a,
if isNaN (mDone mAcc)
then dAcc
else dStep dAcc (mDone mAcc, a))
done = dDone . snd in
Fold step begin done