-- |
-- Module     : Simulation.Aivika.Trans.Dynamics.Memo
-- 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
--
-- This module defines memo functions. The memoization creates such 'Dynamics'
-- computations, which values are cached in the integration time points. Then
-- these values are interpolated in all other time points.
--

module Simulation.Aivika.Trans.Dynamics.Memo
       (MonadMemo(..),
        unzipDynamics,
        unzip0Dynamics) where

import Control.Monad
import Control.Monad.Trans

import Simulation.Aivika.Trans.Internal.Simulation
import Simulation.Aivika.Trans.Internal.Dynamics

-- | A monad with the support of memoisation.
class Monad m => MonadMemo m where 

  -- | Memoize and order the computation in the integration time points using 
  -- the interpolation that knows of the Runge-Kutta method. The values are
  -- calculated sequentially starting from 'starttime'.
  memoDynamics :: Dynamics m e -> Simulation m (Dynamics m e)

  -- | Memoize and order the computation in the integration time points using 
  -- the 'discreteDynamics' interpolation. It consumes less memory than the 'memoDynamics'
  -- function but it is not aware of the Runge-Kutta method. There is a subtle
  -- difference when we request for values in the intermediate time points
  -- that are used by this method to integrate. In general case you should 
  -- prefer the 'memo0Dynamics' function above 'memoDynamics'.
  memo0Dynamics :: Dynamics m e -> Simulation m (Dynamics m e)

  -- | Iterate sequentially the dynamic process with side effects in 
  -- the integration time points. It is equivalent to a call of the
  -- 'memo0Dynamics' function but significantly more efficient, for the array 
  -- is not created.
  iterateDynamics :: Dynamics m () -> Simulation m (Dynamics m ())

-- | Memoize and unzip the computation of pairs, applying the 'memoDynamics' function.
unzipDynamics :: MonadMemo m => Dynamics m (a, b) -> Simulation m (Dynamics m a, Dynamics m b)
{-# INLINABLE unzipDynamics #-}
unzipDynamics :: forall (m :: * -> *) a b.
MonadMemo m =>
Dynamics m (a, b) -> Simulation m (Dynamics m a, Dynamics m b)
unzipDynamics Dynamics m (a, b)
m =
  (Run m -> m (Dynamics m a, Dynamics m b))
-> Simulation m (Dynamics m a, Dynamics m b)
forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation ((Run m -> m (Dynamics m a, Dynamics m b))
 -> Simulation m (Dynamics m a, Dynamics m b))
-> (Run m -> m (Dynamics m a, Dynamics m b))
-> Simulation m (Dynamics m a, Dynamics m b)
forall a b. (a -> b) -> a -> b
$ \Run m
r ->
  do Dynamics m (a, b)
m' <- Run m -> Simulation m (Dynamics m (a, b)) -> m (Dynamics m (a, b))
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Dynamics m (a, b) -> Simulation m (Dynamics m (a, b))
forall e. Dynamics m e -> Simulation m (Dynamics m e)
forall (m :: * -> *) e.
MonadMemo m =>
Dynamics m e -> Simulation m (Dynamics m e)
memoDynamics Dynamics m (a, b)
m)
     let ma :: Dynamics m a
ma =
           (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 ->
           do (a
a, b
_) <- Point m -> Dynamics m (a, b) -> m (a, b)
forall (m :: * -> *) a. Point m -> Dynamics m a -> m a
invokeDynamics Point m
p Dynamics m (a, b)
m'
              a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
         mb :: Dynamics m b
mb =
           (Point m -> m b) -> Dynamics m b
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics ((Point m -> m b) -> Dynamics m b)
-> (Point m -> m b) -> Dynamics m b
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
           do (a
_, b
b) <- Point m -> Dynamics m (a, b) -> m (a, b)
forall (m :: * -> *) a. Point m -> Dynamics m a -> m a
invokeDynamics Point m
p Dynamics m (a, b)
m'
              b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
     (Dynamics m a, Dynamics m b) -> m (Dynamics m a, Dynamics m b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Dynamics m a
ma, Dynamics m b
mb)

-- | Memoize and unzip the computation of pairs, applying the 'memo0Dynamics' function.
unzip0Dynamics :: MonadMemo m => Dynamics m (a, b) -> Simulation m (Dynamics m a, Dynamics m b)
{-# INLINABLE unzip0Dynamics #-}
unzip0Dynamics :: forall (m :: * -> *) a b.
MonadMemo m =>
Dynamics m (a, b) -> Simulation m (Dynamics m a, Dynamics m b)
unzip0Dynamics Dynamics m (a, b)
m =
  (Run m -> m (Dynamics m a, Dynamics m b))
-> Simulation m (Dynamics m a, Dynamics m b)
forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation ((Run m -> m (Dynamics m a, Dynamics m b))
 -> Simulation m (Dynamics m a, Dynamics m b))
-> (Run m -> m (Dynamics m a, Dynamics m b))
-> Simulation m (Dynamics m a, Dynamics m b)
forall a b. (a -> b) -> a -> b
$ \Run m
r ->
  do Dynamics m (a, b)
m' <- Run m -> Simulation m (Dynamics m (a, b)) -> m (Dynamics m (a, b))
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Dynamics m (a, b) -> Simulation m (Dynamics m (a, b))
forall e. Dynamics m e -> Simulation m (Dynamics m e)
forall (m :: * -> *) e.
MonadMemo m =>
Dynamics m e -> Simulation m (Dynamics m e)
memo0Dynamics Dynamics m (a, b)
m)
     let ma :: Dynamics m a
ma =
           (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 ->
           do (a
a, b
_) <- Point m -> Dynamics m (a, b) -> m (a, b)
forall (m :: * -> *) a. Point m -> Dynamics m a -> m a
invokeDynamics Point m
p Dynamics m (a, b)
m'
              a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
         mb :: Dynamics m b
mb =
           (Point m -> m b) -> Dynamics m b
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics ((Point m -> m b) -> Dynamics m b)
-> (Point m -> m b) -> Dynamics m b
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
           do (a
_, b
b) <- Point m -> Dynamics m (a, b) -> m (a, b)
forall (m :: * -> *) a. Point m -> Dynamics m a -> m a
invokeDynamics Point m
p Dynamics m (a, b)
m'
              b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
     (Dynamics m a, Dynamics m b) -> m (Dynamics m a, Dynamics m b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Dynamics m a
ma, Dynamics m b
mb)