-- | -- 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