module Simulation.Aivika.Internal.Specs
(Specs(..),
Method(..),
Run(..),
Point(..),
EventQueue(..),
newEventQueue,
basicTime,
integIterationBnds,
integIterationHiBnd,
integIterationLoBnd,
integPhaseBnds,
integPhaseHiBnd,
integPhaseLoBnd,
integTimes,
integPoints,
integPointsStartingFrom,
integStartPoint,
integStopPoint,
pointAt) where
import Data.IORef
import Simulation.Aivika.Generator
import qualified Simulation.Aivika.PriorityQueue as PQ
data Specs = Specs { spcStartTime :: Double,
spcStopTime :: Double,
spcDT :: Double,
spcMethod :: Method,
spcGeneratorType :: GeneratorType
}
data Method = Euler
| RungeKutta2
| RungeKutta4
deriving (Eq, Ord, Show)
data Run = Run { runSpecs :: Specs,
runIndex :: Int,
runCount :: Int,
runEventQueue :: EventQueue,
runGenerator :: Generator
}
data Point = Point { pointSpecs :: Specs,
pointRun :: Run,
pointTime :: Double,
pointIteration :: Int,
pointPhase :: Int
}
data EventQueue = EventQueue { queuePQ :: PQ.PriorityQueue (Point -> IO ()),
queueBusy :: IORef Bool,
queueTime :: IORef Double
}
newEventQueue :: Specs -> IO EventQueue
newEventQueue specs =
do f <- newIORef False
t <- newIORef $ spcStartTime specs
pq <- PQ.newQueue
return EventQueue { queuePQ = pq,
queueBusy = f,
queueTime = t }
integIterations :: Specs -> [Int]
integIterations sc = [i1 .. i2] where
i1 = integIterationLoBnd sc
i2 = integIterationHiBnd sc
integIterationBnds :: Specs -> (Int, Int)
integIterationBnds sc = (i1, i2) where
i1 = integIterationLoBnd sc
i2 = integIterationHiBnd sc
integIterationLoBnd :: Specs -> Int
integIterationLoBnd sc = 0
integIterationHiBnd :: Specs -> Int
integIterationHiBnd sc =
let n = round ((spcStopTime sc
spcStartTime sc) / spcDT sc)
in if n < 0
then
error $
"The iteration number in the stop time has a negative value. " ++
"Either the simulation specs are incorrect, " ++
"or a floating point overflow occurred, " ++
"for example, when using a too small integration time step. " ++
"You have to define this time step regardless of " ++
"whether you actually use it or not, " ++
"for Aivika allows combining the ordinary differential equations " ++
"with the discrete event simulation within one model. " ++
"So, if you are still using the 32-bit architecture and " ++
"you do need a small integration time step " ++
"for integrating the equations " ++
"then you might think of using the 64-bit architecture. " ++
"Although you could probably just forget " ++
"to increase the time step " ++
"after increasing the stop time: integIterationHiBnd"
else n
integPhases :: Specs -> [Int]
integPhases sc =
case spcMethod sc of
Euler -> [0]
RungeKutta2 -> [0, 1]
RungeKutta4 -> [0, 1, 2, 3]
integPhaseBnds :: Specs -> (Int, Int)
integPhaseBnds sc =
case spcMethod sc of
Euler -> (0, 0)
RungeKutta2 -> (0, 1)
RungeKutta4 -> (0, 3)
integPhaseLoBnd :: Specs -> Int
integPhaseLoBnd sc = 0
integPhaseHiBnd :: Specs -> Int
integPhaseHiBnd sc =
case spcMethod sc of
Euler -> 0
RungeKutta2 -> 1
RungeKutta4 -> 3
basicTime :: Specs -> Int -> Int -> Double
basicTime sc n ph =
if ph < 0 then
error "Incorrect phase: basicTime"
else
spcStartTime sc + n' * spcDT sc + delta (spcMethod sc) ph
where n' = fromIntegral n
delta Euler 0 = 0
delta RungeKutta2 0 = 0
delta RungeKutta2 1 = spcDT sc
delta RungeKutta4 0 = 0
delta RungeKutta4 1 = spcDT sc / 2
delta RungeKutta4 2 = spcDT sc / 2
delta RungeKutta4 3 = spcDT sc
integTimes :: Specs -> [Double]
integTimes sc = map t [nl .. nu]
where (nl, nu) = integIterationBnds sc
t n = basicTime sc n 0
integPoints :: Run -> [Point]
integPoints r = points
where sc = runSpecs r
(nl, nu) = integIterationBnds sc
points = map point [nl .. nu]
point n = Point { pointSpecs = sc,
pointRun = r,
pointTime = basicTime sc n 0,
pointIteration = n,
pointPhase = 0 }
integStartPoint :: Run -> Point
integStartPoint r = point nl
where sc = runSpecs r
(nl, nu) = integIterationBnds sc
point n = Point { pointSpecs = sc,
pointRun = r,
pointTime = basicTime sc n 0,
pointIteration = n,
pointPhase = 0 }
integStopPoint :: Run -> Point
integStopPoint r = point nu
where sc = runSpecs r
(nl, nu) = integIterationBnds sc
point n = Point { pointSpecs = sc,
pointRun = r,
pointTime = basicTime sc n 0,
pointIteration = n,
pointPhase = 0 }
pointAt :: Run -> Double -> Point
pointAt r t = p
where sc = runSpecs r
t0 = spcStartTime sc
dt = spcDT sc
n = fromIntegral $ floor ((t t0) / dt)
p = Point { pointSpecs = sc,
pointRun = r,
pointTime = t,
pointIteration = n,
pointPhase = 1 }
integPointsStartingFrom :: Point -> [Point]
integPointsStartingFrom p = points
where r = pointRun p
sc = runSpecs r
(nl, nu) = integIterationBnds sc
n0 = if pointPhase p == 0
then pointIteration p
else pointIteration p + 1
points = map point [n0 .. nu]
point n = Point { pointSpecs = sc,
pointRun = r,
pointTime = basicTime sc n 0,
pointIteration = n,
pointPhase = 0 }