-- |
-- Module     : Simulation.Aivika.Lattice.Estimate
-- Copyright  : Copyright (c) 2016-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 the 'Estimate' monad transformer which is destined for estimating
-- computations within lattice nodes. Such computations are separated from the 'Event'
-- computations. An idea is that the forward-traversing 'Event' computations provide with
-- something that can be observed, while the 'Estimate' computations estimate the received
-- information and they can be backward-traversing.
--
module Simulation.Aivika.Lattice.Estimate
       (-- * Estimate Monad
        Estimate,
        EstimateLift(..),
        runEstimateInStartTime,
        estimateTime,
        -- * Computations within Lattice
        foldEstimate,
        memoEstimate,
        estimateUpSide,
        estimateDownSide,
        estimateFuture,
        shiftEstimate,
        estimateAt,
        -- * Error Handling
        catchEstimate,
        finallyEstimate,
        throwEstimate,
        -- * Debugging
        traceEstimate) where

import Simulation.Aivika.Trans.Internal.Types
import Simulation.Aivika.Trans.Simulation
import Simulation.Aivika.Trans.Parameter
import Simulation.Aivika.Trans.Ref
import Simulation.Aivika.Trans.Observable
import Simulation.Aivika.Lattice.Internal.Estimate
import Simulation.Aivika.Lattice.Internal.LIO
import qualified Simulation.Aivika.Lattice.Internal.Ref as R

-- | Estimate the computation in the lattice nodes.
memoEstimate :: (Estimate LIO a -> Estimate LIO a)
                -- ^ estimate in the intermediate time point of the lattice
                -> Estimate LIO a
                -- ^ estimate in the final time point of the lattice or beyond it
                -> Simulation LIO (Estimate LIO a)
memoEstimate :: (Estimate LIO a -> Estimate LIO a)
-> Estimate LIO a -> Simulation LIO (Estimate LIO a)
memoEstimate Estimate LIO a -> Estimate LIO a
f Estimate LIO a
m =
  do Ref (Maybe a)
r  <- Maybe a -> Simulation LIO (Ref (Maybe a))
forall a. a -> Simulation LIO (Ref a)
R.newRef Maybe a
forall a. Maybe a
Nothing
     Double
t2 <- Parameter LIO Double -> Simulation LIO Double
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
ParameterLift t m =>
Parameter m a -> t m a
liftParameter Parameter LIO Double
forall (m :: * -> *). Monad m => Parameter m Double
stoptime
     let loop :: Estimate LIO a
loop =
           (Point LIO -> LIO a) -> Estimate LIO a
forall (m :: * -> *) a. (Point m -> m a) -> Estimate m a
Estimate ((Point LIO -> LIO a) -> Estimate LIO a)
-> (Point LIO -> LIO a) -> Estimate LIO a
forall a b. (a -> b) -> a -> b
$ \Point LIO
p ->
           do Maybe a
b <- Ref (Maybe a) -> LIO (Maybe a)
forall a. Ref a -> LIO a
R.readRef0 Ref (Maybe a)
r
              case Maybe a
b of
                Just a
a  -> a -> LIO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
                Maybe a
Nothing ->
                  if Point LIO -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point LIO
p Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
t2
                  then do a
a <- Point LIO -> Estimate LIO a -> LIO a
forall (m :: * -> *) a. Point m -> Estimate m a -> m a
invokeEstimate Point LIO
p Estimate LIO a
m
                          Ref (Maybe a) -> Maybe a -> LIO ()
forall a. Ref a -> a -> LIO ()
R.writeRef0 Ref (Maybe a)
r (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
                          a -> LIO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
                  else do a
a <- Point LIO -> Estimate LIO a -> LIO a
forall (m :: * -> *) a. Point m -> Estimate m a -> m a
invokeEstimate Point LIO
p (Estimate LIO a -> Estimate LIO a
f Estimate LIO a
loop)
                          Ref (Maybe a) -> Maybe a -> LIO ()
forall a. Ref a -> a -> LIO ()
R.writeRef0 Ref (Maybe a)
r (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
                          a -> LIO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
     Estimate LIO a -> Simulation LIO (Estimate LIO a)
forall (m :: * -> *) a. Monad m => a -> m a
return Estimate LIO a
loop

-- | Estimate the computation in the up side node of the lattice,
-- where 'latticeTimeIndex' is increased by 1 but 'latticeMemberIndex' remains the same.
--
-- It is merely equivalent to the following definition:
--
-- @estimateUpSide = shiftEstimate 1 0@
--
estimateUpSide :: Estimate LIO a -> Estimate LIO a
estimateUpSide :: Estimate LIO a -> Estimate LIO a
estimateUpSide Estimate LIO a
m =
  (Point LIO -> LIO a) -> Estimate LIO a
forall (m :: * -> *) a. (Point m -> m a) -> Estimate m a
Estimate ((Point LIO -> LIO a) -> Estimate LIO a)
-> (Point LIO -> LIO a) -> Estimate LIO a
forall a b. (a -> b) -> a -> b
$ \Point LIO
p ->
  (LIOParams -> IO a) -> LIO a
forall a. (LIOParams -> IO a) -> LIO a
LIO ((LIOParams -> IO a) -> LIO a) -> (LIOParams -> IO a) -> LIO a
forall a b. (a -> b) -> a -> b
$ \LIOParams
ps ->
  do let ps' :: LIOParams
ps' = LIOParams -> LIOParams
upSideLIOParams LIOParams
ps
         r :: Run LIO
r   = Point LIO -> Run LIO
forall (m :: * -> *). Point m -> Run m
pointRun Point LIO
p
     Point LIO
p' <- LIOParams -> LIO (Point LIO) -> IO (Point LIO)
forall a. LIOParams -> LIO a -> IO a
invokeLIO LIOParams
ps' (LIO (Point LIO) -> IO (Point LIO))
-> LIO (Point LIO) -> IO (Point LIO)
forall a b. (a -> b) -> a -> b
$
           Run LIO -> Parameter LIO (Point LIO) -> LIO (Point LIO)
forall (m :: * -> *) a. Run m -> Parameter m a -> m a
invokeParameter Run LIO
r
           Parameter LIO (Point LIO)
latticePoint
     LIOParams -> LIO a -> IO a
forall a. LIOParams -> LIO a -> IO a
invokeLIO LIOParams
ps' (LIO a -> IO a) -> LIO a -> IO a
forall a b. (a -> b) -> a -> b
$
       Point LIO -> Estimate LIO a -> LIO a
forall (m :: * -> *) a. Point m -> Estimate m a -> m a
invokeEstimate Point LIO
p' Estimate LIO a
m

-- | Estimate the computation in the down side node of the lattice,
-- where the both 'latticeTimeIndex' and 'latticeMemberIndex' are increased by 1.
--
-- It is merely equivalent to the following definition:
--
-- @estimateDownSide = shiftEstimate 1 1@
--
estimateDownSide :: Estimate LIO a -> Estimate LIO a
estimateDownSide :: Estimate LIO a -> Estimate LIO a
estimateDownSide Estimate LIO a
m =
  (Point LIO -> LIO a) -> Estimate LIO a
forall (m :: * -> *) a. (Point m -> m a) -> Estimate m a
Estimate ((Point LIO -> LIO a) -> Estimate LIO a)
-> (Point LIO -> LIO a) -> Estimate LIO a
forall a b. (a -> b) -> a -> b
$ \Point LIO
p ->
  (LIOParams -> IO a) -> LIO a
forall a. (LIOParams -> IO a) -> LIO a
LIO ((LIOParams -> IO a) -> LIO a) -> (LIOParams -> IO a) -> LIO a
forall a b. (a -> b) -> a -> b
$ \LIOParams
ps ->
  do let ps' :: LIOParams
ps' = LIOParams -> LIOParams
downSideLIOParams LIOParams
ps
         r :: Run LIO
r   = Point LIO -> Run LIO
forall (m :: * -> *). Point m -> Run m
pointRun Point LIO
p
     Point LIO
p' <- LIOParams -> LIO (Point LIO) -> IO (Point LIO)
forall a. LIOParams -> LIO a -> IO a
invokeLIO LIOParams
ps' (LIO (Point LIO) -> IO (Point LIO))
-> LIO (Point LIO) -> IO (Point LIO)
forall a b. (a -> b) -> a -> b
$
           Run LIO -> Parameter LIO (Point LIO) -> LIO (Point LIO)
forall (m :: * -> *) a. Run m -> Parameter m a -> m a
invokeParameter Run LIO
r
           Parameter LIO (Point LIO)
latticePoint
     LIOParams -> LIO a -> IO a
forall a. LIOParams -> LIO a -> IO a
invokeLIO LIOParams
ps' (LIO a -> IO a) -> LIO a -> IO a
forall a b. (a -> b) -> a -> b
$
       Point LIO -> Estimate LIO a -> LIO a
forall (m :: * -> *) a. Point m -> Estimate m a -> m a
invokeEstimate Point LIO
p' Estimate LIO a
m

-- | Estimate the computation in the shifted lattice node, where the first parameter
-- specifies the 'latticeTimeIndex' shift of any sign, but the second parameter
-- specifies the 'latticeMemberIndex' shift af any sign too.
--
-- It allows looking into the future or past computations. The lattice is constructed in such a way
-- that we can define the past 'Estimate' computation in terms of the future @Estimate@
-- computation. That is the point.
--
-- Regarding the 'Event' computation, it is quite different. The future @Event@ computation
-- depends strongly on the past @Event@ computations. But we can update 'Ref' references within
-- the corresponding discrete event simulation and then read them within the @Estimate@
-- computation, because @Ref@ is 'Observable'.
shiftEstimate :: Int
                 -- ^ a shift of the lattice time index
                 -> Int
                 -- ^ a shift of the lattice member index
                 -> Estimate LIO a
                 -- ^ the source computation
                 -> Estimate LIO a
shiftEstimate :: Int -> Int -> Estimate LIO a -> Estimate LIO a
shiftEstimate Int
di Int
dk Estimate LIO a
m =
  (Point LIO -> LIO a) -> Estimate LIO a
forall (m :: * -> *) a. (Point m -> m a) -> Estimate m a
Estimate ((Point LIO -> LIO a) -> Estimate LIO a)
-> (Point LIO -> LIO a) -> Estimate LIO a
forall a b. (a -> b) -> a -> b
$ \Point LIO
p ->
  (LIOParams -> IO a) -> LIO a
forall a. (LIOParams -> IO a) -> LIO a
LIO ((LIOParams -> IO a) -> LIO a) -> (LIOParams -> IO a) -> LIO a
forall a b. (a -> b) -> a -> b
$ \LIOParams
ps ->
  do let ps' :: LIOParams
ps' = Int -> Int -> LIOParams -> LIOParams
shiftLIOParams Int
di Int
dk LIOParams
ps
         r :: Run LIO
r   = Point LIO -> Run LIO
forall (m :: * -> *). Point m -> Run m
pointRun Point LIO
p
     Point LIO
p' <- LIOParams -> LIO (Point LIO) -> IO (Point LIO)
forall a. LIOParams -> LIO a -> IO a
invokeLIO LIOParams
ps' (LIO (Point LIO) -> IO (Point LIO))
-> LIO (Point LIO) -> IO (Point LIO)
forall a b. (a -> b) -> a -> b
$
           Run LIO -> Parameter LIO (Point LIO) -> LIO (Point LIO)
forall (m :: * -> *) a. Run m -> Parameter m a -> m a
invokeParameter Run LIO
r
           Parameter LIO (Point LIO)
latticePoint
     LIOParams -> LIO a -> IO a
forall a. LIOParams -> LIO a -> IO a
invokeLIO LIOParams
ps' (LIO a -> IO a) -> LIO a -> IO a
forall a b. (a -> b) -> a -> b
$
       Point LIO -> Estimate LIO a -> LIO a
forall (m :: * -> *) a. Point m -> Estimate m a -> m a
invokeEstimate Point LIO
p' Estimate LIO a
m

-- | Like 'shiftEstimate' but only the first argument must be possitive.
estimateFuture :: Int
                  -- ^ a positive shift of the lattice time index
                  -> Int
                  -- ^ a shift of the lattice member index
                  -> Estimate LIO a
                  -- ^ the source computation
                  -> Estimate LIO a
estimateFuture :: Int -> Int -> Estimate LIO a -> Estimate LIO a
estimateFuture Int
di Int
dk Estimate LIO a
m
  | Int
di Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0   = [Char] -> Estimate LIO a
forall a. HasCallStack => [Char] -> a
error [Char]
"Expected to see a positive time index shift: estimateFuture"
  | Bool
otherwise = Int -> Int -> Estimate LIO a -> Estimate LIO a
forall a. Int -> Int -> Estimate LIO a -> Estimate LIO a
shiftEstimate Int
di Int
dk Estimate LIO a
m

-- | Estimate the computation at the specified 'latticeTimeIndex' and 'latticeMemberIndex'.
estimateAt :: Int
              -- ^ the lattice time index
              -> Int
              -- ^ the lattice member index
              -> Estimate LIO a
              -- ^ the computation
              -> Estimate LIO a
estimateAt :: Int -> Int -> Estimate LIO a -> Estimate LIO a
estimateAt Int
i Int
k Estimate LIO a
m =
  (Point LIO -> LIO a) -> Estimate LIO a
forall (m :: * -> *) a. (Point m -> m a) -> Estimate m a
Estimate ((Point LIO -> LIO a) -> Estimate LIO a)
-> (Point LIO -> LIO a) -> Estimate LIO a
forall a b. (a -> b) -> a -> b
$ \Point LIO
p ->
  (LIOParams -> IO a) -> LIO a
forall a. (LIOParams -> IO a) -> LIO a
LIO ((LIOParams -> IO a) -> LIO a) -> (LIOParams -> IO a) -> LIO a
forall a b. (a -> b) -> a -> b
$ \LIOParams
ps ->
  do let ps' :: LIOParams
ps' = Int -> Int -> LIOParams -> LIOParams
lioParamsAt Int
i Int
k LIOParams
ps
         r :: Run LIO
r   = Point LIO -> Run LIO
forall (m :: * -> *). Point m -> Run m
pointRun Point LIO
p
     Point LIO
p' <- LIOParams -> LIO (Point LIO) -> IO (Point LIO)
forall a. LIOParams -> LIO a -> IO a
invokeLIO LIOParams
ps' (LIO (Point LIO) -> IO (Point LIO))
-> LIO (Point LIO) -> IO (Point LIO)
forall a b. (a -> b) -> a -> b
$
           Run LIO -> Parameter LIO (Point LIO) -> LIO (Point LIO)
forall (m :: * -> *) a. Run m -> Parameter m a -> m a
invokeParameter Run LIO
r
           Parameter LIO (Point LIO)
latticePoint
     LIOParams -> LIO a -> IO a
forall a. LIOParams -> LIO a -> IO a
invokeLIO LIOParams
ps' (LIO a -> IO a) -> LIO a -> IO a
forall a b. (a -> b) -> a -> b
$
       Point LIO -> Estimate LIO a -> LIO a
forall (m :: * -> *) a. Point m -> Estimate m a -> m a
invokeEstimate Point LIO
p' Estimate LIO a
m

-- | Fold the estimation of the specified computation.
foldEstimate :: (a -> a -> Estimate LIO a)
                -- ^ reduce in the intermediate nodes of the lattice
                -> Estimate LIO a
                -- ^ estimate the computation in the final time point and beyond it
                -> Simulation LIO (Estimate LIO a)
foldEstimate :: (a -> a -> Estimate LIO a)
-> Estimate LIO a -> Simulation LIO (Estimate LIO a)
foldEstimate a -> a -> Estimate LIO a
f = (Estimate LIO a -> Estimate LIO a)
-> Estimate LIO a -> Simulation LIO (Estimate LIO a)
forall a.
(Estimate LIO a -> Estimate LIO a)
-> Estimate LIO a -> Simulation LIO (Estimate LIO a)
memoEstimate Estimate LIO a -> Estimate LIO a
g
  where g :: Estimate LIO a -> Estimate LIO a
g Estimate LIO a
m =
          do a
a1 <- Estimate LIO a -> Estimate LIO a
forall a. Estimate LIO a -> Estimate LIO a
estimateUpSide Estimate LIO a
m
             a
a2 <- Estimate LIO a -> Estimate LIO a
forall a. Estimate LIO a -> Estimate LIO a
estimateDownSide Estimate LIO a
m
             a -> a -> Estimate LIO a
f a
a1 a
a2