{-# LANGUAGE RecursiveDo #-}
module Simulation.Aivika.Trans.Transform
(
Transform(..),
delayTransform,
timeTransform,
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
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)
}
instance Monad m => C.Category (Transform m) where
{-# INLINE id #-}
id :: forall a. Transform m a a
id = (Dynamics m a -> Simulation m (Dynamics m a)) -> Transform m a a
forall (m :: * -> *) a b.
(Dynamics m a -> Simulation m (Dynamics m b)) -> Transform m a b
Transform Dynamics m a -> Simulation m (Dynamics m a)
forall a. a -> Simulation m a
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) =
(Dynamics m a -> Simulation m (Dynamics m c)) -> Transform m a c
forall (m :: * -> *) a b.
(Dynamics m a -> Simulation m (Dynamics m b)) -> Transform m a b
Transform ((Dynamics m a -> Simulation m (Dynamics m c)) -> Transform m a c)
-> (Dynamics m a -> Simulation m (Dynamics m c)) -> Transform m a c
forall a b. (a -> b) -> a -> b
$ \Dynamics m a
a -> Dynamics m a -> Simulation m (Dynamics m b)
f Dynamics m a
a Simulation m (Dynamics m b)
-> (Dynamics m b -> Simulation m (Dynamics m c))
-> Simulation m (Dynamics m c)
forall a b.
Simulation m a -> (a -> Simulation m b) -> Simulation m b
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 = (Dynamics m b -> Simulation m (Dynamics m c)) -> Transform m b c
forall (m :: * -> *) a b.
(Dynamics m a -> Simulation m (Dynamics m b)) -> Transform m a b
Transform ((Dynamics m b -> Simulation m (Dynamics m c)) -> Transform m b c)
-> (Dynamics m b -> Simulation m (Dynamics m c)) -> Transform m b c
forall a b. (a -> b) -> a -> b
$ Dynamics m c -> Simulation m (Dynamics m c)
forall a. a -> Simulation m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Dynamics m c -> Simulation m (Dynamics m c))
-> (Dynamics m b -> Dynamics m c)
-> Dynamics m b
-> Simulation m (Dynamics m c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> c) -> Dynamics m b -> Dynamics m c
forall a b. (a -> b) -> Dynamics m a -> Dynamics m b
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) =
(Dynamics m (b, d) -> Simulation m (Dynamics m (c, d)))
-> Transform m (b, d) (c, d)
forall (m :: * -> *) a b.
(Dynamics m a -> Simulation m (Dynamics m b)) -> Transform m a b
Transform ((Dynamics m (b, d) -> Simulation m (Dynamics m (c, d)))
-> Transform m (b, d) (c, d))
-> (Dynamics m (b, d) -> Simulation m (Dynamics m (c, d)))
-> Transform m (b, d) (c, d)
forall a b. (a -> b) -> a -> b
$ \Dynamics m (b, d)
bd ->
do (Dynamics m b
b, Dynamics m d
d) <- Dynamics m (b, d) -> Simulation m (Dynamics m b, Dynamics m 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
Dynamics m (c, d) -> Simulation m (Dynamics m (c, d))
forall a. a -> Simulation m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Dynamics m (c, d) -> Simulation m (Dynamics m (c, d)))
-> Dynamics m (c, d) -> Simulation m (Dynamics m (c, d))
forall a b. (a -> b) -> a -> b
$ (c -> d -> (c, d))
-> Dynamics m c -> Dynamics m d -> Dynamics m (c, d)
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) =
(Dynamics m (d, b) -> Simulation m (Dynamics m (d, c)))
-> Transform m (d, b) (d, c)
forall (m :: * -> *) a b.
(Dynamics m a -> Simulation m (Dynamics m b)) -> Transform m a b
Transform ((Dynamics m (d, b) -> Simulation m (Dynamics m (d, c)))
-> Transform m (d, b) (d, c))
-> (Dynamics m (d, b) -> Simulation m (Dynamics m (d, c)))
-> Transform m (d, b) (d, c)
forall a b. (a -> b) -> a -> b
$ \Dynamics m (d, b)
db ->
do (Dynamics m d
d, Dynamics m b
b) <- Dynamics m (d, b) -> Simulation m (Dynamics m d, Dynamics m 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
Dynamics m (d, c) -> Simulation m (Dynamics m (d, c))
forall a. a -> Simulation m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Dynamics m (d, c) -> Simulation m (Dynamics m (d, c)))
-> Dynamics m (d, c) -> Simulation m (Dynamics m (d, c))
forall a b. (a -> b) -> a -> b
$ (d -> c -> (d, c))
-> Dynamics m d -> Dynamics m c -> Dynamics m (d, c)
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) =
(Dynamics m (b, b') -> Simulation m (Dynamics m (c, c')))
-> Transform m (b, b') (c, c')
forall (m :: * -> *) a b.
(Dynamics m a -> Simulation m (Dynamics m b)) -> Transform m a b
Transform ((Dynamics m (b, b') -> Simulation m (Dynamics m (c, c')))
-> Transform m (b, b') (c, c'))
-> (Dynamics m (b, b') -> Simulation m (Dynamics m (c, c')))
-> Transform m (b, b') (c, c')
forall a b. (a -> b) -> a -> b
$ \Dynamics m (b, b')
bb' ->
do (Dynamics m b
b, Dynamics m b'
b') <- Dynamics m (b, b') -> Simulation m (Dynamics m b, Dynamics m 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'
Dynamics m (c, c') -> Simulation m (Dynamics m (c, c'))
forall a. a -> Simulation m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Dynamics m (c, c') -> Simulation m (Dynamics m (c, c')))
-> Dynamics m (c, c') -> Simulation m (Dynamics m (c, c'))
forall a b. (a -> b) -> a -> b
$ (c -> c' -> (c, c'))
-> Dynamics m c -> Dynamics m c' -> Dynamics m (c, c')
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) =
(Dynamics m b -> Simulation m (Dynamics m (c, c')))
-> Transform m b (c, c')
forall (m :: * -> *) a b.
(Dynamics m a -> Simulation m (Dynamics m b)) -> Transform m a b
Transform ((Dynamics m b -> Simulation m (Dynamics m (c, c')))
-> Transform m b (c, c'))
-> (Dynamics m b -> Simulation m (Dynamics m (c, c')))
-> Transform m b (c, c')
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
Dynamics m (c, c') -> Simulation m (Dynamics m (c, c'))
forall a. a -> Simulation m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Dynamics m (c, c') -> Simulation m (Dynamics m (c, c')))
-> Dynamics m (c, c') -> Simulation m (Dynamics m (c, c'))
forall a b. (a -> b) -> a -> b
$ (c -> c' -> (c, c'))
-> Dynamics m c -> Dynamics m c' -> Dynamics m (c, c')
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'
timeTransform :: Monad m => Transform m a Double
{-# INLINE timeTransform #-}
timeTransform :: forall (m :: * -> *) a. Monad m => Transform m a Double
timeTransform = (Dynamics m a -> Simulation m (Dynamics m Double))
-> Transform m a Double
forall (m :: * -> *) a b.
(Dynamics m a -> Simulation m (Dynamics m b)) -> Transform m a b
Transform ((Dynamics m a -> Simulation m (Dynamics m Double))
-> Transform m a Double)
-> (Dynamics m a -> Simulation m (Dynamics m Double))
-> Transform m a Double
forall a b. (a -> b) -> a -> b
$ Simulation m (Dynamics m Double)
-> Dynamics m a -> Simulation m (Dynamics m Double)
forall a b. a -> b -> a
const (Simulation m (Dynamics m Double)
-> Dynamics m a -> Simulation m (Dynamics m Double))
-> Simulation m (Dynamics m Double)
-> Dynamics m a
-> Simulation m (Dynamics m Double)
forall a b. (a -> b) -> a -> b
$ Dynamics m Double -> Simulation m (Dynamics m Double)
forall a. a -> Simulation m a
forall (m :: * -> *) a. Monad m => a -> m a
return Dynamics m Double
forall (m :: * -> *). Monad m => Dynamics m Double
time
delayTransform :: MonadSD m
=> Dynamics m Double
-> Dynamics m a
-> Transform m a a
{-# 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 =
(Dynamics m a -> Simulation m (Dynamics m a)) -> Transform m a a
forall (m :: * -> *) a b.
(Dynamics m a -> Simulation m (Dynamics m b)) -> Transform m a b
Transform ((Dynamics m a -> Simulation m (Dynamics m a)) -> Transform m a a)
-> (Dynamics m a -> Simulation m (Dynamics m a)) -> Transform m a a
forall a b. (a -> b) -> a -> b
$ \Dynamics m a
a -> Dynamics m a
-> Dynamics m Double -> Dynamics m a -> Simulation m (Dynamics m 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
integTransform :: (MonadSD m, MonadFix m)
=> Dynamics m Double
-> Transform m Double Double
{-# INLINE integTransform #-}
integTransform :: forall (m :: * -> *).
(MonadSD m, MonadFix m) =>
Dynamics m Double -> Transform m Double Double
integTransform Dynamics m Double
init = (Dynamics m Double -> Simulation m (Dynamics m Double))
-> Transform m Double Double
forall (m :: * -> *) a b.
(Dynamics m a -> Simulation m (Dynamics m b)) -> Transform m a b
Transform ((Dynamics m Double -> Simulation m (Dynamics m Double))
-> Transform m Double Double)
-> (Dynamics m Double -> Simulation m (Dynamics m Double))
-> Transform m Double Double
forall a b. (a -> b) -> a -> b
$ \Dynamics m Double
diff -> Dynamics m Double
-> Dynamics m Double -> Simulation m (Dynamics m Double)
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
integTransformEither :: (MonadSD m, MonadFix m)
=> Dynamics m Double
-> Transform m (Either Double Double) Double
{-# INLINE integTransformEither #-}
integTransformEither :: forall (m :: * -> *).
(MonadSD m, MonadFix m) =>
Dynamics m Double -> Transform m (Either Double Double) Double
integTransformEither Dynamics m Double
init = (Dynamics m (Either Double Double)
-> Simulation m (Dynamics m Double))
-> Transform m (Either Double Double) Double
forall (m :: * -> *) a b.
(Dynamics m a -> Simulation m (Dynamics m b)) -> Transform m a b
Transform ((Dynamics m (Either Double Double)
-> Simulation m (Dynamics m Double))
-> Transform m (Either Double Double) Double)
-> (Dynamics m (Either Double Double)
-> Simulation m (Dynamics m Double))
-> Transform m (Either Double Double) Double
forall a b. (a -> b) -> a -> b
$ \Dynamics m (Either Double Double)
diff -> Dynamics m (Either Double Double)
-> Dynamics m Double -> Simulation m (Dynamics m Double)
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
sumTransform :: (MonadSD m, MonadFix m, Num a, MU.MonadMemo m a)
=> Dynamics m a
-> Transform m a a
{-# 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 = (Dynamics m a -> Simulation m (Dynamics m a)) -> Transform m a a
forall (m :: * -> *) a b.
(Dynamics m a -> Simulation m (Dynamics m b)) -> Transform m a b
Transform ((Dynamics m a -> Simulation m (Dynamics m a)) -> Transform m a a)
-> (Dynamics m a -> Simulation m (Dynamics m a)) -> Transform m a a
forall a b. (a -> b) -> a -> b
$ \Dynamics m a
diff -> Dynamics m a -> Dynamics m a -> Simulation m (Dynamics m a)
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
sumTransformEither :: (MonadSD m, MonadFix m, Num a, MU.MonadMemo m a)
=> Dynamics m a
-> Transform m (Either a a) a
{-# 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 = (Dynamics m (Either a a) -> Simulation m (Dynamics m a))
-> Transform m (Either a a) a
forall (m :: * -> *) a b.
(Dynamics m a -> Simulation m (Dynamics m b)) -> Transform m a b
Transform ((Dynamics m (Either a a) -> Simulation m (Dynamics m a))
-> Transform m (Either a a) a)
-> (Dynamics m (Either a a) -> Simulation m (Dynamics m a))
-> Transform m (Either a a) a
forall a b. (a -> b) -> a -> b
$ \Dynamics m (Either a a)
diff -> Dynamics m (Either a a)
-> Dynamics m a -> Simulation m (Dynamics m a)
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