--------------------------------------------------------------------------------
-- |
-- Module      :  FRP.Yampa.Integration
-- Copyright   :  (c) Antony Courtney and Henrik Nilsson, Yale University, 2003
-- License     :  BSD-style (see the LICENSE file in the distribution)
--
-- Maintainer  :  ivan.perez@keera.co.uk
-- Stability   :  provisional
-- Portability :  non-portable (GHC extensions)
--
-- Integration and derivation of input signals.
--
-- In continuous time, these primitives define SFs that integrate/derive the
-- input signal. Since this is subject to the sampling resolution, simple
-- versions are implemented (like the rectangle rule for the integral).
--
-- In discrete time, all we do is count the number of events.
--
-- The combinator 'iterFrom' gives enough flexibility to program your own
-- leak-free integration and derivation SFs.
--
-- Many primitives and combinators in this module require instances of
-- simple-affine-spaces's 'VectorSpace'. Yampa does not enforce the use of a
-- particular vector space implementation, meaning you could use 'integral' for
-- example with other vector types like V2, V1, etc. from the library linear.
-- For an example, see
-- <https://gist.github.com/walseb/1e0a0ca98aaa9469ab5da04e24f482c2 this gist>.
--------------------------------------------------------------------------------

module FRP.Yampa.Integration (

    -- * Integration
    integral,           -- :: VectorSpace a s => SF a a
    imIntegral,         -- :: VectorSpace a s => a -> SF a a
    impulseIntegral,    -- :: VectorSpace a k => SF (a, Event a) a
    count,              -- :: Integral b => SF (Event a) (Event b)

    -- * Differentiation
    derivative,         -- :: VectorSpace a s => SF a a         -- Crude!
    iterFrom            -- :: (a -> a -> DTime -> b -> b) -> b -> SF a b

) where

import Control.Arrow
import Data.VectorSpace

import FRP.Yampa.Event
import FRP.Yampa.Hybrid
import FRP.Yampa.InternalCore (SF(..), SF'(..), DTime)

------------------------------------------------------------------------------
-- Integration and differentiation
------------------------------------------------------------------------------

-- | Integration using the rectangle rule.
{-# INLINE integral #-}
integral :: VectorSpace a s => SF a a
integral :: SF a a
integral = SF :: forall a b. (a -> Transition a b) -> SF a b
SF {sfTF :: a -> Transition a a
sfTF = a -> Transition a a
forall a. VectorSpace a a => a -> Transition a a
tf0}
    where
        tf0 :: a -> Transition a a
tf0 a
a0 = (a -> a -> SF' a a
forall b a. VectorSpace b a => b -> b -> SF' b b
integralAux a
igrl0 a
a0, a
igrl0)

        igrl0 :: a
igrl0  = a
forall v a. VectorSpace v a => v
zeroVector

        integralAux :: b -> b -> SF' b b
integralAux b
igrl b
a_prev = (DTime -> b -> Transition b b) -> SF' b b
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> b -> Transition b b
forall a a. (VectorSpace b a, Real a) => a -> b -> Transition b b
tf -- True
            where
                tf :: a -> b -> Transition b b
tf a
dt b
a = (b -> b -> SF' b b
integralAux b
igrl' b
a, b
igrl')
                    where
                       igrl' :: b
igrl' = b
igrl b -> b -> b
forall v a. VectorSpace v a => v -> v -> v
^+^ a -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
dt a -> b -> b
forall v a. VectorSpace v a => a -> v -> v
*^ b
a_prev


-- | \"Immediate\" integration (using the function's value at the current time)
imIntegral :: VectorSpace a s => a -> SF a a
imIntegral :: a -> SF a a
imIntegral = ((\ a
_ a
a' DTime
dt a
v -> a
v a -> a -> a
forall v a. VectorSpace v a => v -> v -> v
^+^ DTime -> s
forall a b. (Real a, Fractional b) => a -> b
realToFrac DTime
dt s -> a -> a
forall v a. VectorSpace v a => a -> v -> v
*^ a
a') (a -> a -> DTime -> a -> a) -> a -> SF a a
forall a b. (a -> a -> DTime -> b -> b) -> b -> SF a b
`iterFrom`)

-- | Integrate using an auxiliary function that takes the current and the last
--   input, the time between those samples, and the last output, and returns a
--   new output.
iterFrom :: (a -> a -> DTime -> b -> b) -> b -> SF a b
a -> a -> DTime -> b -> b
f iterFrom :: (a -> a -> DTime -> b -> b) -> b -> SF a b
`iterFrom` b
b = (a -> Transition a b) -> SF a b
forall a b. (a -> Transition a b) -> SF a b
SF (b -> a -> Transition a b
iterAux b
b)
    where
        iterAux :: b -> a -> Transition a b
iterAux b
b a
a = ((DTime -> a -> Transition a b) -> SF' a b
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' (\ DTime
dt a
a' -> b -> a -> Transition a b
iterAux (a -> a -> DTime -> b -> b
f a
a a
a' DTime
dt b
b) a
a'), b
b)

-- | A very crude version of a derivative. It simply divides the
--   value difference by the time difference. Use at your own risk.
derivative :: VectorSpace a s => SF a a
derivative :: SF a a
derivative = SF :: forall a b. (a -> Transition a b) -> SF a b
SF {sfTF :: a -> Transition a a
sfTF = a -> Transition a a
forall b a b a.
(VectorSpace b a, VectorSpace b a) =>
b -> (SF' b b, b)
tf0}
    where
        tf0 :: b -> (SF' b b, b)
tf0 b
a0 = (b -> SF' b b
forall b a. VectorSpace b a => b -> SF' b b
derivativeAux b
a0, b
forall v a. VectorSpace v a => v
zeroVector)

        derivativeAux :: b -> SF' b b
derivativeAux b
a_prev = (DTime -> b -> Transition b b) -> SF' b b
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> b -> Transition b b
forall a a. (VectorSpace b a, Real a) => a -> b -> Transition b b
tf -- True
            where
                tf :: a -> b -> Transition b b
tf a
dt b
a = (b -> SF' b b
derivativeAux b
a, (b
a b -> b -> b
forall v a. VectorSpace v a => v -> v -> v
^-^ b
a_prev) b -> a -> b
forall v a. VectorSpace v a => v -> a -> v
^/ a -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
dt)

-- | Integrate the first input signal and add the /discrete/ accumulation (sum)
--   of the second, discrete, input signal.
impulseIntegral :: VectorSpace a k => SF (a, Event a) a
impulseIntegral :: SF (a, Event a) a
impulseIntegral = (SF a a
forall a s. VectorSpace a s => SF a a
integral SF a a -> SF (Event a) a -> SF (a, Event a) (a, a)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (a -> a -> a) -> a -> SF (Event a) a
forall b a. (b -> a -> b) -> b -> SF (Event a) b
accumHoldBy a -> a -> a
forall v a. VectorSpace v a => v -> v -> v
(^+^) a
forall v a. VectorSpace v a => v
zeroVector) SF (a, Event a) (a, a) -> ((a, a) -> a) -> SF (a, Event a) a
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ (a -> a -> a) -> (a, a) -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> a
forall v a. VectorSpace v a => v -> v -> v
(^+^)

-- | Count the occurrences of input events.
--
-- >>> embed count (deltaEncode 1 [Event 'a', NoEvent, Event 'b'])
-- [Event 1,NoEvent,Event 2]
count :: Integral b => SF (Event a) (Event b)
count :: SF (Event a) (Event b)
count = (b -> a -> b) -> b -> SF (Event a) (Event b)
forall b a. (b -> a -> b) -> b -> SF (Event a) (Event b)
accumBy (\b
n a
_ -> b
n b -> b -> b
forall a. Num a => a -> a -> a
+ b
1) b
0


-- Vim modeline
-- vim:set tabstop=8 expandtab: