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 =
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 }
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
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
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
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
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)
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)
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