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.Experiment.Types
import Simulation.Aivika.Experiment.HtmlWriter
import Simulation.Aivika.Experiment.SamplingStatsWriter
import Simulation.Aivika.Experiment.SamplingStatsSource
import Simulation.Aivika.Specs
import Simulation.Aivika.Simulation
import Simulation.Aivika.Event
import Simulation.Aivika.Signal
import Simulation.Aivika.Statistics
data FinalStatsView =
FinalStatsView { finalStatsTitle :: String,
finalStatsDescription :: String,
finalStatsWriter :: SamplingStatsWriter Double,
finalStatsPredicate :: Event Bool,
finalStatsSeries :: [String]
}
defaultFinalStatsView :: FinalStatsView
defaultFinalStatsView =
FinalStatsView { finalStatsTitle = "Final Statistics",
finalStatsDescription = "The statistical data are gathered in the final time points for all runs.",
finalStatsWriter = defaultSamplingStatsWriter,
finalStatsPredicate = return True,
finalStatsSeries = [] }
instance ExperimentView FinalStatsView where
outputView v =
let reporter exp dir =
do st <- newFinalStats v exp dir
return ExperimentReporter { reporterInitialise = return (),
reporterFinalise = return (),
reporterSimulate = simulateFinalStats st,
reporterTOCHtml = finalStatsTOCHtml st,
reporterHtml = finalStatsHtml st }
in ExperimentGenerator { generateReporter = reporter }
data FinalStatsViewState =
FinalStatsViewState { finalStatsView :: FinalStatsView,
finalStatsExperiment :: Experiment,
finalStatsLock :: MVar (),
finalStatsResults :: IORef (Maybe FinalStatsResults) }
data FinalStatsResults =
FinalStatsResults { finalStatsNames :: [String],
finalStatsValues :: [IORef (SamplingStats Double)] }
newFinalStats :: FinalStatsView -> Experiment -> FilePath -> IO FinalStatsViewState
newFinalStats view exp dir =
do l <- newMVar ()
r <- newIORef Nothing
return FinalStatsViewState { finalStatsView = view,
finalStatsExperiment = exp,
finalStatsLock = l,
finalStatsResults = r }
newFinalStatsResults :: [String] -> Experiment -> IO FinalStatsResults
newFinalStatsResults names exp =
do values <- forM names $ \_ -> liftIO $ newIORef emptySamplingStats
return FinalStatsResults { finalStatsNames = names,
finalStatsValues = values }
simulateFinalStats :: FinalStatsViewState -> ExperimentData -> Event (Event ())
simulateFinalStats st expdata =
do let protolabels = finalStatsSeries $ finalStatsView st
protoproviders = flip map protolabels $ \protolabel ->
experimentSeriesProviders expdata [protolabel]
providers = concat protoproviders
input =
flip map providers $ \provider ->
case providerToDoubleStatsSource provider of
Nothing -> error $
"Cannot represent series " ++
providerName provider ++
" as a source of double values: simulateFinalStats"
Just input -> samplingStatsSourceData input
names = map providerName providers
predicate = finalStatsPredicate $ finalStatsView st
exp = finalStatsExperiment st
lock = finalStatsLock st
results <- liftIO $ readIORef (finalStatsResults st)
case results of
Nothing ->
liftIO $
do results <- newFinalStatsResults names exp
writeIORef (finalStatsResults st) $ Just results
Just results ->
when (names /= finalStatsNames results) $
error "Series with different names are returned for different runs: simulateFinalStats"
results <- liftIO $ fmap fromJust $ readIORef (finalStatsResults st)
let values = finalStatsValues results
h = filterSignalM (const predicate) $
experimentSignalInStopTime expdata
handleSignal_ h $ \_ ->
do xs <- sequence input
liftIO $ withMVar lock $ \() ->
forM_ (zip xs values) $ \(x, values) ->
do y <- readIORef values
let y' = addDataToSamplingStats x y
y' `seq` writeIORef values y'
return $ return ()
finalStatsHtml :: FinalStatsViewState -> Int -> HtmlWriter ()
finalStatsHtml st index =
do header st index
results <- liftIO $ readIORef (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)