{-# 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 { forall a b. Transform a b -> Dynamics a -> Simulation (Dynamics b)
runTransform :: Dynamics a -> Simulation (Dynamics b)
              -- ^ Run the transform.
            }

instance C.Category Transform where

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

instance Arrow Transform where

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

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

  second :: forall b c d. Transform b c -> Transform (d, b) (d, c)
second (Transform Dynamics b -> Simulation (Dynamics c)
f) =
    forall a b.
(Dynamics a -> Simulation (Dynamics b)) -> Transform a b
Transform forall a b. (a -> b) -> a -> b
$ \Dynamics (d, b)
db ->
    do (Dynamics d
d, Dynamics b
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
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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) *** :: forall b c b' c'.
Transform b c -> Transform b' c' -> Transform (b, b') (c, c')
*** (Transform Dynamics b' -> Simulation (Dynamics c')
g) =
    forall a b.
(Dynamics a -> Simulation (Dynamics b)) -> Transform a b
Transform forall a b. (a -> b) -> a -> b
$ \Dynamics (b, b')
bb' ->
    do (Dynamics b
b, Dynamics b'
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'
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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) &&& :: forall b c c'.
Transform b c -> Transform b c' -> Transform b (c, c')
&&& (Transform Dynamics b -> Simulation (Dynamics c')
g) =
    forall a b.
(Dynamics a -> Simulation (Dynamics b)) -> Transform a b
Transform 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
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 :: forall a. Transform a Double
timeTransform = forall a b.
(Dynamics a -> Simulation (Dynamics b)) -> Transform a b
Transform forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ 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 :: forall a. Dynamics Double -> Dynamics a -> Transform a a
delayTransform Dynamics Double
lagTime Dynamics a
init =
  forall a b.
(Dynamics a -> Simulation (Dynamics b)) -> Transform a b
Transform forall a b. (a -> b) -> a -> b
$ \Dynamics a
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 = forall a b.
(Dynamics a -> Simulation (Dynamics b)) -> Transform a b
Transform 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 = forall a b.
(Dynamics a -> Simulation (Dynamics b)) -> Transform a b
Transform 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 :: forall a. (Num a, Unboxed a) => Dynamics a -> Transform a a
sumTransform Dynamics a
init = forall a b.
(Dynamics a -> Simulation (Dynamics b)) -> Transform a b
Transform forall a b. (a -> b) -> a -> b
$ \Dynamics a
diff -> 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 :: forall a.
(Num a, Unboxed a) =>
Dynamics a -> Transform (Either a a) a
sumTransformEither Dynamics a
init = forall a b.
(Dynamics a -> Simulation (Dynamics b)) -> Transform a b
Transform forall a b. (a -> b) -> a -> b
$ \Dynamics (Either a a)
diff -> forall a.
(Num a, Unboxed a) =>
Dynamics (Either a a) -> Dynamics a -> Simulation (Dynamics a)
diffsumEither Dynamics (Either a a)
diff Dynamics a
init