{-# LANGUAGE RecursiveDo #-}

-- |
-- Module     : Simulation.Aivika.Transform
-- Copyright  : Copyright (c) 2009-2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 8.0.1
--
-- The module defines something which is most close to the notion of
-- analogous circuit as an opposite to the digital one.
--
module Simulation.Aivika.Transform
       (-- * The Transform Arrow
        Transform(..),
        -- * Delaying the Transform
        delayTransform,
        -- * The Time Transform
        timeTransform,
        -- * Differential and Difference Equations
        integTransform,
        integTransformEither,
        sumTransform,
        sumTransformEither) where

import qualified Control.Category as C
import Control.Arrow
import Control.Monad

import Simulation.Aivika.Simulation
import Simulation.Aivika.Dynamics
import Simulation.Aivika.Dynamics.Memo
import Simulation.Aivika.Unboxed
import Simulation.Aivika.SystemDynamics

-- | It allows representing an analogous circuit as an opposite to
-- the digital one.
--
-- This is a transform of one time varying function to another usually
-- specified in the integration time points and then interpolated in
-- other time points with help of one of the memoization functions
-- like 'memo0Dynamics'.
--
newtype Transform a b =
  Transform { Transform a b -> Dynamics a -> Simulation (Dynamics b)
runTransform :: Dynamics a -> Simulation (Dynamics b)
              -- ^ Run the transform.
            }

instance C.Category Transform where

  id :: Transform a a
id = (Dynamics a -> Simulation (Dynamics a)) -> Transform a a
forall a b.
(Dynamics a -> Simulation (Dynamics b)) -> Transform a b
Transform Dynamics a -> Simulation (Dynamics a)
forall (m :: * -> *) a. Monad m => a -> m a
return
  
  (Transform Dynamics b -> Simulation (Dynamics c)
g) . :: Transform b c -> Transform a b -> Transform a c
. (Transform Dynamics a -> Simulation (Dynamics b)
f) =
    (Dynamics a -> Simulation (Dynamics c)) -> Transform a c
forall a b.
(Dynamics a -> Simulation (Dynamics b)) -> Transform a b
Transform ((Dynamics a -> Simulation (Dynamics c)) -> Transform a c)
-> (Dynamics a -> Simulation (Dynamics c)) -> Transform a c
forall a b. (a -> b) -> a -> b
$ \Dynamics a
a -> Dynamics a -> Simulation (Dynamics b)
f Dynamics a
a Simulation (Dynamics b)
-> (Dynamics b -> Simulation (Dynamics c))
-> Simulation (Dynamics c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Dynamics b -> Simulation (Dynamics c)
g

instance Arrow Transform where

  arr :: (b -> c) -> Transform b c
arr b -> c
f = (Dynamics b -> Simulation (Dynamics c)) -> Transform b c
forall a b.
(Dynamics a -> Simulation (Dynamics b)) -> Transform a b
Transform ((Dynamics b -> Simulation (Dynamics c)) -> Transform b c)
-> (Dynamics b -> Simulation (Dynamics c)) -> Transform b c
forall a b. (a -> b) -> a -> b
$ Dynamics c -> Simulation (Dynamics c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Dynamics c -> Simulation (Dynamics c))
-> (Dynamics b -> Dynamics c)
-> Dynamics b
-> Simulation (Dynamics c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> c) -> Dynamics b -> Dynamics c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
f

  first :: Transform b c -> Transform (b, d) (c, d)
first (Transform Dynamics b -> Simulation (Dynamics c)
f) =
    (Dynamics (b, d) -> Simulation (Dynamics (c, d)))
-> Transform (b, d) (c, d)
forall a b.
(Dynamics a -> Simulation (Dynamics b)) -> Transform a b
Transform ((Dynamics (b, d) -> Simulation (Dynamics (c, d)))
 -> Transform (b, d) (c, d))
-> (Dynamics (b, d) -> Simulation (Dynamics (c, d)))
-> Transform (b, d) (c, d)
forall a b. (a -> b) -> a -> b
$ \Dynamics (b, d)
bd ->
    do (Dynamics b
b, Dynamics d
d) <- Dynamics (b, d) -> Simulation (Dynamics b, Dynamics d)
forall a b. Dynamics (a, b) -> Simulation (Dynamics a, Dynamics b)
unzip0Dynamics Dynamics (b, d)
bd
       Dynamics c
c <- Dynamics b -> Simulation (Dynamics c)
f Dynamics b
b
       Dynamics (c, d) -> Simulation (Dynamics (c, d))
forall (m :: * -> *) a. Monad m => a -> m a
return (Dynamics (c, d) -> Simulation (Dynamics (c, d)))
-> Dynamics (c, d) -> Simulation (Dynamics (c, d))
forall a b. (a -> b) -> a -> b
$ (c -> d -> (c, d)) -> Dynamics c -> Dynamics d -> Dynamics (c, d)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) Dynamics c
c Dynamics d
d 

  second :: Transform b c -> Transform (d, b) (d, c)
second (Transform Dynamics b -> Simulation (Dynamics c)
f) =
    (Dynamics (d, b) -> Simulation (Dynamics (d, c)))
-> Transform (d, b) (d, c)
forall a b.
(Dynamics a -> Simulation (Dynamics b)) -> Transform a b
Transform ((Dynamics (d, b) -> Simulation (Dynamics (d, c)))
 -> Transform (d, b) (d, c))
-> (Dynamics (d, b) -> Simulation (Dynamics (d, c)))
-> Transform (d, b) (d, c)
forall a b. (a -> b) -> a -> b
$ \Dynamics (d, b)
db ->
    do (Dynamics d
d, Dynamics b
b) <- Dynamics (d, b) -> Simulation (Dynamics d, Dynamics b)
forall a b. Dynamics (a, b) -> Simulation (Dynamics a, Dynamics b)
unzip0Dynamics Dynamics (d, b)
db
       Dynamics c
c <- Dynamics b -> Simulation (Dynamics c)
f Dynamics b
b
       Dynamics (d, c) -> Simulation (Dynamics (d, c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Dynamics (d, c) -> Simulation (Dynamics (d, c)))
-> Dynamics (d, c) -> Simulation (Dynamics (d, c))
forall a b. (a -> b) -> a -> b
$ (d -> c -> (d, c)) -> Dynamics d -> Dynamics c -> Dynamics (d, c)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) Dynamics d
d Dynamics c
c

  (Transform Dynamics b -> Simulation (Dynamics c)
f) *** :: Transform b c -> Transform b' c' -> Transform (b, b') (c, c')
*** (Transform Dynamics b' -> Simulation (Dynamics c')
g) =
    (Dynamics (b, b') -> Simulation (Dynamics (c, c')))
-> Transform (b, b') (c, c')
forall a b.
(Dynamics a -> Simulation (Dynamics b)) -> Transform a b
Transform ((Dynamics (b, b') -> Simulation (Dynamics (c, c')))
 -> Transform (b, b') (c, c'))
-> (Dynamics (b, b') -> Simulation (Dynamics (c, c')))
-> Transform (b, b') (c, c')
forall a b. (a -> b) -> a -> b
$ \Dynamics (b, b')
bb' ->
    do (Dynamics b
b, Dynamics b'
b') <- Dynamics (b, b') -> Simulation (Dynamics b, Dynamics b')
forall a b. Dynamics (a, b) -> Simulation (Dynamics a, Dynamics b)
unzip0Dynamics Dynamics (b, b')
bb'
       Dynamics c
c  <- Dynamics b -> Simulation (Dynamics c)
f Dynamics b
b
       Dynamics c'
c' <- Dynamics b' -> Simulation (Dynamics c')
g Dynamics b'
b'
       Dynamics (c, c') -> Simulation (Dynamics (c, c'))
forall (m :: * -> *) a. Monad m => a -> m a
return (Dynamics (c, c') -> Simulation (Dynamics (c, c')))
-> Dynamics (c, c') -> Simulation (Dynamics (c, c'))
forall a b. (a -> b) -> a -> b
$ (c -> c' -> (c, c'))
-> Dynamics c -> Dynamics c' -> Dynamics (c, c')
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) Dynamics c
c Dynamics c'
c'

  (Transform Dynamics b -> Simulation (Dynamics c)
f) &&& :: Transform b c -> Transform b c' -> Transform b (c, c')
&&& (Transform Dynamics b -> Simulation (Dynamics c')
g) =
    (Dynamics b -> Simulation (Dynamics (c, c')))
-> Transform b (c, c')
forall a b.
(Dynamics a -> Simulation (Dynamics b)) -> Transform a b
Transform ((Dynamics b -> Simulation (Dynamics (c, c')))
 -> Transform b (c, c'))
-> (Dynamics b -> Simulation (Dynamics (c, c')))
-> Transform b (c, c')
forall a b. (a -> b) -> a -> b
$ \Dynamics b
b ->
    do Dynamics c
c  <- Dynamics b -> Simulation (Dynamics c)
f Dynamics b
b
       Dynamics c'
c' <- Dynamics b -> Simulation (Dynamics c')
g Dynamics b
b
       Dynamics (c, c') -> Simulation (Dynamics (c, c'))
forall (m :: * -> *) a. Monad m => a -> m a
return (Dynamics (c, c') -> Simulation (Dynamics (c, c')))
-> Dynamics (c, c') -> Simulation (Dynamics (c, c'))
forall a b. (a -> b) -> a -> b
$ (c -> c' -> (c, c'))
-> Dynamics c -> Dynamics c' -> Dynamics (c, c')
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) Dynamics c
c Dynamics c'
c'

-- instance ArrowLoop Transform where
-- 
--   loop (Transform f) =
--     Transform $ \b ->
--     mdo let bd = liftM2 (,) b d
--         cd <- f bd
--         (c, d) <- unzip0Dynamics cd
--         return c

-- | A transform that returns the current modeling time.
timeTransform :: Transform a Double
timeTransform :: Transform a Double
timeTransform = (Dynamics a -> Simulation (Dynamics Double)) -> Transform a Double
forall a b.
(Dynamics a -> Simulation (Dynamics b)) -> Transform a b
Transform ((Dynamics a -> Simulation (Dynamics Double))
 -> Transform a Double)
-> (Dynamics a -> Simulation (Dynamics Double))
-> Transform a Double
forall a b. (a -> b) -> a -> b
$ Simulation (Dynamics Double)
-> Dynamics a -> Simulation (Dynamics Double)
forall a b. a -> b -> a
const (Simulation (Dynamics Double)
 -> Dynamics a -> Simulation (Dynamics Double))
-> Simulation (Dynamics Double)
-> Dynamics a
-> Simulation (Dynamics Double)
forall a b. (a -> b) -> a -> b
$ Dynamics Double -> Simulation (Dynamics Double)
forall (m :: * -> *) a. Monad m => a -> m a
return Dynamics Double
time

-- | Return a delayed transform by the specified lag time and initial value.
--
-- This is actually the 'delayI' function wrapped in the 'Transform' type. 
delayTransform :: Dynamics Double     -- ^ the lag time
                  -> Dynamics a       -- ^ the initial value
                  -> Transform a a    -- ^ the delayed transform
delayTransform :: Dynamics Double -> Dynamics a -> Transform a a
delayTransform Dynamics Double
lagTime Dynamics a
init =
  (Dynamics a -> Simulation (Dynamics a)) -> Transform a a
forall a b.
(Dynamics a -> Simulation (Dynamics b)) -> Transform a b
Transform ((Dynamics a -> Simulation (Dynamics a)) -> Transform a a)
-> (Dynamics a -> Simulation (Dynamics a)) -> Transform a a
forall a b. (a -> b) -> a -> b
$ \Dynamics a
a -> Dynamics a
-> Dynamics Double -> Dynamics a -> Simulation (Dynamics a)
forall a.
Dynamics a
-> Dynamics Double -> Dynamics a -> Simulation (Dynamics a)
delayI Dynamics a
a Dynamics Double
lagTime Dynamics a
init
  
-- | Return a transform that maps the derivative to an integral
-- by the specified initial value.
--
-- This is actually the 'integ' function wrapped in the 'Transform' type. 
integTransform :: Dynamics Double
                  -- ^ the initial value
                  -> Transform Double Double
                  -- ^ map the derivative to an integral
integTransform :: Dynamics Double -> Transform Double Double
integTransform Dynamics Double
init = (Dynamics Double -> Simulation (Dynamics Double))
-> Transform Double Double
forall a b.
(Dynamics a -> Simulation (Dynamics b)) -> Transform a b
Transform ((Dynamics Double -> Simulation (Dynamics Double))
 -> Transform Double Double)
-> (Dynamics Double -> Simulation (Dynamics Double))
-> Transform Double Double
forall a b. (a -> b) -> a -> b
$ \Dynamics Double
diff -> Dynamics Double -> Dynamics Double -> Simulation (Dynamics Double)
integ Dynamics Double
diff Dynamics Double
init
  
-- | Like 'integTransform' but allows either setting a new 'Left' value of the integral,
-- or updating it by the specified 'Right' derivative.
integTransformEither :: Dynamics Double
                        -- ^ the initial value
                        -> Transform (Either Double Double) Double
                        -- ^ map either a new 'Left' value or the 'Right' derivative to an integral
integTransformEither :: Dynamics Double -> Transform (Either Double Double) Double
integTransformEither Dynamics Double
init = (Dynamics (Either Double Double) -> Simulation (Dynamics Double))
-> Transform (Either Double Double) Double
forall a b.
(Dynamics a -> Simulation (Dynamics b)) -> Transform a b
Transform ((Dynamics (Either Double Double) -> Simulation (Dynamics Double))
 -> Transform (Either Double Double) Double)
-> (Dynamics (Either Double Double)
    -> Simulation (Dynamics Double))
-> Transform (Either Double Double) Double
forall a b. (a -> b) -> a -> b
$ \Dynamics (Either Double Double)
diff -> Dynamics (Either Double Double)
-> Dynamics Double -> Simulation (Dynamics Double)
integEither Dynamics (Either Double Double)
diff Dynamics Double
init

-- | Return a transform that maps the difference to a sum
-- by the specified initial value.
--
-- This is actually the 'diffsum' function wrapped in the 'Transform' type. 
sumTransform :: (Num a, Unboxed a)
                => Dynamics a
                -- ^ the initial value
                -> Transform a a
                -- ^ map the difference to a sum
sumTransform :: Dynamics a -> Transform a a
sumTransform Dynamics a
init = (Dynamics a -> Simulation (Dynamics a)) -> Transform a a
forall a b.
(Dynamics a -> Simulation (Dynamics b)) -> Transform a b
Transform ((Dynamics a -> Simulation (Dynamics a)) -> Transform a a)
-> (Dynamics a -> Simulation (Dynamics a)) -> Transform a a
forall a b. (a -> b) -> a -> b
$ \Dynamics a
diff -> Dynamics a -> Dynamics a -> Simulation (Dynamics a)
forall a.
(Num a, Unboxed a) =>
Dynamics a -> Dynamics a -> Simulation (Dynamics a)
diffsum Dynamics a
diff Dynamics a
init

-- | Like 'sumTransform' but allows either setting a new 'Left' value of the sum,
-- or updating it by the specified 'Right' difference.
sumTransformEither :: (Num a, Unboxed a)
                      => Dynamics a
                      -- ^ the initial value
                      -> Transform (Either a a) a
                      -- ^ map either a new 'Left' value or the 'Right' difference to a sum
sumTransformEither :: Dynamics a -> Transform (Either a a) a
sumTransformEither Dynamics a
init = (Dynamics (Either a a) -> Simulation (Dynamics a))
-> Transform (Either a a) a
forall a b.
(Dynamics a -> Simulation (Dynamics b)) -> Transform a b
Transform ((Dynamics (Either a a) -> Simulation (Dynamics a))
 -> Transform (Either a a) a)
-> (Dynamics (Either a a) -> Simulation (Dynamics a))
-> Transform (Either a a) a
forall a b. (a -> b) -> a -> b
$ \Dynamics (Either a a)
diff -> Dynamics (Either a a) -> Dynamics a -> Simulation (Dynamics a)
forall a.
(Num a, Unboxed a) =>
Dynamics (Either a a) -> Dynamics a -> Simulation (Dynamics a)
diffsumEither Dynamics (Either a a)
diff Dynamics a
init