module Online.Medians
(
Medianer(..)
, onlineL1
, onlineL1'
, maL1
, absmaL1
, covL1
, corrL1
, betaL1
, alphaL1
, autocorrL1
) where
import qualified Control.Foldl as L
import Control.Foldl (Fold(..))
import Protolude
data Medianer a b = Medianer
{ medAbsSum :: a
, medCount :: b
, medianEst :: a
}
onlineL1' ::
(Ord b, Fractional b) => b -> b -> (a -> b) -> (b -> b) -> Fold a (b, b)
onlineL1' i d f g = Fold step begin extract
where
begin = Medianer 0 0 0
step (Medianer s c m) a =
Medianer
(g $ s + abs (f a))
(g $ c + 1)
((1 d) * (m + s' * i * s / c') + d * f a)
where
c' =
if c == 0
then 1
else c
s'
| f a > m = 1
| f a < m = 1
| otherwise = 0
extract (Medianer s c m) = (s / c, m)
onlineL1 :: (Ord b, Fractional b) => b -> b -> (a -> b) -> (b -> b) -> Fold a b
onlineL1 i d f g = snd <$> onlineL1' i d f g
maL1 :: (Ord a, Fractional a) => a -> a -> a -> Fold a a
maL1 i d r = onlineL1 i d identity (* r)
absmaL1 :: (Ord a, Fractional a) => a -> a -> a -> Fold a a
absmaL1 i d r = fst <$> onlineL1' i d identity (* r)
covL1 :: (Ord a, Fractional a) => a -> a -> a -> Fold (a, a) a
covL1 i d r =
(\xy xbar ybar -> xy xbar * ybar) <$> onlineL1 i d (uncurry (*)) (* r) <*>
onlineL1 i d fst (* r) <*>
onlineL1 i d snd (* r)
corrL1 :: (Ord a, Floating a) => a -> a -> a -> Fold (a, a) a
corrL1 i d r =
(\cov' stdx stdy -> cov' / (stdx * stdy)) <$> covL1 i d r <*>
L.premap fst (absmaL1 i d r) <*>
L.premap snd (absmaL1 i d r)
betaL1 :: (Ord a, Floating a) => a -> a -> a -> Fold (a, a) a
betaL1 i d r =
(\xy x' y' x2 -> (xy x' * y') / (x2 x' * x')) <$>
L.premap (uncurry (*)) (maL1 i d r) <*>
L.premap fst (maL1 i d r) <*>
L.premap snd (maL1 i d r) <*>
L.premap (\(x, _) -> x * x) (maL1 i d r)
alphaL1 :: (Ord a, Floating a) => a -> a -> a -> Fold (a, a) a
alphaL1 i d r =
(\y b x -> y b * x) <$> L.premap fst (maL1 i d r) <*> betaL1 i d r <*>
L.premap snd (maL1 i d r)
autocorrL1 :: (Floating a, RealFloat a) => a -> a -> a -> a -> Fold a a
autocorrL1 i d maR corrR =
case maL1 i d maR of
(Fold maStep maBegin maDone) ->
case corrL1 i d corrR of
(Fold corrStep corrBegin corrDone) ->
let begin = (maBegin, corrBegin)
step (maAcc, corrAcc) a =
( maStep maAcc a
, if isNaN (maDone maAcc)
then corrAcc
else corrStep corrAcc (maDone maAcc, a))
done = corrDone . snd
in Fold step begin done