module Simulation.Aivika.Internal.Specs
(Specs(..),
Method(..),
Run(..),
Point(..),
EventQueue(..),
newEventQueue,
basicTime,
integIterationBnds,
integIterationHiBnd,
integIterationLoBnd,
integPhaseBnds,
integPhaseHiBnd,
integPhaseLoBnd,
integTimes,
integPoints,
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 = 0
i2 = round ((spcStopTime sc
spcStartTime sc) / spcDT sc)
integIterationBnds :: Specs -> (Int, Int)
integIterationBnds sc = (0, round ((spcStopTime sc
spcStartTime sc) / spcDT sc))
integIterationLoBnd :: Specs -> Int
integIterationLoBnd sc = 0
integIterationHiBnd :: Specs -> Int
integIterationHiBnd sc = round ((spcStopTime sc
spcStartTime sc) / spcDT sc)
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 }