{-# LANGUAGE CPP #-}
module Online.Averages
( Averager
, online
, ma
, absma
, sqma
, std
, cov
, corr
, corrGauss
, beta
, alpha
, autocorr
, mconst
) where
import qualified Control.Foldl as L
import Control.Foldl (Fold(..))
import Prelude
newtype Averager a b = Averager
{ _averager :: (a, b)
}
instance (Semigroup a, Semigroup b) => Semigroup (Averager a b) where
(Averager (s, c)) <> (Averager (s', c')) =
Averager (s <> s', c <> c')
instance (Semigroup a, Semigroup b, Monoid a, Monoid b) => Monoid (Averager a b) where
mempty = Averager (mempty, mempty)
mappend = (<>)
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
{-# INLINABLE online #-}
ma :: (Fractional a) => a -> Fold a a
ma r = online id (* r)
{-# INLINABLE ma #-}
absma :: (Fractional a) => a -> Fold a a
absma r = online abs (* r)
{-# INLINABLE absma #-}
sqma :: (Fractional a) => a -> Fold a a
sqma r = online (\x -> x * x) (* r)
{-# INLINABLE sqma #-}
std :: (Fractional a, Floating a) => a -> Fold a a
std r = (\s ss -> sqrt (ss - s ** 2)) <$> ma r <*> sqma r
{-# INLINABLE std #-}
cov :: (Num 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
{-# INLINABLE cov #-}
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)
{-# INLINABLE corrGauss #-}
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
{-# INLINABLE corr #-}
beta :: (Fractional 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
{-# INLINABLE beta #-}
alpha :: (Fractional 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
{-# INLINABLE alpha #-}
autocorr :: (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
{-# INLINABLE autocorr #-}
mconst :: a -> L.Fold a a
mconst a = L.Fold (\() _ -> ()) () (const a)