module Simulation.Aivika.Dynamics.Internal.Simulation
(
Simulation(..),
SimulationLift(..),
Specs(..),
Method(..),
Run(..),
runSimulation,
runSimulations,
simulationIndex,
simulationCount,
simulationSpecs) where
import Control.Monad
import Control.Monad.Trans
newtype Simulation a = Simulation (Run -> IO a)
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
} deriving (Eq, Ord, Show)
instance Monad Simulation where
return = returnS
m >>= k = bindS m k
returnS :: a -> Simulation a
returnS a = Simulation (\r -> return a)
bindS :: Simulation a -> (a -> Simulation b) -> Simulation b
bindS (Simulation m) k =
Simulation $ \r ->
do a <- m r
let Simulation m' = k a
m' r
runSimulation :: Simulation a -> Specs -> IO a
runSimulation (Simulation m) sc =
m Run { runSpecs = sc,
runIndex = 1,
runCount = 1 }
runSimulations :: Simulation a -> Specs -> Int -> [IO a]
runSimulations (Simulation m) sc runs = map f [1 .. runs]
where f i = m Run { runSpecs = sc,
runIndex = i,
runCount = runs }
simulationIndex :: Simulation Int
simulationIndex = Simulation $ return . runIndex
simulationCount :: Simulation Int
simulationCount = Simulation $ return . runCount
simulationSpecs :: Simulation Specs
simulationSpecs = Simulation $ return . runSpecs
instance Functor Simulation where
fmap = liftMS
liftMS :: (a -> b) -> Simulation a -> Simulation b
liftMS f (Simulation x) =
Simulation $ \r -> do { a <- x r; return $ f a }
instance MonadIO Simulation where
liftIO m = Simulation $ const m
class Monad m => SimulationLift m where
liftSimulation :: Simulation a -> m a