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 qualified Simulation.Aivika.PriorityQueue as PQ
data Specs = Specs { spcStartTime :: Double,
spcStopTime :: Double,
spcDT :: Double,
spcMethod :: Method
} deriving (Eq, Ord, Show)
data Method = Euler
| RungeKutta2
| RungeKutta4
deriving (Eq, Ord, Show)
data Run = Run { runSpecs :: Specs,
runIndex :: Int,
runCount :: Int,
runEventQueue :: EventQueue
}
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 }