{-# LANGUAGE TypeFamilies #-}
module Simulation.Aivika.Trans.Internal.Specs
(Specs(..),
Method(..),
Run(..),
Point(..),
basicTime,
integIterationBnds,
integIterationHiBnd,
integIterationLoBnd,
integPhaseBnds,
integPhaseHiBnd,
integPhaseLoBnd,
integTimes,
integPoints,
integPointsStartingFrom,
integStartPoint,
integStopPoint,
simulationStopPoint,
timeGrid,
pointAt,
delayPoint) where
import Simulation.Aivika.Trans.Internal.Types
integIterations :: Specs m -> [Int]
integIterations :: forall (m :: * -> *). Specs m -> [Int]
integIterations Specs m
sc = [Int
i1 .. Int
i2] where
i1 :: Int
i1 = Specs m -> Int
forall (m :: * -> *). Specs m -> Int
integIterationLoBnd Specs m
sc
i2 :: Int
i2 = Specs m -> Int
forall (m :: * -> *). Specs m -> Int
integIterationHiBnd Specs m
sc
integIterationBnds :: Specs m -> (Int, Int)
integIterationBnds :: forall (m :: * -> *). Specs m -> (Int, Int)
integIterationBnds Specs m
sc = (Int
i1, Int
i2) where
i1 :: Int
i1 = Specs m -> Int
forall (m :: * -> *). Specs m -> Int
integIterationLoBnd Specs m
sc
i2 :: Int
i2 = Specs m -> Int
forall (m :: * -> *). Specs m -> Int
integIterationHiBnd Specs m
sc
integIterationLoBnd :: Specs m -> Int
integIterationLoBnd :: forall (m :: * -> *). Specs m -> Int
integIterationLoBnd Specs m
sc = Int
0
integIterationHiBnd :: Specs m -> Int
integIterationHiBnd :: forall (m :: * -> *). Specs m -> Int
integIterationHiBnd Specs m
sc =
let n :: Int
n = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round ((Specs m -> Double
forall (m :: * -> *). Specs m -> Double
spcStopTime Specs m
sc Double -> Double -> Double
forall a. Num a => a -> a -> a
-
Specs m -> Double
forall (m :: * -> *). Specs m -> Double
spcStartTime Specs m
sc) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Specs m -> Double
forall (m :: * -> *). Specs m -> Double
spcDT Specs m
sc)
in if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
then
[Char] -> Int
forall a. HasCallStack => [Char] -> a
error ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$
[Char]
"Either the simulation specs are incorrect, " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"or a step time is too small, because of which " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"a floating point overflow occurred on 32-bit Haskell implementation."
else Int
n
integPhases :: Specs m -> [Int]
integPhases :: forall (m :: * -> *). Specs m -> [Int]
integPhases Specs m
sc =
case Specs m -> Method
forall (m :: * -> *). Specs m -> Method
spcMethod Specs m
sc of
Method
Euler -> [Int
0]
Method
RungeKutta2 -> [Int
0, Int
1]
Method
RungeKutta4 -> [Int
0, Int
1, Int
2, Int
3]
Method
RungeKutta4b -> [Int
0, Int
1, Int
2, Int
3]
integPhaseBnds :: Specs m -> (Int, Int)
integPhaseBnds :: forall (m :: * -> *). Specs m -> (Int, Int)
integPhaseBnds Specs m
sc =
case Specs m -> Method
forall (m :: * -> *). Specs m -> Method
spcMethod Specs m
sc of
Method
Euler -> (Int
0, Int
0)
Method
RungeKutta2 -> (Int
0, Int
1)
Method
RungeKutta4 -> (Int
0, Int
3)
Method
RungeKutta4b -> (Int
0, Int
3)
integPhaseLoBnd :: Specs m -> Int
integPhaseLoBnd :: forall (m :: * -> *). Specs m -> Int
integPhaseLoBnd Specs m
sc = Int
0
integPhaseHiBnd :: Specs m -> Int
integPhaseHiBnd :: forall (m :: * -> *). Specs m -> Int
integPhaseHiBnd Specs m
sc =
case Specs m -> Method
forall (m :: * -> *). Specs m -> Method
spcMethod Specs m
sc of
Method
Euler -> Int
0
Method
RungeKutta2 -> Int
1
Method
RungeKutta4 -> Int
3
Method
RungeKutta4b -> Int
3
basicTime :: Specs m -> Int -> Int -> Double
{-# INLINE basicTime #-}
basicTime :: forall (m :: * -> *). Specs m -> Int -> Int -> Double
basicTime Specs m
sc Int
n Int
ph =
if Int
ph Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then
[Char] -> Double
forall a. HasCallStack => [Char] -> a
error [Char]
"Incorrect phase: basicTime"
else
Specs m -> Double
forall (m :: * -> *). Specs m -> Double
spcStartTime Specs m
sc Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
n' Double -> Double -> Double
forall a. Num a => a -> a -> a
* Specs m -> Double
forall (m :: * -> *). Specs m -> Double
spcDT Specs m
sc Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Method -> Int -> Double
delta (Specs m -> Method
forall (m :: * -> *). Specs m -> Method
spcMethod Specs m
sc) Int
ph
where n' :: Double
n' = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
delta :: Method -> Int -> Double
delta Method
Euler Int
0 = Double
0
delta Method
RungeKutta2 Int
0 = Double
0
delta Method
RungeKutta2 Int
1 = Specs m -> Double
forall (m :: * -> *). Specs m -> Double
spcDT Specs m
sc
delta Method
RungeKutta4 Int
0 = Double
0
delta Method
RungeKutta4 Int
1 = Specs m -> Double
forall (m :: * -> *). Specs m -> Double
spcDT Specs m
sc Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
delta Method
RungeKutta4 Int
2 = Specs m -> Double
forall (m :: * -> *). Specs m -> Double
spcDT Specs m
sc Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
delta Method
RungeKutta4 Int
3 = Specs m -> Double
forall (m :: * -> *). Specs m -> Double
spcDT Specs m
sc
delta Method
RungeKutta4b Int
0 = Double
0
delta Method
RungeKutta4b Int
1 = Specs m -> Double
forall (m :: * -> *). Specs m -> Double
spcDT Specs m
sc Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
3
delta Method
RungeKutta4b Int
2 = Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Specs m -> Double
forall (m :: * -> *). Specs m -> Double
spcDT Specs m
sc Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
3
delta Method
RungeKutta4b Int
3 = Specs m -> Double
forall (m :: * -> *). Specs m -> Double
spcDT Specs m
sc
integTimes :: Specs m -> [Double]
integTimes :: forall (m :: * -> *). Specs m -> [Double]
integTimes Specs m
sc = (Int -> Double) -> [Int] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Double
t [Int
nl .. Int
nu]
where (Int
nl, Int
nu) = Specs m -> (Int, Int)
forall (m :: * -> *). Specs m -> (Int, Int)
integIterationBnds Specs m
sc
t :: Int -> Double
t Int
n = Specs m -> Int -> Int -> Double
forall (m :: * -> *). Specs m -> Int -> Int -> Double
basicTime Specs m
sc Int
n Int
0
integPoints :: Run m -> [Point m]
integPoints :: forall (m :: * -> *). Run m -> [Point m]
integPoints Run m
r = [Point m]
points
where sc :: Specs m
sc = Run m -> Specs m
forall (m :: * -> *). Run m -> Specs m
runSpecs Run m
r
(Int
nl, Int
nu) = Specs m -> (Int, Int)
forall (m :: * -> *). Specs m -> (Int, Int)
integIterationBnds Specs m
sc
points :: [Point m]
points = (Int -> Point m) -> [Int] -> [Point m]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Point m
point [Int
nl .. Int
nu]
point :: Int -> Point m
point Int
n = Point { pointSpecs :: Specs m
pointSpecs = Specs m
sc,
pointRun :: Run m
pointRun = Run m
r,
pointTime :: Double
pointTime = Specs m -> Int -> Int -> Double
forall (m :: * -> *). Specs m -> Int -> Int -> Double
basicTime Specs m
sc Int
n Int
0,
pointPriority :: Int
pointPriority = Int
0,
pointIteration :: Int
pointIteration = Int
n,
pointPhase :: Int
pointPhase = Int
0 }
integStartPoint :: Run m -> Point m
integStartPoint :: forall (m :: * -> *). Run m -> Point m
integStartPoint Run m
r = Int -> Point m
point Int
nl
where sc :: Specs m
sc = Run m -> Specs m
forall (m :: * -> *). Run m -> Specs m
runSpecs Run m
r
(Int
nl, Int
nu) = Specs m -> (Int, Int)
forall (m :: * -> *). Specs m -> (Int, Int)
integIterationBnds Specs m
sc
point :: Int -> Point m
point Int
n = Point { pointSpecs :: Specs m
pointSpecs = Specs m
sc,
pointRun :: Run m
pointRun = Run m
r,
pointTime :: Double
pointTime = Specs m -> Int -> Int -> Double
forall (m :: * -> *). Specs m -> Int -> Int -> Double
basicTime Specs m
sc Int
n Int
0,
pointPriority :: Int
pointPriority = Int
0,
pointIteration :: Int
pointIteration = Int
n,
pointPhase :: Int
pointPhase = Int
0 }
integStopPoint :: Run m -> Point m
integStopPoint :: forall (m :: * -> *). Run m -> Point m
integStopPoint Run m
r = Int -> Point m
point Int
nu
where sc :: Specs m
sc = Run m -> Specs m
forall (m :: * -> *). Run m -> Specs m
runSpecs Run m
r
(Int
nl, Int
nu) = Specs m -> (Int, Int)
forall (m :: * -> *). Specs m -> (Int, Int)
integIterationBnds Specs m
sc
point :: Int -> Point m
point Int
n = Point { pointSpecs :: Specs m
pointSpecs = Specs m
sc,
pointRun :: Run m
pointRun = Run m
r,
pointTime :: Double
pointTime = Specs m -> Int -> Int -> Double
forall (m :: * -> *). Specs m -> Int -> Int -> Double
basicTime Specs m
sc Int
n Int
0,
pointPriority :: Int
pointPriority = Int
0,
pointIteration :: Int
pointIteration = Int
n,
pointPhase :: Int
pointPhase = Int
0 }
simulationStopPoint :: Run m -> Point m
simulationStopPoint :: forall (m :: * -> *). Run m -> Point m
simulationStopPoint Run m
r = Run m -> Double -> Int -> Point m
forall (m :: * -> *). Run m -> Double -> Int -> Point m
pointAt Run m
r (Specs m -> Double
forall (m :: * -> *). Specs m -> Double
spcStopTime (Specs m -> Double) -> Specs m -> Double
forall a b. (a -> b) -> a -> b
$ Run m -> Specs m
forall (m :: * -> *). Run m -> Specs m
runSpecs Run m
r) Int
0
pointAt :: Run m -> Double -> EventPriority -> Point m
{-# INLINABLE pointAt #-}
pointAt :: forall (m :: * -> *). Run m -> Double -> Int -> Point m
pointAt Run m
r Double
t Int
priority = Point m
p
where sc :: Specs m
sc = Run m -> Specs m
forall (m :: * -> *). Run m -> Specs m
runSpecs Run m
r
t0 :: Double
t0 = Specs m -> Double
forall (m :: * -> *). Specs m -> Double
spcStartTime Specs m
sc
dt :: Double
dt = Specs m -> Double
forall (m :: * -> *). Specs m -> Double
spcDT Specs m
sc
n :: Int
n = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor ((Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
t0) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
dt)
p :: Point m
p = Point { pointSpecs :: Specs m
pointSpecs = Specs m
sc,
pointRun :: Run m
pointRun = Run m
r,
pointTime :: Double
pointTime = Double
t,
pointPriority :: Int
pointPriority = Int
priority,
pointIteration :: Int
pointIteration = Int
n,
pointPhase :: Int
pointPhase = -Int
1 }
integPointsStartingFrom :: Point m -> [Point m]
integPointsStartingFrom :: forall (m :: * -> *). Point m -> [Point m]
integPointsStartingFrom Point m
p = [Point m]
points
where r :: Run m
r = Point m -> Run m
forall (m :: * -> *). Point m -> Run m
pointRun Point m
p
sc :: Specs m
sc = Run m -> Specs m
forall (m :: * -> *). Run m -> Specs m
runSpecs Run m
r
(Int
nl, Int
nu) = Specs m -> (Int, Int)
forall (m :: * -> *). Specs m -> (Int, Int)
integIterationBnds Specs m
sc
n0 :: Int
n0 = if Point m -> Int
forall (m :: * -> *). Point m -> Int
pointPhase Point m
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then Point m -> Int
forall (m :: * -> *). Point m -> Int
pointIteration Point m
p
else Point m -> Int
forall (m :: * -> *). Point m -> Int
pointIteration Point m
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
points :: [Point m]
points = (Int -> Point m) -> [Int] -> [Point m]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Point m
point [Int
n0 .. Int
nu]
point :: Int -> Point m
point Int
n = Point { pointSpecs :: Specs m
pointSpecs = Specs m
sc,
pointRun :: Run m
pointRun = Run m
r,
pointTime :: Double
pointTime = Specs m -> Int -> Int -> Double
forall (m :: * -> *). Specs m -> Int -> Int -> Double
basicTime Specs m
sc Int
n Int
0,
pointPriority :: Int
pointPriority = Int
0,
pointIteration :: Int
pointIteration = Int
n,
pointPhase :: Int
pointPhase = Int
0 }
timeGrid :: Specs m -> Int -> [(Int, Double)]
timeGrid :: forall (m :: * -> *). Specs m -> Int -> [(Int, Double)]
timeGrid Specs m
sc Int
n =
let t0 :: Double
t0 = Specs m -> Double
forall (m :: * -> *). Specs m -> Double
spcStartTime Specs m
sc
t2 :: Double
t2 = Specs m -> Double
forall (m :: * -> *). Specs m -> Double
spcStopTime Specs m
sc
n' :: Int
n' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
1
dt :: Double
dt = (Double
t2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
t0) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n')
f :: Int -> (Int, Double)
f Int
i | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (Int
i, Double
t0)
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n' = (Int
i, Double
t2)
| Bool
otherwise = (Int
i, Double
t0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dt)
in (Int -> (Int, Double)) -> [Int] -> [(Int, Double)]
forall a b. (a -> b) -> [a] -> [b]
map Int -> (Int, Double)
f [Int
0 .. Int
n']
delayPoint :: Point m -> Int -> Point m
delayPoint :: forall (m :: * -> *). Point m -> Int -> Point m
delayPoint Point m
p Int
dn
| Int
dn Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = [Char] -> Point m
forall a. HasCallStack => [Char] -> a
error [Char]
"Expected the positive number of iterations: delayPoint"
| Bool
otherwise =
let sc :: Specs m
sc = Point m -> Specs m
forall (m :: * -> *). Point m -> Specs m
pointSpecs Point m
p
n :: Int
n = Point m -> Int
forall (m :: * -> *). Point m -> Int
pointIteration Point m
p
ph :: Int
ph = Point m -> Int
forall (m :: * -> *). Point m -> Int
pointPhase Point m
p
in if Int
ph Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
then let t' :: Double
t' = Point m -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point m
p Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dn Double -> Double -> Double
forall a. Num a => a -> a -> a
* Specs m -> Double
forall (m :: * -> *). Specs m -> Double
spcDT Specs m
sc
n' :: Int
n' = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Integer) -> Double -> Integer
forall a b. (a -> b) -> a -> b
$ (Double
t' Double -> Double -> Double
forall a. Num a => a -> a -> a
- Specs m -> Double
forall (m :: * -> *). Specs m -> Double
spcStartTime Specs m
sc) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Specs m -> Double
forall (m :: * -> *). Specs m -> Double
spcDT Specs m
sc
in Point m
p { pointTime = t',
pointIteration = n',
pointPhase = -1 }
else let n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dn
t' :: Double
t' = Specs m -> Int -> Int -> Double
forall (m :: * -> *). Specs m -> Int -> Int -> Double
basicTime Specs m
sc Int
n' Int
ph
in Point m
p { pointTime = t',
pointIteration = n',
pointPhase = ph }