module Simulation.Aivika.Experiment.FinalStatsView
(FinalStatsView(..),
defaultFinalStatsView) where
import Control.Monad
import Control.Monad.Trans
import Control.Concurrent.MVar
import Data.IORef
import Data.Maybe
import Simulation.Aivika
import Simulation.Aivika.Experiment.Types
import Simulation.Aivika.Experiment.WebPageRenderer
import Simulation.Aivika.Experiment.ExperimentWriter
import Simulation.Aivika.Experiment.HtmlWriter
import Simulation.Aivika.Experiment.SamplingStatsWriter
import Simulation.Aivika.Experiment.MRef
data FinalStatsView =
FinalStatsView { finalStatsTitle :: String,
finalStatsDescription :: String,
finalStatsWriter :: SamplingStatsWriter Double,
finalStatsPredicate :: Event Bool,
finalStatsTransform :: ResultTransform,
finalStatsSeries :: ResultTransform
}
defaultFinalStatsView :: FinalStatsView
defaultFinalStatsView =
FinalStatsView { finalStatsTitle = "Final Statistics",
finalStatsDescription = "Statistics is gathered in final time points for all runs.",
finalStatsWriter = defaultSamplingStatsWriter,
finalStatsPredicate = return True,
finalStatsTransform = id,
finalStatsSeries = id }
instance ExperimentView FinalStatsView (WebPageRenderer a) where
outputView v =
let reporter exp renderer dir =
do st <- newFinalStats v exp dir
let context =
WebPageContext $
WebPageWriter { reporterWriteTOCHtml = finalStatsTOCHtml st,
reporterWriteHtml = finalStatsHtml st }
return ExperimentReporter { reporterInitialise = return (),
reporterFinalise = return (),
reporterSimulate = simulateFinalStats st,
reporterContext = context }
in ExperimentGenerator { generateReporter = reporter }
data FinalStatsViewState =
FinalStatsViewState { finalStatsView :: FinalStatsView,
finalStatsExperiment :: Experiment,
finalStatsResults :: MRef (Maybe FinalStatsResults) }
data FinalStatsResults =
FinalStatsResults { finalStatsNames :: [String],
finalStatsValues :: [IORef (SamplingStats Double)] }
newFinalStats :: FinalStatsView -> Experiment -> FilePath -> ExperimentWriter FinalStatsViewState
newFinalStats view exp dir =
do r <- liftIO $ newMRef Nothing
return FinalStatsViewState { finalStatsView = view,
finalStatsExperiment = exp,
finalStatsResults = r }
newFinalStatsResults :: [String] -> Experiment -> IO FinalStatsResults
newFinalStatsResults names exp =
do values <- forM names $ \_ -> liftIO $ newIORef emptySamplingStats
return FinalStatsResults { finalStatsNames = names,
finalStatsValues = values }
requireFinalStatsResults :: FinalStatsViewState -> [String] -> IO FinalStatsResults
requireFinalStatsResults st names =
maybeWriteMRef (finalStatsResults st)
(newFinalStatsResults names (finalStatsExperiment st)) $ \results ->
if (names /= finalStatsNames results)
then error "Series with different names are returned for different runs: requireFinalStatsResults"
else return results
simulateFinalStats :: FinalStatsViewState -> ExperimentData -> Event DisposableEvent
simulateFinalStats st expdata =
do let view = finalStatsView st
rs = finalStatsSeries view $
finalStatsTransform view $
experimentResults expdata
exts = resultsToDoubleStatsEitherValues rs
signals = experimentPredefinedSignals expdata
signal = filterSignalM (const predicate) $
resultSignalInStopTime signals
names = map resultValueName exts
predicate = finalStatsPredicate view
results <- liftIO $ requireFinalStatsResults st names
let values = finalStatsValues results
handleSignal signal $ \_ ->
forM_ (zip exts values) $ \(ext, value) ->
do x <- resultValueData ext
liftIO $
do y <- readIORef value
let y' = combineSamplingStatsEither x y
y' `seq` writeIORef value y'
finalStatsHtml :: FinalStatsViewState -> Int -> HtmlWriter ()
finalStatsHtml st index =
do header st index
results <- liftIO $ readMRef (finalStatsResults st)
case results of
Nothing -> return ()
Just results ->
do let names = finalStatsNames results
values = finalStatsValues results
writer = finalStatsWriter (finalStatsView st)
write = samplingStatsWrite writer
forM_ (zip names values) $ \(name, value) ->
do stats <- liftIO $ readIORef value
write writer name stats
header :: FinalStatsViewState -> Int -> HtmlWriter ()
header st index =
do writeHtmlHeader3WithId ("id" ++ show index) $
writeHtmlText (finalStatsTitle $ finalStatsView st)
let description = finalStatsDescription $ finalStatsView st
unless (null description) $
writeHtmlParagraph $
writeHtmlText description
finalStatsTOCHtml :: FinalStatsViewState -> Int -> HtmlWriter ()
finalStatsTOCHtml st index =
writeHtmlListItem $
writeHtmlLink ("#id" ++ show index) $
writeHtmlText (finalStatsTitle $ finalStatsView st)