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
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 }
newVar :: a -> Simulation (Var a)
newVar :: forall 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. IO (Vector a)
V.newVector
Vector a
ys <- IO (Vector a)
forall a. IO (Vector a)
V.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. Vector a -> a -> IO ()
V.appendVector Vector a
ms a
a
Vector a -> a -> IO ()
forall a. Vector a -> a -> IO ()
V.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 }
varMemo :: Var a -> Dynamics a
varMemo :: forall 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. Vector a -> Int -> IO a
V.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. Vector a -> a -> IO ()
V.appendVector Vector a
ms a
a
Vector a -> a -> IO ()
forall a. Vector a -> a -> IO ()
V.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. Vector a -> Int -> IO a
V.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. Vector a -> Int -> IO a
V.readVector Vector a
ms Int
i
else Vector a -> Int -> IO a
forall a. Vector a -> Int -> IO a
V.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
readVar :: Var a -> Event a
readVar :: forall 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. Vector a -> Int -> IO a
V.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. Vector a -> Int -> IO a
V.readVector Vector a
ys Int
i
else Vector a -> Int -> IO a
forall a. Vector a -> Int -> IO a
V.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
writeVar :: Var a -> a -> Event ()
writeVar :: forall 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. Vector a -> Int -> a -> IO ()
V.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. Vector a -> a -> IO ()
V.appendVector Vector a
ms (a -> IO ()) -> a -> IO ()
forall a b. (a -> b) -> a -> b
$! a
a
Vector a -> a -> IO ()
forall a. Vector a -> a -> IO ()
V.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
modifyVar :: Var a -> (a -> a) -> Event ()
modifyVar :: forall 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. Vector a -> Int -> IO a
V.readVector Vector a
ys Int
i
let b :: a
b = a -> a
f a
a
Vector a -> Int -> a -> IO ()
forall a. Vector a -> Int -> a -> IO ()
V.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. Vector a -> Int -> IO a
V.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. Vector a -> a -> IO ()
V.appendVector Vector a
ms (a -> IO ()) -> a -> IO ()
forall a b. (a -> b) -> a -> b
$! a
b
Vector a -> a -> IO ()
forall a. Vector a -> a -> IO ()
V.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
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 =
(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. Vector a -> IO (Array Int a)
V.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. Vector a -> IO (Array Int a)
V.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)
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)
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