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

An incremental statsitical fold can be thought of as exponentially-weighting statistics designed to be efficient computations over a Foldable.

Some throat clearing is required, however.

The common usage term \"exponential moving ...\" refers to the cumulative effect
of the fold referencing the original data. From the point of view of a
single step, the algorithm could be better described as \"constant proportion\" or
\"geometric\" decay. Many other methods are also possible and future versions of the library may introduce some more.

A main point of the library is that the traditional simple moving average
uses a sliding window of past data and thus requires keeping track of
the last n elements in State (in a LIFO queue most likey). It may be simple for the human brain but its a more complex and costly computational than this single-pass version.

For clarity, moving average (and moving whatever) below refers to geometric decay
rather than the common usage. So with the throat clearing out of the way:

To avoid clashes, Control.Foldl should be qualified.

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

The folds represent incremental statistics such as moving averages`.

The stream of moving averages with a `rate` of 0.1 is:

>>> L.scan (incMa 0.1) [1..    10]

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

>>> L.fold (incMa 0.1) [1..10]

-}

module Control.Foldl.Incremental (
    -- * incrementalize
    incrementalize
    -- * common incremental folds
  , incMa
  , incAbs
  , incSq
  , incStd
  ) where

import           Control.Applicative ((<$>), (<*>))
import           Control.Foldl (Fold(..))

-- | An Increment is the incremental state within an exponential moving average fold.
data Increment = Increment
   { _adder   :: {-# UNPACK #-} !Double
   , _counter :: {-# UNPACK #-} !Double
   , _rate    :: {-# UNPACK #-} !Double
   } deriving (Show)

{-| Incrementalize takes a function and turns it into a `Control.Foldl.Fold` where the step is an Increment iso to the typical 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

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 (or decays) 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 #-}

-- | moving average fold
incMa :: Double -> Fold Double Double
incMa = incrementalize id
{-# INLINABLE incMa #-}

-- | moving absolute average
incAbs :: Double -> Fold Double Double
incAbs = incrementalize abs
{-# INLINABLE incAbs #-}

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

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