{-| This module provides incremental statistics folds based upon the `foldl` library

>>> import Statistics.Incremental
>>> import qualified Control.Foldl as L

    The folds represent incremental statistics such as `moving averages`.

    Statistics are based on exponential-weighting schemes which enable statistics to be calculated in a streaming one-pass manner.  The stream of moving averages with an exponential parameter of 0.1 is:

>>> scan (ma 0.1) [1..10]

or if you just want the moving average at the end.

>>> fold (ma 0.1) [1..10]

-}

module Statistics.Incremental (
  -- * an increment between L.fold steps
    Increment(..)
  , incrementalize
  -- * convenience folds
  , incMa
  , incAbs
  , incSq
  , incStd
  , scan -- move to Foldl
    -- reexporting
  , module Data.Foldable
  , module Control.Foldl
  ) where

import           Control.Applicative ((<$>), (<*>))
import           Control.Foldl (Fold(..))
import           Data.Foldable (Foldable(..))
import qualified Data.Foldable as F

-- | State
data Increment = Increment
   { _adder   :: {-# UNPACK #-} !Double
   , _counter :: {-# UNPACK #-} !Double
   , _rate    :: {-# UNPACK #-} !Double
   } deriving (Show)

{-| takes a function and turns it into a Foldl.Fold where the step incremental is an Increment with a step function iso to a step in an exponential moving average calculation.

>>> incrementalize id

is a moving average of a foldable

>>> incrementalize (*2)

is a moving average of the square of a foldable

This lets you build an exponential standard deviation computation (using Foldl) as

>>> std r = (\s ss -> sqrt (ss - s**2)) <$> incrementalize id r <*> incrementalize (*2) r

An exponential moving average approach (where `average` id abstracted to `function`) represents an efficient single-pass computation that attempts to keep track of a running average of some Foldable.

The rate is the parameter regulating the discount of current state and the introduction of the current value.

>>> incrementalize id 1

tracks the sum/average of an entire Foldable.

>>> incrementalize id 0

produces the latest value (ie current state is discounted to zero)

A exponential moving average with a duration of 10 (the average lag of the values effecting the calculation) is

>>> incrementalize id (1/10)


-}
incrementalize :: (a -> Double) -> Double -> Fold a Double
incrementalize f r =  Fold step (Increment 0 0 r) (\(Increment a c _) -> a / c)
  where
    step (Increment n d r') n' = Increment (r' * n + f n') (r' * d + 1) r'
{-# INLINABLE incrementalize #-}

-- | convenience folds
incMa :: Double -> Fold Double Double
incMa = incrementalize id
{-# INLINABLE incMa #-}

incAbs :: Double -> Fold Double Double
incAbs = incrementalize abs
{-# INLINABLE incAbs #-}

incSq :: Double -> Fold Double Double
incSq = incrementalize (\x -> x*x)
{-# INLINABLE incSq #-}

incStd :: Double -> Fold Double Double
incStd rate = (\s ss -> sqrt (ss - s**2)) <$> incMa rate <*> incSq rate
{-# INLINABLE incStd #-}

-- | Scanning
scan :: (Foldable f) => Fold a b -> f a -> [b]
scan (Fold step begin done) as = F.foldr step' done' as begin'
  where
    step' x k z = k $! (step (head z) x:z)
    done' = map done . reverse
    begin' = [begin]
{-# INLINABLE scan #-}