{-# LANGUAGE RecursiveDo #-}

-- |
-- Module     : Simulation.Aivika.Trans.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.Trans.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 Control.Monad.Fix

import Simulation.Aivika.Trans.Simulation
import Simulation.Aivika.Trans.Dynamics
import qualified Simulation.Aivika.Trans.Dynamics.Memo as M
import qualified Simulation.Aivika.Trans.Dynamics.Memo.Unboxed as MU
import Simulation.Aivika.Trans.SystemDynamics
import Simulation.Aivika.Trans.SD

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

instance Monad m => C.Category (Transform m) where

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

instance MonadSD m => Arrow (Transform m) where

  {-# INLINE arr #-}
  arr :: forall b c. (b -> c) -> Transform m b c
arr b -> c
f = forall (m :: * -> *) a b.
(Dynamics m a -> Simulation m (Dynamics m b)) -> Transform m 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

  {-# INLINABLE first #-}
  first :: forall b c d. Transform m b c -> Transform m (b, d) (c, d)
first (Transform Dynamics m b -> Simulation m (Dynamics m c)
f) =
    forall (m :: * -> *) a b.
(Dynamics m a -> Simulation m (Dynamics m b)) -> Transform m a b
Transform forall a b. (a -> b) -> a -> b
$ \Dynamics m (b, d)
bd ->
    do (Dynamics m b
b, Dynamics m d
d) <- forall (m :: * -> *) a b.
MonadMemo m =>
Dynamics m (a, b) -> Simulation m (Dynamics m a, Dynamics m b)
M.unzip0Dynamics Dynamics m (b, d)
bd
       Dynamics m c
c <- Dynamics m b -> Simulation m (Dynamics m c)
f Dynamics m 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 m c
c Dynamics m d
d 

  {-# INLINABLE second #-}
  second :: forall b c d. Transform m b c -> Transform m (d, b) (d, c)
second (Transform Dynamics m b -> Simulation m (Dynamics m c)
f) =
    forall (m :: * -> *) a b.
(Dynamics m a -> Simulation m (Dynamics m b)) -> Transform m a b
Transform forall a b. (a -> b) -> a -> b
$ \Dynamics m (d, b)
db ->
    do (Dynamics m d
d, Dynamics m b
b) <- forall (m :: * -> *) a b.
MonadMemo m =>
Dynamics m (a, b) -> Simulation m (Dynamics m a, Dynamics m b)
M.unzip0Dynamics Dynamics m (d, b)
db
       Dynamics m c
c <- Dynamics m b -> Simulation m (Dynamics m c)
f Dynamics m 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 m d
d Dynamics m c
c

  {-# INLINABLE (***) #-}
  (Transform Dynamics m b -> Simulation m (Dynamics m c)
f) *** :: forall b c b' c'.
Transform m b c -> Transform m b' c' -> Transform m (b, b') (c, c')
*** (Transform Dynamics m b' -> Simulation m (Dynamics m c')
g) =
    forall (m :: * -> *) a b.
(Dynamics m a -> Simulation m (Dynamics m b)) -> Transform m a b
Transform forall a b. (a -> b) -> a -> b
$ \Dynamics m (b, b')
bb' ->
    do (Dynamics m b
b, Dynamics m b'
b') <- forall (m :: * -> *) a b.
MonadMemo m =>
Dynamics m (a, b) -> Simulation m (Dynamics m a, Dynamics m b)
M.unzip0Dynamics Dynamics m (b, b')
bb'
       Dynamics m c
c  <- Dynamics m b -> Simulation m (Dynamics m c)
f Dynamics m b
b
       Dynamics m c'
c' <- Dynamics m b' -> Simulation m (Dynamics m c')
g Dynamics m 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 m c
c Dynamics m c'
c'

  {-# INLINABLE (&&&) #-}
  (Transform Dynamics m b -> Simulation m (Dynamics m c)
f) &&& :: forall b c c'.
Transform m b c -> Transform m b c' -> Transform m b (c, c')
&&& (Transform Dynamics m b -> Simulation m (Dynamics m c')
g) =
    forall (m :: * -> *) a b.
(Dynamics m a -> Simulation m (Dynamics m b)) -> Transform m a b
Transform forall a b. (a -> b) -> a -> b
$ \Dynamics m b
b ->
    do Dynamics m c
c  <- Dynamics m b -> Simulation m (Dynamics m c)
f Dynamics m b
b
       Dynamics m c'
c' <- Dynamics m b -> Simulation m (Dynamics m c')
g Dynamics m 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 m c
c Dynamics m c'
c'

-- instance (MonadSD m, MonadFix m) => ArrowLoop (Transform m) where
-- 
--   {-# INLINABLE loop #-}
--   loop (Transform f) =
--     Transform $ \b ->
--     mdo let bd = liftM2 (,) b d
--         cd <- f bd
--         (c, d) <- M.unzip0Dynamics cd
--         return c

-- | A transform that returns the current modeling time.
timeTransform :: Monad m => Transform m a Double
{-# INLINE timeTransform #-}
timeTransform :: forall (m :: * -> *) a. Monad m => Transform m a Double
timeTransform = forall (m :: * -> *) a b.
(Dynamics m a -> Simulation m (Dynamics m b)) -> Transform m 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 forall (m :: * -> *). Monad m => Dynamics m 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 :: MonadSD m
                  => Dynamics m Double     -- ^ the lag time
                  -> Dynamics m a       -- ^ the initial value
                  -> Transform m a a    -- ^ the delayed transform
{-# INLINE delayTransform #-}
delayTransform :: forall (m :: * -> *) a.
MonadSD m =>
Dynamics m Double -> Dynamics m a -> Transform m a a
delayTransform Dynamics m Double
lagTime Dynamics m a
init =
  forall (m :: * -> *) a b.
(Dynamics m a -> Simulation m (Dynamics m b)) -> Transform m a b
Transform forall a b. (a -> b) -> a -> b
$ \Dynamics m a
a -> forall (m :: * -> *) a.
MonadSD m =>
Dynamics m a
-> Dynamics m Double -> Dynamics m a -> Simulation m (Dynamics m a)
delayI Dynamics m a
a Dynamics m Double
lagTime Dynamics m 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 :: (MonadSD m, MonadFix m)
                  => Dynamics m Double
                  -- ^ the initial value
                  -> Transform m Double Double
                  -- ^ map the derivative to an integral
{-# INLINE integTransform #-}
integTransform :: forall (m :: * -> *).
(MonadSD m, MonadFix m) =>
Dynamics m Double -> Transform m Double Double
integTransform Dynamics m Double
init = forall (m :: * -> *) a b.
(Dynamics m a -> Simulation m (Dynamics m b)) -> Transform m a b
Transform forall a b. (a -> b) -> a -> b
$ \Dynamics m Double
diff -> forall (m :: * -> *).
(MonadSD m, MonadFix m) =>
Dynamics m Double
-> Dynamics m Double -> Simulation m (Dynamics m Double)
integ Dynamics m Double
diff Dynamics m Double
init
  
-- | Like 'integTransform' but allows either setting a new 'Left' value of the integral,
-- or updating it by the specified 'Right' derivative.
integTransformEither :: (MonadSD m, MonadFix m)
                        => Dynamics m Double
                        -- ^ the initial value
                        -> Transform m (Either Double Double) Double
                        -- ^ map either a new 'Left' value or the 'Right' derivative to an integral
{-# INLINE integTransformEither #-}
integTransformEither :: forall (m :: * -> *).
(MonadSD m, MonadFix m) =>
Dynamics m Double -> Transform m (Either Double Double) Double
integTransformEither Dynamics m Double
init = forall (m :: * -> *) a b.
(Dynamics m a -> Simulation m (Dynamics m b)) -> Transform m a b
Transform forall a b. (a -> b) -> a -> b
$ \Dynamics m (Either Double Double)
diff -> forall (m :: * -> *).
(MonadSD m, MonadFix m) =>
Dynamics m (Either Double Double)
-> Dynamics m Double -> Simulation m (Dynamics m Double)
integEither Dynamics m (Either Double Double)
diff Dynamics m 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 :: (MonadSD m, MonadFix m, Num a, MU.MonadMemo m a)
                => Dynamics m a
                -- ^ the initial value
                -> Transform m a a
                -- ^ map the difference to a sum
{-# INLINE sumTransform #-}
sumTransform :: forall (m :: * -> *) a.
(MonadSD m, MonadFix m, Num a, MonadMemo m a) =>
Dynamics m a -> Transform m a a
sumTransform Dynamics m a
init = forall (m :: * -> *) a b.
(Dynamics m a -> Simulation m (Dynamics m b)) -> Transform m a b
Transform forall a b. (a -> b) -> a -> b
$ \Dynamics m a
diff -> forall (m :: * -> *) a.
(MonadSD m, MonadFix m, MonadMemo m a, Num a) =>
Dynamics m a -> Dynamics m a -> Simulation m (Dynamics m a)
diffsum Dynamics m a
diff Dynamics m a
init

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