{-# LANGUAGE RecursiveDo #-}
module Simulation.Aivika.Transform
(
Transform(..),
delayTransform,
timeTransform,
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
newtype Transform a b =
Transform { forall a b. Transform a b -> Dynamics a -> Simulation (Dynamics b)
runTransform :: Dynamics a -> Simulation (Dynamics b)
}
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'
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
delayTransform :: Dynamics Double
-> Dynamics a
-> Transform a a
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
integTransform :: Dynamics Double
-> Transform Double Double
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
integTransformEither :: Dynamics Double
-> Transform (Either Double Double) Double
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
sumTransform :: (Num a, Unboxed a)
=> Dynamics a
-> Transform a a
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
sumTransformEither :: (Num a, Unboxed a)
=> Dynamics a
-> Transform (Either a a) a
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