-- |
-- Module     : Simulation.Aivika.Var
-- 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 a variable that is bound up with the event queue and 
-- that keeps the history of changes storing the values in arrays, which
-- allows using the variable in differential and difference equations of
-- System Dynamics within hybrid discrete-continuous simulation.
--
-- Because of using the arrays, it would usually be a logical mistake to
-- use this variable for collecting statistics. In most cases,
-- the statistics can actually be collected with a very small footprint
-- by updating immutable 'SamplingStats' and 'TimingStats' values in
-- a mutable 'Ref' reference.
--
module Simulation.Aivika.Var
       (Var,
        varChanged,
        varChanged_,
        newVar,
        readVar,
        varMemo,
        writeVar,
        modifyVar,
        freezeVar) where

import Data.Array
import Data.Array.IO.Safe

import Simulation.Aivika.Internal.Specs
import Simulation.Aivika.Internal.Simulation
import Simulation.Aivika.Internal.Dynamics
import Simulation.Aivika.Internal.Event
import Simulation.Aivika.Ref
import Simulation.Aivika.Signal
import Simulation.Aivika.Statistics

import qualified Simulation.Aivika.Vector as V
import qualified Simulation.Aivika.Vector.Unboxed as UV

-- | Like the 'Ref' reference but keeps the history of changes in 
-- different time points. The 'Var' variable is safe to be used in
-- the hybrid discrete-continuous simulation. Only this variable is
-- much slower than the reference.
--
-- For example, the memoised values of the variable can be used in
-- the differential and difference equations of System Dynamics, while
-- the variable iself can be updated within the discrete event simulation.
--
-- Because of using arrays under the hood, it would usually be a logical
-- mistake to use the variable for collecting statistics. In most cases,
-- the statistics can actually be collected with a very small footprint
-- by updating immutable 'SamplingStats' and 'TimingStats' values in
-- a mutable @Ref@ reference.
data Var a = 
  Var { forall a. Var a -> Vector Double
varXS    :: UV.Vector Double,
        forall a. Var a -> Vector a
varMS    :: V.Vector a,
        forall a. Var a -> Vector a
varYS    :: V.Vector a,
        forall a. Var a -> SignalSource a
varChangedSource :: SignalSource a }
     
-- | Create a new variable.
newVar :: a -> Simulation (Var a)
newVar :: forall a. a -> Simulation (Var a)
newVar a
a =
  forall a. (Run -> IO a) -> Simulation a
Simulation forall a b. (a -> b) -> a -> b
$ \Run
r ->
  do Vector Double
xs <- forall a. Unboxed a => IO (Vector a)
UV.newVector
     Vector a
ms <- forall a. IO (Vector a)
V.newVector
     Vector a
ys <- forall a. IO (Vector a)
V.newVector
     forall a. Unboxed a => Vector a -> a -> IO ()
UV.appendVector Vector Double
xs forall a b. (a -> b) -> a -> b
$ Specs -> Double
spcStartTime forall a b. (a -> b) -> a -> b
$ Run -> Specs
runSpecs Run
r
     forall a. Vector a -> a -> IO ()
V.appendVector Vector a
ms a
a
     forall a. Vector a -> a -> IO ()
V.appendVector Vector a
ys a
a
     SignalSource a
s  <- forall a. Run -> Simulation a -> IO a
invokeSimulation Run
r forall a. Simulation (SignalSource a)
newSignalSource
     forall (m :: * -> *) a. Monad m => a -> m a
return Var { varXS :: Vector Double
varXS = Vector Double
xs,
                  varMS :: Vector a
varMS = Vector a
ms,
                  varYS :: Vector a
varYS = Vector a
ms,
                  varChangedSource :: SignalSource a
varChangedSource = SignalSource a
s }

-- | Read the first actual, i.e. memoised, value of a variable for the requested time
-- actuating the current events from the queue if needed.
--
-- This computation can be used in the ordinary differential and
-- difference equations of System Dynamics.
varMemo :: Var a -> Dynamics a
varMemo :: forall a. Var a -> Dynamics a
varMemo Var a
v =
  forall a. EventProcessing -> Event a -> Dynamics a
runEventWith EventProcessing
CurrentEventsOrFromPast forall a b. (a -> b) -> a -> b
$
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let xs :: Vector Double
xs = forall a. Var a -> Vector Double
varXS Var a
v
         ms :: Vector a
ms = forall a. Var a -> Vector a
varMS Var a
v
         ys :: Vector a
ys = forall a. Var a -> Vector a
varYS Var a
v
         t :: Double
t  = Point -> Double
pointTime Point
p
     Int
count <- forall a. Unboxed a => Vector a -> IO Int
UV.vectorCount Vector Double
xs
     let i :: Int
i = Int
count forall a. Num a => a -> a -> a
- Int
1
     Double
x <- forall a. Unboxed a => Vector a -> Int -> IO a
UV.readVector Vector Double
xs Int
i
     if Double
x forall a. Ord a => a -> a -> Bool
< Double
t
       then do a
a <- forall a. Vector a -> Int -> IO a
V.readVector Vector a
ys Int
i
               forall a. Unboxed a => Vector a -> a -> IO ()
UV.appendVector Vector Double
xs Double
t
               forall a. Vector a -> a -> IO ()
V.appendVector Vector a
ms a
a
               forall a. Vector a -> a -> IO ()
V.appendVector Vector a
ys a
a
               forall (m :: * -> *) a. Monad m => a -> m a
return a
a
       else if Double
x forall a. Eq a => a -> a -> Bool
== Double
t
            then forall a. Vector a -> Int -> IO a
V.readVector Vector a
ms Int
i
            else do Int
i <- forall a. (Unboxed a, Ord a) => Vector a -> a -> IO Int
UV.vectorBinarySearch Vector Double
xs Double
t
                    if Int
i forall a. Ord a => a -> a -> Bool
>= Int
0
                      then forall a. Vector a -> Int -> IO a
V.readVector Vector a
ms Int
i
                      else forall a. Vector a -> Int -> IO a
V.readVector Vector a
ms forall a b. (a -> b) -> a -> b
$ - (Int
i forall a. Num a => a -> a -> a
+ Int
1) forall a. Num a => a -> a -> a
- Int
1

-- | Read the recent actual value of a variable for the requested time.
--
-- This computation is destined to be used within discrete event simulation.
readVar :: Var a -> Event a
readVar :: forall a. Var a -> Event a
readVar Var a
v = 
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let xs :: Vector Double
xs = forall a. Var a -> Vector Double
varXS Var a
v
         ys :: Vector a
ys = forall a. Var a -> Vector a
varYS Var a
v
         t :: Double
t  = Point -> Double
pointTime Point
p
     Int
count <- forall a. Unboxed a => Vector a -> IO Int
UV.vectorCount Vector Double
xs
     let i :: Int
i = Int
count forall a. Num a => a -> a -> a
- Int
1
     Double
x <- forall a. Unboxed a => Vector a -> Int -> IO a
UV.readVector Vector Double
xs Int
i
     if Double
x forall a. Ord a => a -> a -> Bool
<= Double
t 
       then forall a. Vector a -> Int -> IO a
V.readVector Vector a
ys Int
i
       else do Int
i <- forall a. (Unboxed a, Ord a) => Vector a -> a -> IO Int
UV.vectorBinarySearch Vector Double
xs Double
t
               if Int
i forall a. Ord a => a -> a -> Bool
>= Int
0
                 then forall a. Vector a -> Int -> IO a
V.readVector Vector a
ys Int
i
                 else forall a. Vector a -> Int -> IO a
V.readVector Vector a
ys forall a b. (a -> b) -> a -> b
$ - (Int
i forall a. Num a => a -> a -> a
+ Int
1) forall a. Num a => a -> a -> a
- Int
1

-- | Write a new value into the variable.
writeVar :: Var a -> a -> Event ()
writeVar :: forall a. Var a -> a -> Event ()
writeVar Var a
v a
a =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let xs :: Vector Double
xs = forall a. Var a -> Vector Double
varXS Var a
v
         ms :: Vector a
ms = forall a. Var a -> Vector a
varMS Var a
v
         ys :: Vector a
ys = forall a. Var a -> Vector a
varYS Var a
v
         t :: Double
t  = Point -> Double
pointTime Point
p
         s :: SignalSource a
s  = forall a. Var a -> SignalSource a
varChangedSource Var a
v
     Int
count <- forall a. Unboxed a => Vector a -> IO Int
UV.vectorCount Vector Double
xs
     let i :: Int
i = Int
count forall a. Num a => a -> a -> a
- Int
1
     Double
x <- forall a. Unboxed a => Vector a -> Int -> IO a
UV.readVector Vector Double
xs Int
i
     if Double
t forall a. Ord a => a -> a -> Bool
< Double
x 
       then forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot update the past data: writeVar."
       else if Double
t forall a. Eq a => a -> a -> Bool
== Double
x
            then forall a. Vector a -> Int -> a -> IO ()
V.writeVector Vector a
ys Int
i forall a b. (a -> b) -> a -> b
$! a
a
            else do forall a. Unboxed a => Vector a -> a -> IO ()
UV.appendVector Vector Double
xs Double
t
                    forall a. Vector a -> a -> IO ()
V.appendVector Vector a
ms forall a b. (a -> b) -> a -> b
$! a
a
                    forall a. Vector a -> a -> IO ()
V.appendVector Vector a
ys forall a b. (a -> b) -> a -> b
$! a
a
     forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ forall a. SignalSource a -> a -> Event ()
triggerSignal SignalSource a
s a
a

-- | Mutate the contents of the variable.
modifyVar :: Var a -> (a -> a) -> Event ()
modifyVar :: forall a. Var a -> (a -> a) -> Event ()
modifyVar Var a
v a -> a
f =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let xs :: Vector Double
xs = forall a. Var a -> Vector Double
varXS Var a
v
         ms :: Vector a
ms = forall a. Var a -> Vector a
varMS Var a
v
         ys :: Vector a
ys = forall a. Var a -> Vector a
varYS Var a
v
         t :: Double
t  = Point -> Double
pointTime Point
p
         s :: SignalSource a
s  = forall a. Var a -> SignalSource a
varChangedSource Var a
v
     Int
count <- forall a. Unboxed a => Vector a -> IO Int
UV.vectorCount Vector Double
xs
     let i :: Int
i = Int
count forall a. Num a => a -> a -> a
- Int
1
     Double
x <- forall a. Unboxed a => Vector a -> Int -> IO a
UV.readVector Vector Double
xs Int
i
     if Double
t forall a. Ord a => a -> a -> Bool
< Double
x
       then forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot update the past data: modifyVar."
       else if Double
t forall a. Eq a => a -> a -> Bool
== Double
x
            then do a
a <- forall a. Vector a -> Int -> IO a
V.readVector Vector a
ys Int
i
                    let b :: a
b = a -> a
f a
a
                    forall a. Vector a -> Int -> a -> IO ()
V.writeVector Vector a
ys Int
i forall a b. (a -> b) -> a -> b
$! a
b
                    forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ forall a. SignalSource a -> a -> Event ()
triggerSignal SignalSource a
s a
b
            else do a
a <- forall a. Vector a -> Int -> IO a
V.readVector Vector a
ys Int
i
                    let b :: a
b = a -> a
f a
a
                    forall a. Unboxed a => Vector a -> a -> IO ()
UV.appendVector Vector Double
xs Double
t
                    forall a. Vector a -> a -> IO ()
V.appendVector Vector a
ms forall a b. (a -> b) -> a -> b
$! a
b
                    forall a. Vector a -> a -> IO ()
V.appendVector Vector a
ys forall a b. (a -> b) -> a -> b
$! a
b
                    forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ forall a. SignalSource a -> a -> Event ()
triggerSignal SignalSource a
s a
b

-- | Freeze the variable and return in arrays the time points and the corresponding 
-- first and last values when the variable had changed or had been memoised in
-- different time points: (1) the time points are sorted in ascending order;
-- (2) the first and last actual values per each time point are provided.
--
-- If you need to get all changes including those ones that correspond to the same
-- simulation time points then you can use the 'newSignalHistory' function passing
-- in the 'varChanged' signal to it and then call function 'readSignalHistory'.
freezeVar :: Var a -> Event (Array Int Double, Array Int a, Array Int a)
freezeVar :: forall a.
Var a -> Event (Array Int Double, Array Int a, Array Int a)
freezeVar Var a
v =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Array Int Double
xs <- forall a. Unboxed a => Vector a -> IO (Array Int a)
UV.freezeVector (forall a. Var a -> Vector Double
varXS Var a
v)
     Array Int a
ms <- forall a. Vector a -> IO (Array Int a)
V.freezeVector (forall a. Var a -> Vector a
varMS Var a
v)
     Array Int a
ys <- forall a. Vector a -> IO (Array Int a)
V.freezeVector (forall a. Var a -> Vector a
varYS Var a
v)
     forall (m :: * -> *) a. Monad m => a -> m a
return (Array Int Double
xs, Array Int a
ms, Array Int a
ys)
     
-- | Return a signal that notifies about every change of the variable state.
varChanged :: Var a -> Signal a
varChanged :: forall a. Var a -> Signal a
varChanged Var a
v = forall a. SignalSource a -> Signal a
publishSignal (forall a. Var a -> SignalSource a
varChangedSource Var a
v)

-- | Return a signal that notifies about every change of the variable state.
varChanged_ :: Var a -> Signal ()
varChanged_ :: forall a. Var a -> Signal ()
varChanged_ Var a
v = forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (forall a b. a -> b -> a
const ()) forall a b. (a -> b) -> a -> b
$ forall a. Var a -> Signal a
varChanged Var a
v