module Simulation.Aivika.Experiment.Types
(
Experiment(..),
ExperimentRendering(..),
defaultExperiment,
runExperiment,
runExperimentParallel,
ExperimentData(..),
ExperimentView(..),
ExperimentGenerator(..),
ExperimentReporter(..),
WebPageRendering(..),
WebPageRenderer(..),
WebPageWriter(..),
WebPageGenerator(..)) where
import Control.Monad
import Control.Monad.State
import Control.Concurrent.ParallelIO.Local
import qualified Data.Map as M
import Data.Ix
import Data.Maybe
import Data.Monoid
import qualified System.IO.UTF8 as UTF8
import System.Directory
import System.FilePath
import GHC.Conc (getNumCapabilities)
import Simulation.Aivika
import Simulation.Aivika.Experiment.HtmlWriter
import Simulation.Aivika.Experiment.Utils (replace)
import Simulation.Aivika.Experiment.ExperimentWriter
data Experiment =
Experiment { experimentSpecs :: Specs,
experimentTransform :: ResultTransform,
experimentLocalisation :: ResultLocalisation,
experimentRunCount :: Int,
experimentDirectoryName :: ExperimentFilePath,
experimentTitle :: String,
experimentDescription :: String,
experimentVerbose :: Bool,
experimentNumCapabilities :: IO Int
}
defaultExperiment :: Experiment
defaultExperiment =
Experiment { experimentSpecs = Specs 0 10 0.01 RungeKutta4 SimpleGenerator,
experimentTransform = id,
experimentLocalisation = englishResultLocalisation,
experimentRunCount = 1,
experimentDirectoryName = UniqueFilePath "experiment",
experimentTitle = "Simulation Experiment",
experimentDescription = "",
experimentVerbose = True,
experimentNumCapabilities = getNumCapabilities }
class ExperimentRendering r a | r -> a where
renderExperiment :: Experiment -> r -> [ExperimentReporter a] -> FilePath -> ExperimentWriter ()
data ExperimentGenerator r a =
ExperimentGenerator { generateReporter :: Experiment -> r -> FilePath -> ExperimentWriter (ExperimentReporter a)
}
class ExperimentRendering r a => ExperimentView v r a | r -> a where
outputView :: v -> ExperimentGenerator r a
data ExperimentData =
ExperimentData { experimentResults :: Results,
experimentPredefinedSignals :: ResultPredefinedSignals
}
data ExperimentReporter a =
ExperimentReporter { reporterInitialise :: ExperimentWriter (),
reporterFinalise :: ExperimentWriter (),
reporterSimulate :: ExperimentData -> Event DisposableEvent,
reporterRequest :: a
}
runExperiment :: ExperimentRendering r a
=> Experiment
-> [ExperimentGenerator r a]
-> r
-> Simulation Results
-> IO ()
runExperiment = runExperimentWithExecutor sequence_
runExperimentParallel :: ExperimentRendering r a
=> Experiment
-> [ExperimentGenerator r a]
-> r
-> Simulation Results
-> IO ()
runExperimentParallel e = runExperimentWithExecutor executor e
where executor tasks =
do n <- experimentNumCapabilities e
withPool n $ \pool ->
parallel_ pool tasks
runExperimentWithExecutor :: ExperimentRendering r a
=> ([IO ()] -> IO ())
-> Experiment
-> [ExperimentGenerator r a]
-> r
-> Simulation Results
-> IO ()
runExperimentWithExecutor executor e generators r simulation =
runExperimentWriter $
do let specs = experimentSpecs e
runCount = experimentRunCount e
dirName = experimentDirectoryName e
path <- resolveFilePath "" dirName
liftIO $ do
when (experimentVerbose e) $
do putStr "Updating directory "
putStrLn path
createDirectoryIfMissing True path
reporters <- mapM (\x -> generateReporter x e r path)
generators
forM_ reporters reporterInitialise
let simulate :: Simulation ()
simulate =
do signals <- newResultPredefinedSignals
results <- simulation
let d = ExperimentData { experimentResults = experimentTransform e results,
experimentPredefinedSignals = signals }
fs <- runDynamicsInStartTime $
runEventWith EarlierEvents $
forM reporters $ \reporter ->
reporterSimulate reporter d
runEventInStopTime $
disposeEvent $ mconcat fs
liftIO $
executor $ runSimulations simulate specs runCount
forM_ reporters reporterFinalise
renderExperiment e r reporters path
return ()
data WebPageRenderer = WebPageRenderer
data WebPageWriter =
WebPageWriter { reporterWriteTOCHtml :: Int -> HtmlWriter (),
reporterWriteHtml :: Int -> HtmlWriter ()
}
class ExperimentRendering r WebPageWriter => WebPageRendering r
type WebPageGenerator r = ExperimentGenerator r WebPageWriter
instance WebPageRendering WebPageRenderer
instance ExperimentRendering WebPageRenderer WebPageWriter where
renderExperiment e r reporters path =
do let html :: HtmlWriter ()
html =
writeHtmlDocumentWithTitle (experimentTitle e) $
do writeHtmlList $
forM_ (zip [1..] reporters) $ \(i, reporter) ->
reporterWriteTOCHtml (reporterRequest reporter) i
writeHtmlBreak
unless (null $ experimentDescription e) $
writeHtmlParagraph $
writeHtmlText $ experimentDescription e
forM_ (zip [1..] reporters) $ \(i, reporter) ->
reporterWriteHtml (reporterRequest reporter) i
file = combine path "index.html"
((), contents) <- runHtmlWriter html id
liftIO $ do
UTF8.writeFile file (contents [])
when (experimentVerbose e) $
do putStr "Generated file "
putStrLn file