module Simulation.Aivika.Dynamics.Var
(Var,
varQueue,
newVar,
readVar,
writeVar,
modifyVar,
freezeVar) where
import Data.Array
import Data.Array.IO
import Data.IORef
import Simulation.Aivika.Dynamics.Internal.Simulation
import Simulation.Aivika.Dynamics.Internal.Dynamics
import Simulation.Aivika.Dynamics.EventQueue
import qualified Simulation.Aivika.Vector as V
import qualified Simulation.Aivika.UVector as UV
data Var a =
Var { varQueue :: EventQueue,
varRun :: Dynamics (),
varXS :: UV.UVector Double,
varYS :: V.Vector a}
newVar :: EventQueue -> a -> Simulation (Var a)
newVar q a =
Simulation $ \r ->
do xs <- UV.newVector
ys <- V.newVector
UV.appendVector xs $ spcStartTime $ runSpecs r
V.appendVector ys a
return Var { varQueue = q,
varRun = queueRun q,
varXS = xs,
varYS = ys }
readVar :: Var a -> Dynamics a
readVar v =
Dynamics $ \p ->
do let Dynamics m = varRun v
m p
let xs = varXS v
ys = varYS v
t = pointTime p
count <- UV.vectorCount xs
let i = count 1
x <- UV.readVector xs i
if x <= t
then V.readVector ys i
else do i <- UV.vectorBinarySearch xs t
if i >= 0
then V.readVector ys i
else V.readVector ys $ (i + 1) 1
writeVar :: Var a -> a -> Dynamics ()
writeVar v a =
Dynamics $ \p ->
do let xs = varXS v
ys = varYS v
t = pointTime p
count <- UV.vectorCount xs
let i = count 1
x <- UV.readVector xs i
if t < x
then error "Cannot update the past data: writeVar."
else if t == x
then V.writeVector ys i $! a
else do UV.appendVector xs t
V.appendVector ys $! a
modifyVar :: Var a -> (a -> a) -> Dynamics ()
modifyVar v f =
Dynamics $ \p ->
do let Dynamics m = varRun v
m p
let xs = varXS v
ys = varYS v
t = pointTime p
count <- UV.vectorCount xs
let i = count 1
x <- UV.readVector xs i
if t < x
then error "Cannot update the past data: modifyVar."
else if t == x
then do a <- V.readVector ys i
V.writeVector ys i $! f a
else do i <- UV.vectorBinarySearch xs t
if i >= 0
then do a <- V.readVector ys i
UV.appendVector xs t
V.appendVector ys $! f a
else do a <- V.readVector ys $ (i + 1) 1
UV.appendVector xs t
V.appendVector ys $! f a
freezeVar :: Var a -> Dynamics (Array Int Double, Array Int a)
freezeVar v =
Dynamics $ \p ->
do let Dynamics m = varRun v
m p
xs <- UV.freezeVector (varXS v)
ys <- V.freezeVector (varYS v)
return (xs, ys)