Process.hs

-- |
-- Module      : Control.Auto.Process
-- Description : 'Auto's useful for various commonly occurring processes.
-- Copyright   : (c) Justin Le 2015
-- License     : MIT
-- Maintainer  : justin@jle.im
-- Stability   : unstable
-- Portability : portable
--
-- Various 'Auto's describing relationships following common processes,
-- like 'sumFrom', whose output is the cumulative sum of the input.
--
-- Also has some 'Auto' constructors inspired from digital signal
-- processing signal transformation systems and statistical models.
--
-- Note that all of these can be turned into an equivalent version acting
-- on blip streams, with 'perBlip':
--
-- @
-- 'sumFrom' n           :: 'Num' a => 'Auto' m a a
-- 'perBlip' ('sumFrom' n) :: 'Num' a => 'Auto' m ('Blip' a) ('Blip' a)
-- @
--
module Control.Auto.Process (
  -- * Numerical
    sumFrom
  , sumFrom_
  , sumFromD
  , sumFromD_
  , productFrom
  , productFrom_
  , deltas
  , deltas_
  -- ** Numerical signal transformations/systems
  , movingAverage
  , movingAverage_
  , impulseResponse
  , impulseResponse_
  , autoRegression
  , autoRegression_
  , arma
  , arma_
  -- * Monoidal/Semigroup
  , mappender
  , mappender_
  , mappendFrom
  , mappendFrom_
  ) where

import Control.Auto.Core
import Control.Auto.Interval
import Data.Semigroup
import Data.Serialize

-- | The stream of outputs is the cumulative/running sum of the inputs so
-- far, starting with an initial count.
--
-- The first output takes into account the first input.  See 'sumFromD' for
-- a version where the first output is the initial count itself.
--
-- prop> sumFrom x0 = accum (+) x0
sumFrom :: (Serialize a, Num a)
        => a             -- ^ initial count
        -> Auto m a a
sumFrom = accum (+)

-- | The non-resuming/non-serializing version of 'sumFrom'.
sumFrom_ :: Num a
         => a             -- ^ initial count
         -> Auto m a a
sumFrom_ = accum_ (+)

-- | Like 'sumFrom', except the first output is the starting count.
--
-- >>> let a = sumFromD 5
-- >>> let (y1, a') = stepAuto' a 10
-- >>> y1
-- 5
-- >>> let (y2, _ ) = stepAuto' a' 3
-- >>> y2
-- 10
--
-- >>> streamAuto' (sumFrom 0) [1..10]
-- [1,3,6,10,15,21,28,36,45,55]
-- >>> streamAuto' (sumFromD 0) [1..10]
-- [0,1,3,6,10,15,21,28,36,45]
--
-- It's 'sumFrom', but "delayed".
--
-- Useful for recursive bindings, where you need at least one value to be
-- able to produce its "first output" without depending on anything else.
--
-- prop> sumFromD x0 = sumFrom x0 . delay 0
-- prop> sumFromD x0 = delay x0 . sumFrom x0
sumFromD :: (Serialize a, Num a)
         => a             -- ^ initial count
         -> Auto m a a
sumFromD = accumD (+)

-- | The non-resuming/non-serializing version of 'sumFromD'.
sumFromD_ :: Num a
          => a             -- ^ initial count
          -> Auto m a a
sumFromD_ = accumD_ (+)

-- | The output is the running/cumulative product of all of the inputs so
-- far, starting from an initial product.
--
-- prop> productFrom x0 = accum (*) x0
productFrom :: (Serialize a, Num a)
            => a            -- ^ initial product
            -> Auto m a a
productFrom = accum (*)

-- | The non-resuming/non-serializing version of 'productFrom'.
productFrom_ :: Num a
             => a           -- ^ initial product
             -> Auto m a a
productFrom_ = accum_ (*)

-- | The output is the the difference between the input and the previously
-- received input.
--
-- First result is a 'Nothing', so you can use '<|!>' or 'fromInterval' or
-- 'fromMaybe' to get a "default first value".
--
-- >>> streamAuto' deltas [1,6,3,5,8]
-- >>> [Nothing, Just 5, Just (-3), Just 2, Just 3]
--
-- Usage with '<|!>':
--
-- >>> let a = deltas <|!> pure 100
-- >>> streamAuto' (deltas <|!> pure 100) [1,6,3,5,8]
-- [100, 5, -3, 2, 3]
--
-- Usage with 'fromMaybe':
--
-- >>> streamAuto' (fromMaybe 100 <$> deltas) [1,6,3,5,8]
-- [100, 5, -3, 2, 3]
--
deltas :: (Serialize a, Num a) => Interval m a a
deltas = mkState _deltasF Nothing

-- | The non-resuming/non-serializing version of 'deltas'.
deltas_ :: Num a => Interval m a a
deltas_ = mkState_ _deltasF Nothing

_deltasF :: Num a => a -> Maybe a -> (Maybe a, Maybe a)
_deltasF x s = case s of
                 Nothing   -> (Nothing        , Just x)
                 Just prev -> (Just (x - prev), Just x)

-- | The output is the running/cumulative 'mconcat' of all of the input
-- seen so far, starting with 'mempty'.
--
-- >>> streamauto' mappender . map Last $ [Just 4, Nothing, Just 2, Just 3]
-- [Last (Just 4), Last (Just 4), Last (Just 2), Last (Just 3)]
-- >>> streamAuto' mappender ["hello","world","good","bye"]
-- ["hello","helloworld","helloworldgood","helloworldgoodbye"]
--
-- prop> mappender = accum mappend mempty
mappender :: (Serialize a, Monoid a) => Auto m a a
mappender = accum mappend mempty

-- | The non-resuming/non-serializing version of 'mappender'.
mappender_ :: Monoid a => Auto m a a
mappender_ = accum_ mappend mempty

-- | The output is the running '<>'-sum ('mappend' for 'Semigroup') of all
-- of the input values so far, starting with a given starting value.
-- Basically like 'mappender', but with a starting value.
--
-- >>> streamAuto' (mappendFrom (Max 0)) [Max 4, Max (-2), Max 3, Max 10]
-- [Max 4, Max 4, Max 4, Max 10]
--
-- prop> mappendFrom m0 = accum (<>) m0
mappendFrom :: (Serialize a, Semigroup a)
            => a            -- ^ initial value
            -> Auto m a a
mappendFrom = accum (<>)

-- | The non-resuming/non-serializing version of 'mappender'.
mappendFrom_ :: Semigroup a
             => a           -- ^ initial value
             -> Auto m a a
mappendFrom_ = accum_ (<>)

-- | The output is the sum of the past inputs, multiplied by a moving
-- window of weights.
--
-- For example, if the last received inputs are @[1,2,3,4]@ (from most
-- recent to oldest), and the window of weights is @[2,0.5,4]@, then the
-- output will be @1*2 + 0.5*2 + 4*3@, or @15@.  (The weights are assumed
-- to be zero past the end of the weight window)
--
-- The immediately received input is counted as a part of the history.
--
-- Mathematically,
-- @y_n = w_0 * x_(n-0) + w_1 + x_(n-1) + w_2 * x_(n-1) + ...@, for all
-- @w@s in the weight window, where the first item is @w_0@.  @y_n@ is the
-- @n@th output, and @x_n@ is the @n@th input.
--
-- Note that this serializes the history of the input...or at least the
-- history as far back as the entire window of weights.  (A weight list of
-- five items will serialize the past five received items)  If your weight
-- window is very long (or infinite), then serializing is a bad idea!
--
-- The second parameter is a list of a "starting history", or initial
-- conditions, to be used when the actual input history isn't long enough.
-- If you want all your initial conditions/starting history to be @0@, just
-- pass in @[]@.
--
-- Minus serialization, you can implement 'sumFrom' as:
--
-- @
-- sumFrom n = movingAverage (repeat 1) [n]
-- @
--
-- And you can implement a version of 'deltas' as:
--
-- @
-- deltas = movingAverage [1,-1] []
-- @
--
-- It behaves the same, except the first step outputs the initially
-- received value.  So it's realy a bit like
--
-- @
-- (movingAverage [1,-1] []) == (deltas <|!> id)
-- @
--
-- Where for the first step, the actual input is used instead of the delta.
--
-- Name comes from the statistical model.
--
movingAverage :: (Num a, Serialize a)
              => [a]          -- ^ weights to apply to previous inputs,
                              --     from most recent
              -> [a]          -- ^ starting history/initial conditions
              -> Auto m a a
movingAverage weights = mkState (_movingAverageF weights)

-- | The non-serializing/non-resuming version of 'movingAverage'.
movingAverage_ :: Num a
               => [a]         -- ^ weights to apply to previous inputs,
                              --     from most recent
               -> [a]         -- ^ starting history/initial conditions
               -> Auto m a a
movingAverage_ weights = mkState_ (_movingAverageF weights)

_movingAverageF :: Num a => [a] -> a -> [a] -> (a, [a])
_movingAverageF weights x hist = (sum (zipWith (*) weights hist'), hist')
  where
    hist' = zipWith const (x:hist) weights

-- | Any linear time independent stream transformation can be encoded by
-- the response of the transformation when given @[1,0,0,0...]@, or @1
-- : 'repeat' 0@.  So, given an "LTI" 'Auto', if you feed it @1 : 'repeat'
-- 0@, the output is what is called an "impulse response function".
--
-- For any "LTI" 'Auto', we can reconstruct the behavior of the original
-- 'Auto' given its impulse response.  Give 'impulseResponse' an impulse
-- response, and it will recreate/reconstruct the original 'Auto'.
--
-- >>> let getImpulseResponse a = streamAuto' a (1 : repeat 0)
-- >>> let sumFromImpulseResponse = getImpulseResponse (sumFrom 0)
-- >>> streamAuto' (sumFrom 0) [1..10]
-- [1,3,6,10,15,21,28,36,45,55]
-- >>> streamAuto' (impulseResponse sumFromImpulseResponse) [1..10]
-- [1,3,6,10,15,21,28,36,45,55]
--
-- Use this function to create an LTI system when you know its impulse
-- response.
--
-- >>> take 10 . streamAuto' (impulseResponse (map (2**) [0,-1..])) $ repeat 1
-- [1.0,1.5,1.75,1.875,1.9375,1.96875,1.984375,1.9921875,1.99609375,1.998046875]
--
-- All impulse response after the end of the given list is assumed to be
-- zero.
--
-- Mathematically,
-- @y_n = h_0 * x_(n-0) + h_1 + x_(n-1) + h_2 * x_(n-1) + ...@, for all
-- @h_n@ in the input response, where the first item is @h_0@.
--
-- Note that when this is serialized, it must serialize a number of input
-- elements equal to the length of the impulse response list...so if you give
-- an infinite impulse response, you might want to use 'impulseResponse_',
-- or not serialize.
--
-- By the way, @'impulseResponse' ir == 'movingAverage' ir []@.
--
impulseResponse :: (Num a, Serialize a)
                => [a]        -- ^ the impulse response function
                -> Auto m a a
impulseResponse weights = movingAverage weights []

-- | The non-serializing/non-resuming version of 'impulseResponse'.
impulseResponse_ :: Num a
                 => [a]       -- ^ the impulse response function
                 -> Auto m a a
impulseResponse_ weights = movingAverage_ weights []

-- | The output is the sum of the past outputs, multiplied by a moving
-- window of weights.  Ignores all input.
--
-- For example, if the last outputs are @[1,2,3,4]@ (from most recent to
-- oldest), and the window of weights is @[2,0.5,4]@, then the output will
-- be @1*2 + 0.5*2 + 4*3@, or @15@.  (The weights are assumed to be zero
-- past the end of the weight window)
--
-- Mathematically, @y_n = w_1 * y_(n-1) + w_2 * y_(n-2) + ...@, for all @w@
-- in the weight window, where the first item is @w_1@.
--
-- Note that this serializes the history of the outputs...or at least the
-- history as far back as the entire window of weights.  (A weight list of
-- five items will serialize the past five outputted items)  If your weight
-- window is very long (or infinite), then serializing is a bad idea!
--
-- The second parameter is a list of a "starting history", or initial
-- conditions, to be used when the actual output history isn't long enough.
-- If you want all your initial conditions/starting history to be @0@, just
-- pass in @[]@.
--
-- You can use this to implement any linear recurrence relationship, like
-- he fibonacci sequence:
--
-- >>> evalAutoN' 10 (autoRegression [1,1] [1,1]) ()
-- [2,3,5,8,13,21,34,55,89,144]
-- >>> evalAutoN' 10 (fromList [1,1] --> autoRegression [1,1] [1,1]) ()
-- [1,1,2,3,5,8,13,21,34,55]
--
-- Which is 1 times the previous value, plus one times the value before
-- that.
--
-- You can create a series that doubles by having it be just twice the
-- previous value:
--
-- >>> evalAutoN' 10 (autoRegression [2] [1]) ()
-- [2,,4,8,16,32,64,128,256,512,1024]
--
-- Name comes from the statistical model.
--
autoRegression :: (Num b, Serialize b)
               => [b]         -- ^ weights to apply to previous outputs,
                              --     from most recent
               -> [b]         -- ^ starting history/initial conditions
               -> Auto m a b
autoRegression weights = mkState (const (_autoRegressionF weights))

-- | The non-serializing/non-resuming version of 'autoRegression'.
autoRegression_ :: Num b
                => [b]        -- ^ weights to apply to previous outputs,
                              --     from most recent
                -> [b]        -- ^ starting history/initial conditions
                -> Auto m a b
autoRegression_ weights = mkState_ (const (_autoRegressionF weights))

_autoRegressionF :: Num b => [b] -> [b] -> (b, [b])
_autoRegressionF weights hist = (result, hist')
  where
    result = sum (zipWith (*) weights hist)
    hist'  = zipWith const (result:hist) weights

-- | A combination of 'autoRegression' and 'movingAverage'.  Inspired by
-- the statistical model.
--
-- Mathematically:
--
-- @
-- y_n = wm_0 * x_(n-0) + wm_1 * x_(n-1) + wm_2 * x_(n-2) + ...
--                      + wa_1 * y_(n-1) + wa_2 * y_(n-1) + ...
-- @
--
-- Where @wm_n@s are all of the "moving average" weights, where the first
-- weight is @wm_0@, and @wa_n@s are all of the "autoregression" weights,
-- where the first weight is @wa_1@.
arma :: (Num a, Serialize a)
     => [a]   -- ^ weights for the "auto-regression" components
     -> [a]   -- ^ weights for the "moving average" components
     -> [a]   -- ^ an "initial history" of outputs, recents first
     -> [a]   -- ^ an "initial history" of inputs, recents first
     -> Auto m a a
arma arWeights maWeights arHist maHist =
        mkState (_armaF arWeights maWeights) (arHist, maHist)

-- | The non-serializing/non-resuming version of 'arma'.
arma_ :: Num a
      => [a]  -- ^ weights for the "auto-regression" components
      -> [a]  -- ^ weights for the "moving average" components
      -> [a]  -- ^ an "initial history" of outputs, recents first
      -> [a]  -- ^ an "initial history" of inputs, recents first
      -> Auto m a a
arma_ arWeights maWeights arHist maHist =
        mkState_ (_armaF arWeights maWeights) (arHist, maHist)

_armaF :: Num a => [a] -> [a] -> a -> ([a], [a]) -> (a, ([a], [a]))
_armaF arWeights maWeights x (arHist, maHist) = (y, (arHist', maHist'))
  where
    maHist' = zipWith const (x:maHist) maWeights
    ma      = sum (zipWith (*) maWeights maHist')

    ar      = sum (zipWith (*) arWeights arHist)

    y       = ar + ma

    arHist' = zipWith const (y:arHist) arWeights