{-# LANGUAGE TypeFamilies #-}

-- |
-- Module     : Simulation.Aivika.Trans.Internal.Specs
-- Copyright  : Copyright (c) 2009-2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 8.0.1
--
-- It defines the simulation specs and related stuff.
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

-- | Returns the integration iterations starting from zero.
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

-- | Returns the first and last integration iterations.
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

-- | Returns the first integration iteration, i.e. zero.
integIterationLoBnd :: Specs m -> Int
integIterationLoBnd :: forall (m :: * -> *). Specs m -> Int
integIterationLoBnd Specs m
sc = Int
0

-- | Returns the last integration iteration.
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

-- | Returns the phases for the specified simulation specs starting from zero.
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]

-- | Returns the first and last integration phases.
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)

-- | Returns the first integration phase, i.e. zero.
integPhaseLoBnd :: Specs m -> Int
integPhaseLoBnd :: forall (m :: * -> *). Specs m -> Int
integPhaseLoBnd Specs m
sc = Int
0
                  
-- | Returns the last integration phase, 0 for Euler's method, 1 for RK2 and 3 for RK4.
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

-- | Returns a simulation time for the integration point specified by 
-- the specs, iteration and phase.
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

-- | Return the integration time values.
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

-- | Return the integration time points.
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 }

-- | Return the start time point.
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 }

-- | Return the integration stop time point.
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 }

-- | Return the simulation stop time point.
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

-- | Return the point at the specified time.
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 }

-- | Return the integration time points starting from the specified iteration.
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 }

-- | Return the indexed time values in the grid by specified size.
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']

-- | Delay the point by the specified positive number of iterations.
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 }