{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleContexts #-}
module Simulation.Aivika.Experiment.Types where
import Control.Monad
import Control.Monad.Trans
import Control.Exception
import Control.Concurrent.ParallelIO.Local
import Data.Maybe
import Data.Monoid
import Data.Either
import GHC.Conc (getNumCapabilities)
import Simulation.Aivika
import Simulation.Aivika.Trans.Exception
data Experiment =
Experiment { Experiment -> Specs
experimentSpecs :: Specs,
Experiment -> ResultTransform
experimentTransform :: ResultTransform,
Experiment -> ResultLocalisation
experimentLocalisation :: ResultLocalisation,
Experiment -> Int
experimentRunCount :: Int,
Experiment -> String
experimentTitle :: String,
Experiment -> String
experimentDescription :: String,
Experiment -> Bool
experimentVerbose :: Bool,
Experiment -> IO Int
experimentNumCapabilities :: IO Int
}
defaultExperiment :: Experiment
defaultExperiment :: Experiment
defaultExperiment =
Experiment { experimentSpecs :: Specs
experimentSpecs = Double -> Double -> Double -> Method -> GeneratorType -> Specs
Specs Double
0 Double
10 Double
0.01 Method
RungeKutta4 GeneratorType
SimpleGenerator,
experimentTransform :: ResultTransform
experimentTransform = ResultTransform
forall a. a -> a
id,
experimentLocalisation :: ResultLocalisation
experimentLocalisation = ResultLocalisation
englishResultLocalisation,
experimentRunCount :: Int
experimentRunCount = Int
1,
experimentTitle :: String
experimentTitle = String
"Simulation Experiment",
experimentDescription :: String
experimentDescription = String
"",
experimentVerbose :: Bool
experimentVerbose = Bool
True,
experimentNumCapabilities :: IO Int
experimentNumCapabilities = IO Int
getNumCapabilities }
class ExperimentRendering r where
data ExperimentContext r :: *
type ExperimentEnvironment r :: *
type ExperimentMonad r :: * -> *
liftExperiment :: r -> ExperimentMonad r a -> IO a
prepareExperiment :: Experiment -> r -> ExperimentMonad r (ExperimentEnvironment r)
renderExperiment :: Experiment -> r -> [ExperimentReporter r] -> ExperimentEnvironment r -> ExperimentMonad r ()
onExperimentCompleted :: Experiment -> r -> ExperimentEnvironment r -> ExperimentMonad r ()
onExperimentFailed :: Exception e => Experiment -> r -> ExperimentEnvironment r -> e -> ExperimentMonad r ()
data ExperimentGenerator r =
ExperimentGenerator { forall r.
ExperimentGenerator r
-> Experiment
-> r
-> ExperimentEnvironment r
-> ExperimentMonad r (ExperimentReporter r)
generateReporter :: Experiment -> r -> ExperimentEnvironment r -> ExperimentMonad r (ExperimentReporter r)
}
class ExperimentRendering r => ExperimentView v r where
outputView :: v -> ExperimentGenerator r
data ExperimentData =
ExperimentData { ExperimentData -> Results
experimentResults :: Results,
ExperimentData -> ResultPredefinedSignals
experimentPredefinedSignals :: ResultPredefinedSignals
}
data ExperimentReporter r =
ExperimentReporter { forall r. ExperimentReporter r -> ExperimentMonad r ()
reporterInitialise :: ExperimentMonad r (),
forall r. ExperimentReporter r -> ExperimentMonad r ()
reporterFinalise :: ExperimentMonad r (),
forall r. ExperimentReporter r -> ExperimentData -> Composite ()
reporterSimulate :: ExperimentData -> Composite (),
forall r. ExperimentReporter r -> ExperimentContext r
reporterContext :: ExperimentContext r
}
runExperiment :: (ExperimentRendering r,
Monad (ExperimentMonad r),
MonadIO (ExperimentMonad r),
MonadException (ExperimentMonad r))
=> Experiment
-> [ExperimentGenerator r]
-> r
-> Simulation Results
-> IO (Either SomeException ())
{-# INLINABLE runExperiment #-}
runExperiment :: forall r.
(ExperimentRendering r, Monad (ExperimentMonad r),
MonadIO (ExperimentMonad r), MonadException (ExperimentMonad r)) =>
Experiment
-> [ExperimentGenerator r]
-> r
-> Simulation Results
-> IO (Either SomeException ())
runExperiment Experiment
e [ExperimentGenerator r]
generators r
r Simulation Results
simulation =
([IO ()] -> IO ())
-> Experiment
-> [ExperimentGenerator r]
-> r
-> Simulation Results
-> IO (Either SomeException ())
forall r a.
(ExperimentRendering r, Monad (ExperimentMonad r),
MonadIO (ExperimentMonad r), MonadException (ExperimentMonad r)) =>
([IO ()] -> IO a)
-> Experiment
-> [ExperimentGenerator r]
-> r
-> Simulation Results
-> IO (Either SomeException a)
runExperimentWithExecutor [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ Experiment
e [ExperimentGenerator r]
generators r
r Simulation Results
simulation
runExperimentParallel :: (ExperimentRendering r,
Monad (ExperimentMonad r),
MonadIO (ExperimentMonad r),
MonadException (ExperimentMonad r))
=> Experiment
-> [ExperimentGenerator r]
-> r
-> Simulation Results
-> IO (Either SomeException ())
{-# INLINABLE runExperimentParallel #-}
runExperimentParallel :: forall r.
(ExperimentRendering r, Monad (ExperimentMonad r),
MonadIO (ExperimentMonad r), MonadException (ExperimentMonad r)) =>
Experiment
-> [ExperimentGenerator r]
-> r
-> Simulation Results
-> IO (Either SomeException ())
runExperimentParallel Experiment
e [ExperimentGenerator r]
generators r
r Simulation Results
simulation =
do Either SomeException ()
x <- ([IO ()] -> IO ())
-> Experiment
-> [ExperimentGenerator r]
-> r
-> Simulation Results
-> IO (Either SomeException ())
forall r a.
(ExperimentRendering r, Monad (ExperimentMonad r),
MonadIO (ExperimentMonad r), MonadException (ExperimentMonad r)) =>
([IO ()] -> IO a)
-> Experiment
-> [ExperimentGenerator r]
-> r
-> Simulation Results
-> IO (Either SomeException a)
runExperimentWithExecutor [IO ()] -> IO ()
executor Experiment
e [ExperimentGenerator r]
generators r
r Simulation Results
simulation
Either SomeException () -> IO (Either SomeException ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SomeException ()
x Either SomeException ()
-> Either SomeException () -> Either SomeException ()
forall a b.
Either SomeException a
-> Either SomeException b -> Either SomeException b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Either SomeException ()
forall a. a -> Either SomeException a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
where executor :: [IO ()] -> IO ()
executor [IO ()]
tasks =
do Int
n <- Experiment -> IO Int
experimentNumCapabilities Experiment
e
Int -> (Pool -> IO ()) -> IO ()
forall a. Int -> (Pool -> IO a) -> IO a
withPool Int
n ((Pool -> IO ()) -> IO ()) -> (Pool -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Pool
pool ->
Pool -> [IO ()] -> IO ()
forall a. Pool -> [IO a] -> IO ()
parallel_ Pool
pool [IO ()]
tasks
runExperimentWithExecutor :: (ExperimentRendering r,
Monad (ExperimentMonad r),
MonadIO (ExperimentMonad r),
MonadException (ExperimentMonad r))
=> ([IO ()] -> IO a)
-> Experiment
-> [ExperimentGenerator r]
-> r
-> Simulation Results
-> IO (Either SomeException a)
{-# INLINABLE runExperimentWithExecutor #-}
runExperimentWithExecutor :: forall r a.
(ExperimentRendering r, Monad (ExperimentMonad r),
MonadIO (ExperimentMonad r), MonadException (ExperimentMonad r)) =>
([IO ()] -> IO a)
-> Experiment
-> [ExperimentGenerator r]
-> r
-> Simulation Results
-> IO (Either SomeException a)
runExperimentWithExecutor [IO ()] -> IO a
executor Experiment
e [ExperimentGenerator r]
generators r
r Simulation Results
simulation =
r
-> ExperimentMonad r (Either SomeException a)
-> IO (Either SomeException a)
forall a. r -> ExperimentMonad r a -> IO a
forall r a.
ExperimentRendering r =>
r -> ExperimentMonad r a -> IO a
liftExperiment r
r (ExperimentMonad r (Either SomeException a)
-> IO (Either SomeException a))
-> ExperimentMonad r (Either SomeException a)
-> IO (Either SomeException a)
forall a b. (a -> b) -> a -> b
$
do let specs :: Specs
specs = Experiment -> Specs
experimentSpecs Experiment
e
runCount :: Int
runCount = Experiment -> Int
experimentRunCount Experiment
e
ExperimentEnvironment r
env <- Experiment -> r -> ExperimentMonad r (ExperimentEnvironment r)
forall r.
ExperimentRendering r =>
Experiment -> r -> ExperimentMonad r (ExperimentEnvironment r)
prepareExperiment Experiment
e r
r
let c1 :: ExperimentMonad r (Either SomeException a)
c1 =
do [ExperimentReporter r]
reporters <- (ExperimentGenerator r -> ExperimentMonad r (ExperimentReporter r))
-> [ExperimentGenerator r]
-> ExperimentMonad r [ExperimentReporter r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\ExperimentGenerator r
x -> ExperimentGenerator r
-> Experiment
-> r
-> ExperimentEnvironment r
-> ExperimentMonad r (ExperimentReporter r)
forall r.
ExperimentGenerator r
-> Experiment
-> r
-> ExperimentEnvironment r
-> ExperimentMonad r (ExperimentReporter r)
generateReporter ExperimentGenerator r
x Experiment
e r
r ExperimentEnvironment r
env)
[ExperimentGenerator r]
generators
[ExperimentReporter r]
-> (ExperimentReporter r -> ExperimentMonad r ())
-> ExperimentMonad r ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ExperimentReporter r]
reporters ExperimentReporter r -> ExperimentMonad r ()
forall r. ExperimentReporter r -> ExperimentMonad r ()
reporterInitialise
let simulate :: Simulation ()
simulate :: Simulation ()
simulate =
do ResultPredefinedSignals
signals <- Simulation ResultPredefinedSignals
newResultPredefinedSignals
Results
results <- Simulation Results
simulation
let d :: ExperimentData
d = ExperimentData { experimentResults :: Results
experimentResults = Experiment -> ResultTransform
experimentTransform Experiment
e Results
results,
experimentPredefinedSignals :: ResultPredefinedSignals
experimentPredefinedSignals = ResultPredefinedSignals
signals }
((), DisposableEvent
fs) <- Dynamics ((), DisposableEvent) -> Simulation ((), DisposableEvent)
forall a. Dynamics a -> Simulation a
runDynamicsInStartTime (Dynamics ((), DisposableEvent)
-> Simulation ((), DisposableEvent))
-> Dynamics ((), DisposableEvent)
-> Simulation ((), DisposableEvent)
forall a b. (a -> b) -> a -> b
$
EventProcessing
-> Event ((), DisposableEvent) -> Dynamics ((), DisposableEvent)
forall a. EventProcessing -> Event a -> Dynamics a
runEventWith EventProcessing
EarlierEvents (Event ((), DisposableEvent) -> Dynamics ((), DisposableEvent))
-> Event ((), DisposableEvent) -> Dynamics ((), DisposableEvent)
forall a b. (a -> b) -> a -> b
$
(Composite () -> DisposableEvent -> Event ((), DisposableEvent))
-> DisposableEvent -> Composite () -> Event ((), DisposableEvent)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Composite () -> DisposableEvent -> Event ((), DisposableEvent)
forall a.
Composite a -> DisposableEvent -> Event (a, DisposableEvent)
runComposite DisposableEvent
forall a. Monoid a => a
mempty (Composite () -> Event ((), DisposableEvent))
-> Composite () -> Event ((), DisposableEvent)
forall a b. (a -> b) -> a -> b
$
[ExperimentReporter r]
-> (ExperimentReporter r -> Composite ()) -> Composite ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ExperimentReporter r]
reporters ((ExperimentReporter r -> Composite ()) -> Composite ())
-> (ExperimentReporter r -> Composite ()) -> Composite ()
forall a b. (a -> b) -> a -> b
$ \ExperimentReporter r
reporter ->
ExperimentReporter r -> ExperimentData -> Composite ()
forall r. ExperimentReporter r -> ExperimentData -> Composite ()
reporterSimulate ExperimentReporter r
reporter ExperimentData
d
let m1 :: Simulation ()
m1 =
Event () -> Simulation ()
forall a. Event a -> Simulation a
runEventInStopTime (Event () -> Simulation ()) -> Event () -> Simulation ()
forall a b. (a -> b) -> a -> b
$
() -> Event ()
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
m2 :: Simulation ()
m2 =
Event () -> Simulation ()
forall a. Event a -> Simulation a
runEventInStopTime (Event () -> Simulation ()) -> Event () -> Simulation ()
forall a b. (a -> b) -> a -> b
$
DisposableEvent -> Event ()
disposeEvent DisposableEvent
fs
mh :: SimulationAbort -> m ()
mh (SimulationAbort String
e') =
() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Simulation () -> Simulation () -> Simulation ()
forall a b. Simulation a -> Simulation b -> Simulation a
finallySimulation (Simulation ()
-> (SimulationAbort -> Simulation ()) -> Simulation ()
forall e a.
Exception e =>
Simulation a -> (e -> Simulation a) -> Simulation a
catchSimulation Simulation ()
m1 SimulationAbort -> Simulation ()
forall {m :: * -> *}. Monad m => SimulationAbort -> m ()
mh) Simulation ()
m2
a
a <- IO a -> ExperimentMonad r a
forall a. IO a -> ExperimentMonad r a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> ExperimentMonad r a) -> IO a -> ExperimentMonad r a
forall a b. (a -> b) -> a -> b
$
[IO ()] -> IO a
executor ([IO ()] -> IO a) -> [IO ()] -> IO a
forall a b. (a -> b) -> a -> b
$ Simulation () -> Specs -> Int -> [IO ()]
forall a. Simulation a -> Specs -> Int -> [IO a]
runSimulations Simulation ()
simulate Specs
specs Int
runCount
[ExperimentReporter r]
-> (ExperimentReporter r -> ExperimentMonad r ())
-> ExperimentMonad r ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ExperimentReporter r]
reporters ExperimentReporter r -> ExperimentMonad r ()
forall r. ExperimentReporter r -> ExperimentMonad r ()
reporterFinalise
Experiment
-> r
-> [ExperimentReporter r]
-> ExperimentEnvironment r
-> ExperimentMonad r ()
forall r.
ExperimentRendering r =>
Experiment
-> r
-> [ExperimentReporter r]
-> ExperimentEnvironment r
-> ExperimentMonad r ()
renderExperiment Experiment
e r
r [ExperimentReporter r]
reporters ExperimentEnvironment r
env
Experiment -> r -> ExperimentEnvironment r -> ExperimentMonad r ()
forall r.
ExperimentRendering r =>
Experiment -> r -> ExperimentEnvironment r -> ExperimentMonad r ()
onExperimentCompleted Experiment
e r
r ExperimentEnvironment r
env
Either SomeException a
-> ExperimentMonad r (Either SomeException a)
forall a. a -> ExperimentMonad r a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either SomeException a
forall a b. b -> Either a b
Right a
a)
ch :: SomeException -> ExperimentMonad r (Either SomeException a)
ch z :: SomeException
z@(SomeException e
e') =
do Experiment
-> r -> ExperimentEnvironment r -> e -> ExperimentMonad r ()
forall e.
Exception e =>
Experiment
-> r -> ExperimentEnvironment r -> e -> ExperimentMonad r ()
forall r e.
(ExperimentRendering r, Exception e) =>
Experiment
-> r -> ExperimentEnvironment r -> e -> ExperimentMonad r ()
onExperimentFailed Experiment
e r
r ExperimentEnvironment r
env e
e'
Either SomeException a
-> ExperimentMonad r (Either SomeException a)
forall a. a -> ExperimentMonad r a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException -> Either SomeException a
forall a b. a -> Either a b
Left SomeException
z)
ExperimentMonad r (Either SomeException a)
-> (SomeException -> ExperimentMonad r (Either SomeException a))
-> ExperimentMonad r (Either SomeException a)
forall e a.
Exception e =>
ExperimentMonad r a
-> (e -> ExperimentMonad r a) -> ExperimentMonad r a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
m a -> (e -> m a) -> m a
catchComp ExperimentMonad r (Either SomeException a)
c1 SomeException -> ExperimentMonad r (Either SomeException a)
ch