-- |
-- Module     : Simulation.Aivika.Var.Unboxed
-- 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 an unboxed variable that is bound up with the event queue and 
-- that keeps the history of changes storing the values in unboxed 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.Unboxed
       (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.Unboxed
import Simulation.Aivika.Statistics

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    :: UV.Vector a,
        forall a. Var a -> Vector a
varYS    :: UV.Vector a,
        forall a. Var a -> SignalSource a
varChangedSource :: SignalSource a }

-- | Create a new variable.
newVar :: Unboxed a => a -> Simulation (Var a)
newVar :: forall a. Unboxed a => a -> Simulation (Var a)
newVar a
a =
  (Run -> IO (Var a)) -> Simulation (Var a)
forall a. (Run -> IO a) -> Simulation a
Simulation ((Run -> IO (Var a)) -> Simulation (Var a))
-> (Run -> IO (Var a)) -> Simulation (Var a)
forall a b. (a -> b) -> a -> b
$ \Run
r ->
  do Vector Double
xs <- IO (Vector Double)
forall a. Unboxed a => IO (Vector a)
UV.newVector
     Vector a
ms <- IO (Vector a)
forall a. Unboxed a => IO (Vector a)
UV.newVector
     Vector a
ys <- IO (Vector a)
forall a. Unboxed a => IO (Vector a)
UV.newVector
     Vector Double -> Double -> IO ()
forall a. Unboxed a => Vector a -> a -> IO ()
UV.appendVector Vector Double
xs (Double -> IO ()) -> Double -> IO ()
forall a b. (a -> b) -> a -> b
$ Specs -> Double
spcStartTime (Specs -> Double) -> Specs -> Double
forall a b. (a -> b) -> a -> b
$ Run -> Specs
runSpecs Run
r
     Vector a -> a -> IO ()
forall a. Unboxed a => Vector a -> a -> IO ()
UV.appendVector Vector a
ms a
a
     Vector a -> a -> IO ()
forall a. Unboxed a => Vector a -> a -> IO ()
UV.appendVector Vector a
ys a
a
     SignalSource a
s  <- Run -> Simulation (SignalSource a) -> IO (SignalSource a)
forall a. Run -> Simulation a -> IO a
invokeSimulation Run
r Simulation (SignalSource a)
forall a. Simulation (SignalSource a)
newSignalSource
     Var a -> IO (Var a)
forall a. a -> IO a
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 :: Unboxed a => Var a -> Dynamics a
varMemo :: forall a. Unboxed a => Var a -> Dynamics a
varMemo Var a
v =
  EventProcessing -> Event a -> Dynamics a
forall a. EventProcessing -> Event a -> Dynamics a
runEventWith EventProcessing
CurrentEventsOrFromPast (Event a -> Dynamics a) -> Event a -> Dynamics a
forall a b. (a -> b) -> a -> b
$
  (Point -> IO a) -> Event a
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO a) -> Event a) -> (Point -> IO a) -> Event a
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let xs :: Vector Double
xs = Var a -> Vector Double
forall a. Var a -> Vector Double
varXS Var a
v
         ms :: Vector a
ms = Var a -> Vector a
forall a. Var a -> Vector a
varMS Var a
v
         ys :: Vector a
ys = Var a -> Vector a
forall a. Var a -> Vector a
varYS Var a
v
         t :: Double
t  = Point -> Double
pointTime Point
p
     Int
count <- Vector Double -> IO Int
forall a. Unboxed a => Vector a -> IO Int
UV.vectorCount Vector Double
xs
     let i :: Int
i = Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
     Double
x <- Vector Double -> Int -> IO Double
forall a. Unboxed a => Vector a -> Int -> IO a
UV.readVector Vector Double
xs Int
i
     if Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
t
       then do a
a <- Vector a -> Int -> IO a
forall a. Unboxed a => Vector a -> Int -> IO a
UV.readVector Vector a
ys Int
i
               Vector Double -> Double -> IO ()
forall a. Unboxed a => Vector a -> a -> IO ()
UV.appendVector Vector Double
xs Double
t
               Vector a -> a -> IO ()
forall a. Unboxed a => Vector a -> a -> IO ()
UV.appendVector Vector a
ms a
a
               Vector a -> a -> IO ()
forall a. Unboxed a => Vector a -> a -> IO ()
UV.appendVector Vector a
ys a
a
               a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
       else if Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
t
            then Vector a -> Int -> IO a
forall a. Unboxed a => Vector a -> Int -> IO a
UV.readVector Vector a
ms Int
i
            else do Int
i <- Vector Double -> Double -> IO Int
forall a. (Unboxed a, Ord a) => Vector a -> a -> IO Int
UV.vectorBinarySearch Vector Double
xs Double
t
                    if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
                      then Vector a -> Int -> IO a
forall a. Unboxed a => Vector a -> Int -> IO a
UV.readVector Vector a
ms Int
i
                      else Vector a -> Int -> IO a
forall a. Unboxed a => Vector a -> Int -> IO a
UV.readVector Vector a
ms (Int -> IO a) -> Int -> IO a
forall a b. (a -> b) -> a -> b
$ - (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
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 :: Unboxed a => Var a -> Event a
readVar :: forall a. Unboxed a => Var a -> Event a
readVar Var a
v = 
  (Point -> IO a) -> Event a
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO a) -> Event a) -> (Point -> IO a) -> Event a
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let xs :: Vector Double
xs = Var a -> Vector Double
forall a. Var a -> Vector Double
varXS Var a
v
         ys :: Vector a
ys = Var a -> Vector a
forall a. Var a -> Vector a
varYS Var a
v
         t :: Double
t  = Point -> Double
pointTime Point
p
     Int
count <- Vector Double -> IO Int
forall a. Unboxed a => Vector a -> IO Int
UV.vectorCount Vector Double
xs
     let i :: Int
i = Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
     Double
x <- Vector Double -> Int -> IO Double
forall a. Unboxed a => Vector a -> Int -> IO a
UV.readVector Vector Double
xs Int
i
     if Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
t 
       then Vector a -> Int -> IO a
forall a. Unboxed a => Vector a -> Int -> IO a
UV.readVector Vector a
ys Int
i
       else do Int
i <- Vector Double -> Double -> IO Int
forall a. (Unboxed a, Ord a) => Vector a -> a -> IO Int
UV.vectorBinarySearch Vector Double
xs Double
t
               if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
                 then Vector a -> Int -> IO a
forall a. Unboxed a => Vector a -> Int -> IO a
UV.readVector Vector a
ys Int
i
                 else Vector a -> Int -> IO a
forall a. Unboxed a => Vector a -> Int -> IO a
UV.readVector Vector a
ys (Int -> IO a) -> Int -> IO a
forall a b. (a -> b) -> a -> b
$ - (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

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

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