{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleContexts #-}

-- |
-- Module     : Simulation.Aivika.Experiment.Types
-- Copyright  : Copyright (c) 2012-2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 8.0.1
--
-- The module defines the simulation experiments. They automate
-- the process of generating and analyzing the results. Moreover,
-- this module is open to extensions, allowing you to define
-- your own output views for the simulation results, for example,
-- such views that would allow saving the results in PDF or as
-- charts. To decrease the number of dependencies, such possible  
-- extenstions are not included in this package, although simple
-- views are provided.
--

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

-- | It defines the simulation experiment with the specified rendering backend and its bound data.
data Experiment = 
  Experiment { Experiment -> Specs
experimentSpecs         :: Specs,
               -- ^ The simulation specs for the experiment.
               Experiment -> ResultTransform
experimentTransform     :: ResultTransform,
               -- ^ How the results must be transformed before rendering.
               Experiment -> ResultLocalisation
experimentLocalisation  :: ResultLocalisation,
               -- ^ Specifies a localisation applied when rendering the experiment.
               Experiment -> Int
experimentRunCount      :: Int,
               -- ^ How many simulation runs should be launched.
               Experiment -> String
experimentTitle         :: String,
               -- ^ The experiment title.
               Experiment -> String
experimentDescription   :: String,
               -- ^ The experiment description.
               Experiment -> Bool
experimentVerbose       :: Bool,
               -- ^ Whether the process of generating the results is verbose.
               Experiment -> IO Int
experimentNumCapabilities :: IO Int
               -- ^ The number of threads used for the Monte-Carlo simulation
               -- if the executable was compiled with the support of multi-threading.
             }

-- | The default experiment.
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 }

-- | It allows rendering the simulation results in an arbitrary way.
class ExperimentRendering r where

  -- | Defines a context used when rendering the experiment.
  data ExperimentContext r :: *

  -- | Defines the experiment environment.
  type ExperimentEnvironment r :: *

  -- | Defines the experiment monad type.
  type ExperimentMonad r :: * -> *

  -- | Lift the experiment computation.
  liftExperiment :: r -> ExperimentMonad r a -> IO a

  -- | Prepare before rendering the experiment.
  prepareExperiment :: Experiment -> r -> ExperimentMonad r (ExperimentEnvironment r)

  -- | Render the experiment after the simulation is finished, for example,
  -- creating the @index.html@ file in the specified directory.
  renderExperiment :: Experiment -> r -> [ExperimentReporter r] -> ExperimentEnvironment r -> ExperimentMonad r ()

  -- | It is called when the experiment has been completed.
  onExperimentCompleted :: Experiment -> r -> ExperimentEnvironment r -> ExperimentMonad r () 

  -- | It is called when the experiment rendering has failed.
  onExperimentFailed :: Exception e => Experiment -> r -> ExperimentEnvironment r -> e -> ExperimentMonad r ()

-- | This is a generator of the reporter with the specified rendering backend.                     
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)
                        -- ^ Generate a reporter.
                      }

-- | Defines a view in which the simulation results should be saved.
-- You should extend this type class to define your own views such
-- as the PDF document.
class ExperimentRendering r => ExperimentView v r where
  
  -- | Create a generator of the reporter.
  outputView :: v -> ExperimentGenerator r

-- | It describes the source simulation data used in the experiment.
data ExperimentData =
  ExperimentData { ExperimentData -> Results
experimentResults :: Results,
                   -- ^ The simulation results used in the experiment.
                   ExperimentData -> ResultPredefinedSignals
experimentPredefinedSignals :: ResultPredefinedSignals
                   -- ^ The predefined signals provided by every model.
                 }

-- | Defines what creates the simulation reports by the specified renderer.
data ExperimentReporter r =
  ExperimentReporter { forall r. ExperimentReporter r -> ExperimentMonad r ()
reporterInitialise :: ExperimentMonad r (),
                       -- ^ Initialise the reporting before 
                       -- the simulation runs are started.
                       forall r. ExperimentReporter r -> ExperimentMonad r ()
reporterFinalise   :: ExperimentMonad r (),
                       -- ^ Finalise the reporting after
                       -- all simulation runs are finished.
                       forall r. ExperimentReporter r -> ExperimentData -> Composite ()
reporterSimulate   :: ExperimentData -> Composite (),
                       -- ^ Start the simulation run in the start time.
                       forall r. ExperimentReporter r -> ExperimentContext r
reporterContext    :: ExperimentContext r
                       -- ^ Return a context used by the renderer.
                     }

-- | Run the simulation experiment sequentially. For example, 
-- it can be a Monte-Carlo simulation dependentent on the external
-- 'Parameter' values.
runExperiment :: (ExperimentRendering r,
                  Monad (ExperimentMonad r),
                  MonadIO (ExperimentMonad r),
                  MonadException (ExperimentMonad r))
                 => Experiment
                 -- ^ the simulation experiment to run
                 -> [ExperimentGenerator r]
                 -- ^ generators used for rendering
                 -> r
                 -- ^ the rendering backend
                 -> Simulation Results
                 -- ^ the simulation results received from the model
                 -> 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
  
-- | Run the simulation experiment in parallel. 
--
-- Make sure that you compile with @-threaded@ and supply @+RTS -N2 -RTS@ 
-- to the generated Haskell executable on dual core processor, 
-- or you won't get any parallelism. Generally, the mentioned 
-- @N@ parameter should correspond to the number of cores for 
-- your processor.
--
-- In case of need you might want to specify the number of
-- threads directly with help of 'experimentNumCapabilities',
-- although the real number of parallel threads can depend on many
-- factors.
runExperimentParallel :: (ExperimentRendering r,
                          Monad (ExperimentMonad r),
                          MonadIO (ExperimentMonad r),
                          MonadException (ExperimentMonad r))
                         => Experiment
                         -- ^ the simulation experiment to run
                         -> [ExperimentGenerator r]
                         -- ^ generators used for rendering
                         -> r
                         -- ^ the rendering backend
                         -> Simulation Results
                         -- ^ the simulation results received from the model
                         -> 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
                        
-- | Run the simulation experiment with the specified executor.
runExperimentWithExecutor :: (ExperimentRendering r,
                              Monad (ExperimentMonad r),
                              MonadIO (ExperimentMonad r),
                              MonadException (ExperimentMonad r))
                             => ([IO ()] -> IO a)
                             -- ^ an executor that allows parallelizing the simulation if required
                             -> Experiment
                             -- ^ the simulation experiment to run
                             -> [ExperimentGenerator r]
                             -- ^ generators used for rendering
                             -> r
                             -- ^ the rendering backend
                             -> Simulation Results
                             -- ^ the simulation results received from the model
                             -> 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