{-# LANGUAGE RecursiveDo #-}
module Simulation.Aivika.Trans.Dynamics.Extra
(
initDynamics,
discreteDynamics,
interpolateDynamics,
scanDynamics,
scan1Dynamics) where
import Control.Monad.Fix
import Simulation.Aivika.Trans.Comp
import Simulation.Aivika.Trans.Internal.Specs
import Simulation.Aivika.Trans.Internal.Simulation
import Simulation.Aivika.Trans.Internal.Dynamics
initDynamics :: Dynamics m a -> Dynamics m a
{-# INLINE initDynamics #-}
initDynamics :: forall (m :: * -> *) a. Dynamics m a -> Dynamics m a
initDynamics (Dynamics Point m -> m a
m) =
(Point m -> m a) -> Dynamics m a
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics ((Point m -> m a) -> Dynamics m a)
-> (Point m -> m a) -> Dynamics m a
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
let sc :: Specs m
sc = Point m -> Specs m
forall (m :: * -> *). Point m -> Specs m
pointSpecs Point m
p
in Point m -> m a
m (Point m -> m a) -> Point m -> m a
forall a b. (a -> b) -> a -> b
$ Point m
p { pointTime = basicTime sc 0 0,
pointIteration = 0,
pointPhase = 0 }
discreteDynamics :: Dynamics m a -> Dynamics m a
{-# INLINE discreteDynamics #-}
discreteDynamics :: forall (m :: * -> *) a. Dynamics m a -> Dynamics m a
discreteDynamics (Dynamics Point m -> m a
m) =
(Point m -> m a) -> Dynamics m a
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics ((Point m -> m a) -> Dynamics m a)
-> (Point m -> m a) -> Dynamics m a
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
if Point m -> Int
forall (m :: * -> *). Point m -> Int
pointPhase Point m
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then
Point m -> m a
m Point m
p
else
let sc :: Specs m
sc = Point m -> Specs m
forall (m :: * -> *). Point m -> Specs m
pointSpecs Point m
p
n :: Int
n = Point m -> Int
forall (m :: * -> *). Point m -> Int
pointIteration Point m
p
in Point m -> m a
m (Point m -> m a) -> Point m -> m a
forall a b. (a -> b) -> a -> b
$ Point m
p { pointTime = basicTime sc n 0,
pointPhase = 0 }
interpolateDynamics :: Dynamics m a -> Dynamics m a
{-# INLINE interpolateDynamics #-}
interpolateDynamics :: forall (m :: * -> *) a. Dynamics m a -> Dynamics m a
interpolateDynamics (Dynamics Point m -> m a
m) =
(Point m -> m a) -> Dynamics m a
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics ((Point m -> m a) -> Dynamics m a)
-> (Point m -> m a) -> Dynamics m a
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
if Point m -> Int
forall (m :: * -> *). Point m -> Int
pointPhase Point m
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then
Point m -> m a
m Point m
p
else
let sc :: Specs m
sc = Point m -> Specs m
forall (m :: * -> *). Point m -> Specs m
pointSpecs Point m
p
n :: Int
n = Point m -> Int
forall (m :: * -> *). Point m -> Int
pointIteration Point m
p
in Point m -> m a
m (Point m -> m a) -> Point m -> m a
forall a b. (a -> b) -> a -> b
$ Point m
p { pointTime = basicTime sc n 0,
pointPhase = 0 }
scan1Dynamics :: MonadFix m
=> (a -> a -> a)
-> (Dynamics m a -> Simulation m (Dynamics m a))
-> (Dynamics m a -> Simulation m (Dynamics m a))
{-# INLINABLE scan1Dynamics #-}
scan1Dynamics :: forall (m :: * -> *) a.
MonadFix m =>
(a -> a -> a)
-> (Dynamics m a -> Simulation m (Dynamics m a))
-> Dynamics m a
-> Simulation m (Dynamics m a)
scan1Dynamics a -> a -> a
f Dynamics m a -> Simulation m (Dynamics m a)
tr Dynamics m a
m =
mdo Dynamics m a
y <- Dynamics m a -> Simulation m (Dynamics m a)
tr (Dynamics m a -> Simulation m (Dynamics m a))
-> Dynamics m a -> Simulation m (Dynamics m a)
forall a b. (a -> b) -> a -> b
$ (Point m -> m a) -> Dynamics m a
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics ((Point m -> m a) -> Dynamics m a)
-> (Point m -> m a) -> Dynamics m a
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
case Point m -> Int
forall (m :: * -> *). Point m -> Int
pointIteration Point m
p of
Int
0 ->
Point m -> Dynamics m a -> m a
forall (m :: * -> *) a. Point m -> Dynamics m a -> m a
invokeDynamics Point m
p Dynamics m a
m
Int
n -> do
let sc :: Specs m
sc = Point m -> Specs m
forall (m :: * -> *). Point m -> Specs m
pointSpecs Point m
p
ty :: Double
ty = Specs m -> Int -> Int -> Double
forall (m :: * -> *). Specs m -> Int -> Int -> Double
basicTime Specs m
sc (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
0
py :: Point m
py = Point m
p { pointTime = ty, pointIteration = n - 1, pointPhase = 0 }
a
s <- Point m -> Dynamics m a -> m a
forall (m :: * -> *) a. Point m -> Dynamics m a -> m a
invokeDynamics Point m
py Dynamics m a
y
a
x <- Point m -> Dynamics m a -> m a
forall (m :: * -> *) a. Point m -> Dynamics m a -> m a
invokeDynamics Point m
p Dynamics m a
m
a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$! a -> a -> a
f a
s a
x
Dynamics m a -> Simulation m (Dynamics m a)
forall a. a -> Simulation m a
forall (m :: * -> *) a. Monad m => a -> m a
return Dynamics m a
y
scanDynamics :: MonadFix m
=> (a -> b -> a)
-> a
-> (Dynamics m a -> Simulation m (Dynamics m a))
-> (Dynamics m b -> Simulation m (Dynamics m a))
{-# INLINABLE scanDynamics #-}
scanDynamics :: forall (m :: * -> *) a b.
MonadFix m =>
(a -> b -> a)
-> a
-> (Dynamics m a -> Simulation m (Dynamics m a))
-> Dynamics m b
-> Simulation m (Dynamics m a)
scanDynamics a -> b -> a
f a
acc Dynamics m a -> Simulation m (Dynamics m a)
tr Dynamics m b
m =
mdo Dynamics m a
y <- Dynamics m a -> Simulation m (Dynamics m a)
tr (Dynamics m a -> Simulation m (Dynamics m a))
-> Dynamics m a -> Simulation m (Dynamics m a)
forall a b. (a -> b) -> a -> b
$ (Point m -> m a) -> Dynamics m a
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics ((Point m -> m a) -> Dynamics m a)
-> (Point m -> m a) -> Dynamics m a
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
case Point m -> Int
forall (m :: * -> *). Point m -> Int
pointIteration Point m
p of
Int
0 -> do
b
x <- Point m -> Dynamics m b -> m b
forall (m :: * -> *) a. Point m -> Dynamics m a -> m a
invokeDynamics Point m
p Dynamics m b
m
a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$! a -> b -> a
f a
acc b
x
Int
n -> do
let sc :: Specs m
sc = Point m -> Specs m
forall (m :: * -> *). Point m -> Specs m
pointSpecs Point m
p
ty :: Double
ty = Specs m -> Int -> Int -> Double
forall (m :: * -> *). Specs m -> Int -> Int -> Double
basicTime Specs m
sc (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
0
py :: Point m
py = Point m
p { pointTime = ty, pointIteration = n - 1, pointPhase = 0 }
a
s <- Point m -> Dynamics m a -> m a
forall (m :: * -> *) a. Point m -> Dynamics m a -> m a
invokeDynamics Point m
py Dynamics m a
y
b
x <- Point m -> Dynamics m b -> m b
forall (m :: * -> *) a. Point m -> Dynamics m a -> m a
invokeDynamics Point m
p Dynamics m b
m
a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$! a -> b -> a
f a
s b
x
Dynamics m a -> Simulation m (Dynamics m a)
forall a. a -> Simulation m a
forall (m :: * -> *) a. Monad m => a -> m a
return Dynamics m a
y