{-# LANGUAGE MultiParamTypeClasses #-}
module Simulation.Aivika.Experiment.Base.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.Base.WebPageRenderer
import Simulation.Aivika.Experiment.Base.ExperimentWriter
import Simulation.Aivika.Experiment.Base.HtmlWriter
import Simulation.Aivika.Experiment.Base.SamplingStatsWriter
import Simulation.Aivika.Experiment.Concurrent.MVar
data FinalStatsView =
FinalStatsView { FinalStatsView -> String
finalStatsTitle :: String,
FinalStatsView -> String
finalStatsDescription :: String,
FinalStatsView -> SamplingStatsWriter Double
finalStatsWriter :: SamplingStatsWriter Double,
FinalStatsView -> Event Bool
finalStatsPredicate :: Event Bool,
FinalStatsView -> ResultTransform
finalStatsTransform :: ResultTransform,
FinalStatsView -> ResultTransform
finalStatsSeries :: ResultTransform
}
defaultFinalStatsView :: FinalStatsView
defaultFinalStatsView :: FinalStatsView
defaultFinalStatsView =
FinalStatsView :: String
-> String
-> SamplingStatsWriter Double
-> Event Bool
-> ResultTransform
-> ResultTransform
-> FinalStatsView
FinalStatsView { finalStatsTitle :: String
finalStatsTitle = String
"Final Statistics Based on Observations",
finalStatsDescription :: String
finalStatsDescription = String
"Statistics is gathered in final time points for all runs.",
finalStatsWriter :: SamplingStatsWriter Double
finalStatsWriter = SamplingStatsWriter Double
forall a. Show a => SamplingStatsWriter a
defaultSamplingStatsWriter,
finalStatsPredicate :: Event Bool
finalStatsPredicate = Bool -> Event Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True,
finalStatsTransform :: ResultTransform
finalStatsTransform = ResultTransform
forall a. a -> a
id,
finalStatsSeries :: ResultTransform
finalStatsSeries = ResultTransform
forall a. a -> a
id }
instance ExperimentView FinalStatsView (WebPageRenderer a) where
outputView :: FinalStatsView -> ExperimentGenerator (WebPageRenderer a)
outputView FinalStatsView
v =
let reporter :: Experiment
-> p
-> String
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
reporter Experiment
exp p
renderer String
dir =
do FinalStatsViewState
st <- FinalStatsView
-> Experiment -> String -> ExperimentWriter FinalStatsViewState
newFinalStats FinalStatsView
v Experiment
exp String
dir
let context :: ExperimentContext (WebPageRenderer a)
context =
WebPageWriter -> ExperimentContext (WebPageRenderer a)
forall a. WebPageWriter -> ExperimentContext (WebPageRenderer a)
WebPageContext (WebPageWriter -> ExperimentContext (WebPageRenderer a))
-> WebPageWriter -> ExperimentContext (WebPageRenderer a)
forall a b. (a -> b) -> a -> b
$
WebPageWriter :: (Int -> HtmlWriter ()) -> (Int -> HtmlWriter ()) -> WebPageWriter
WebPageWriter { reporterWriteTOCHtml :: Int -> HtmlWriter ()
reporterWriteTOCHtml = FinalStatsViewState -> Int -> HtmlWriter ()
finalStatsTOCHtml FinalStatsViewState
st,
reporterWriteHtml :: Int -> HtmlWriter ()
reporterWriteHtml = FinalStatsViewState -> Int -> HtmlWriter ()
finalStatsHtml FinalStatsViewState
st }
ExperimentReporter (WebPageRenderer a)
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
forall (m :: * -> *) a. Monad m => a -> m a
return ExperimentReporter :: forall r.
ExperimentMonad r ()
-> ExperimentMonad r ()
-> (ExperimentData -> Composite ())
-> ExperimentContext r
-> ExperimentReporter r
ExperimentReporter { reporterInitialise :: ExperimentMonad (WebPageRenderer a) ()
reporterInitialise = () -> ExperimentWriter ()
forall (m :: * -> *) a. Monad m => a -> m a
return (),
reporterFinalise :: ExperimentMonad (WebPageRenderer a) ()
reporterFinalise = () -> ExperimentWriter ()
forall (m :: * -> *) a. Monad m => a -> m a
return (),
reporterSimulate :: ExperimentData -> Composite ()
reporterSimulate = FinalStatsViewState -> ExperimentData -> Composite ()
simulateFinalStats FinalStatsViewState
st,
reporterContext :: ExperimentContext (WebPageRenderer a)
reporterContext = ExperimentContext (WebPageRenderer a)
forall a. ExperimentContext (WebPageRenderer a)
context }
in ExperimentGenerator :: forall r.
(Experiment
-> r
-> ExperimentEnvironment r
-> ExperimentMonad r (ExperimentReporter r))
-> ExperimentGenerator r
ExperimentGenerator { generateReporter :: Experiment
-> WebPageRenderer a
-> ExperimentEnvironment (WebPageRenderer a)
-> ExperimentMonad
(WebPageRenderer a) (ExperimentReporter (WebPageRenderer a))
generateReporter = Experiment
-> WebPageRenderer a
-> ExperimentEnvironment (WebPageRenderer a)
-> ExperimentMonad
(WebPageRenderer a) (ExperimentReporter (WebPageRenderer a))
forall p a.
Experiment
-> p
-> String
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
reporter }
data FinalStatsViewState =
FinalStatsViewState { FinalStatsViewState -> FinalStatsView
finalStatsView :: FinalStatsView,
FinalStatsViewState -> Experiment
finalStatsExperiment :: Experiment,
FinalStatsViewState -> MVar (Maybe FinalStatsResults)
finalStatsResults :: MVar (Maybe FinalStatsResults) }
data FinalStatsResults =
FinalStatsResults { FinalStatsResults -> [String]
finalStatsNames :: [String],
FinalStatsResults -> [MVar (SamplingStats Double)]
finalStatsValues :: [MVar (SamplingStats Double)] }
newFinalStats :: FinalStatsView -> Experiment -> FilePath -> ExperimentWriter FinalStatsViewState
newFinalStats :: FinalStatsView
-> Experiment -> String -> ExperimentWriter FinalStatsViewState
newFinalStats FinalStatsView
view Experiment
exp String
dir =
do MVar (Maybe FinalStatsResults)
r <- IO (MVar (Maybe FinalStatsResults))
-> ExperimentWriter (MVar (Maybe FinalStatsResults))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar (Maybe FinalStatsResults))
-> ExperimentWriter (MVar (Maybe FinalStatsResults)))
-> IO (MVar (Maybe FinalStatsResults))
-> ExperimentWriter (MVar (Maybe FinalStatsResults))
forall a b. (a -> b) -> a -> b
$ Maybe FinalStatsResults -> IO (MVar (Maybe FinalStatsResults))
forall a. a -> IO (MVar a)
newMVar Maybe FinalStatsResults
forall a. Maybe a
Nothing
FinalStatsViewState -> ExperimentWriter FinalStatsViewState
forall (m :: * -> *) a. Monad m => a -> m a
return FinalStatsViewState :: FinalStatsView
-> Experiment
-> MVar (Maybe FinalStatsResults)
-> FinalStatsViewState
FinalStatsViewState { finalStatsView :: FinalStatsView
finalStatsView = FinalStatsView
view,
finalStatsExperiment :: Experiment
finalStatsExperiment = Experiment
exp,
finalStatsResults :: MVar (Maybe FinalStatsResults)
finalStatsResults = MVar (Maybe FinalStatsResults)
r }
newFinalStatsResults :: [String] -> Experiment -> IO FinalStatsResults
newFinalStatsResults :: [String] -> Experiment -> IO FinalStatsResults
newFinalStatsResults [String]
names Experiment
exp =
do [MVar (SamplingStats Double)]
values <- [String]
-> (String -> IO (MVar (SamplingStats Double)))
-> IO [MVar (SamplingStats Double)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
names ((String -> IO (MVar (SamplingStats Double)))
-> IO [MVar (SamplingStats Double)])
-> (String -> IO (MVar (SamplingStats Double)))
-> IO [MVar (SamplingStats Double)]
forall a b. (a -> b) -> a -> b
$ \String
_ -> IO (MVar (SamplingStats Double))
-> IO (MVar (SamplingStats Double))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar (SamplingStats Double))
-> IO (MVar (SamplingStats Double)))
-> IO (MVar (SamplingStats Double))
-> IO (MVar (SamplingStats Double))
forall a b. (a -> b) -> a -> b
$ SamplingStats Double -> IO (MVar (SamplingStats Double))
forall a. a -> IO (MVar a)
newMVar SamplingStats Double
forall a. SamplingData a => SamplingStats a
emptySamplingStats
FinalStatsResults -> IO FinalStatsResults
forall (m :: * -> *) a. Monad m => a -> m a
return FinalStatsResults :: [String] -> [MVar (SamplingStats Double)] -> FinalStatsResults
FinalStatsResults { finalStatsNames :: [String]
finalStatsNames = [String]
names,
finalStatsValues :: [MVar (SamplingStats Double)]
finalStatsValues = [MVar (SamplingStats Double)]
values }
requireFinalStatsResults :: FinalStatsViewState -> [String] -> IO FinalStatsResults
requireFinalStatsResults :: FinalStatsViewState -> [String] -> IO FinalStatsResults
requireFinalStatsResults FinalStatsViewState
st [String]
names =
MVar (Maybe FinalStatsResults)
-> IO FinalStatsResults
-> (FinalStatsResults -> IO FinalStatsResults)
-> IO FinalStatsResults
forall a b. MVar (Maybe a) -> IO a -> (a -> IO b) -> IO b
maybePutMVar (FinalStatsViewState -> MVar (Maybe FinalStatsResults)
finalStatsResults FinalStatsViewState
st)
([String] -> Experiment -> IO FinalStatsResults
newFinalStatsResults [String]
names (FinalStatsViewState -> Experiment
finalStatsExperiment FinalStatsViewState
st)) ((FinalStatsResults -> IO FinalStatsResults)
-> IO FinalStatsResults)
-> (FinalStatsResults -> IO FinalStatsResults)
-> IO FinalStatsResults
forall a b. (a -> b) -> a -> b
$ \FinalStatsResults
results ->
if ([String]
names [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= FinalStatsResults -> [String]
finalStatsNames FinalStatsResults
results)
then String -> IO FinalStatsResults
forall a. HasCallStack => String -> a
error String
"Series with different names are returned for different runs: requireFinalStatsResults"
else FinalStatsResults -> IO FinalStatsResults
forall (m :: * -> *) a. Monad m => a -> m a
return FinalStatsResults
results
simulateFinalStats :: FinalStatsViewState -> ExperimentData -> Composite ()
simulateFinalStats :: FinalStatsViewState -> ExperimentData -> Composite ()
simulateFinalStats FinalStatsViewState
st ExperimentData
expdata =
do let view :: FinalStatsView
view = FinalStatsViewState -> FinalStatsView
finalStatsView FinalStatsViewState
st
rs :: Results
rs = FinalStatsView -> ResultTransform
finalStatsSeries FinalStatsView
view ResultTransform -> ResultTransform
forall a b. (a -> b) -> a -> b
$
FinalStatsView -> ResultTransform
finalStatsTransform FinalStatsView
view ResultTransform -> ResultTransform
forall a b. (a -> b) -> a -> b
$
ExperimentData -> Results
experimentResults ExperimentData
expdata
loc :: [ResultId] -> String
loc = ResultLocalisation -> [ResultId] -> String
localisePathResultTitle (ResultLocalisation -> [ResultId] -> String)
-> ResultLocalisation -> [ResultId] -> String
forall a b. (a -> b) -> a -> b
$
Experiment -> ResultLocalisation
experimentLocalisation (Experiment -> ResultLocalisation)
-> Experiment -> ResultLocalisation
forall a b. (a -> b) -> a -> b
$
FinalStatsViewState -> Experiment
finalStatsExperiment FinalStatsViewState
st
exts :: [ResultValue (Either Double (SamplingStats Double))]
exts = Results -> [ResultValue (Either Double (SamplingStats Double))]
resultsToDoubleStatsEitherValues Results
rs
signals :: ResultPredefinedSignals
signals = ExperimentData -> ResultPredefinedSignals
experimentPredefinedSignals ExperimentData
expdata
signal :: Signal Double
signal = (Double -> Event Bool) -> Signal Double -> Signal Double
forall a. (a -> Event Bool) -> Signal a -> Signal a
filterSignalM (Event Bool -> Double -> Event Bool
forall a b. a -> b -> a
const Event Bool
predicate) (Signal Double -> Signal Double) -> Signal Double -> Signal Double
forall a b. (a -> b) -> a -> b
$
ResultPredefinedSignals -> Signal Double
resultSignalInStopTime ResultPredefinedSignals
signals
names :: [String]
names = (ResultValue (Either Double (SamplingStats Double)) -> String)
-> [ResultValue (Either Double (SamplingStats Double))] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([ResultId] -> String
loc ([ResultId] -> String)
-> (ResultValue (Either Double (SamplingStats Double))
-> [ResultId])
-> ResultValue (Either Double (SamplingStats Double))
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResultValue (Either Double (SamplingStats Double)) -> [ResultId]
forall e. ResultValue e -> [ResultId]
resultValueIdPath) [ResultValue (Either Double (SamplingStats Double))]
exts
predicate :: Event Bool
predicate = FinalStatsView -> Event Bool
finalStatsPredicate FinalStatsView
view
FinalStatsResults
results <- IO FinalStatsResults -> Composite FinalStatsResults
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FinalStatsResults -> Composite FinalStatsResults)
-> IO FinalStatsResults -> Composite FinalStatsResults
forall a b. (a -> b) -> a -> b
$ FinalStatsViewState -> [String] -> IO FinalStatsResults
requireFinalStatsResults FinalStatsViewState
st [String]
names
let values :: [MVar (SamplingStats Double)]
values = FinalStatsResults -> [MVar (SamplingStats Double)]
finalStatsValues FinalStatsResults
results
Signal Double -> (Double -> Event ()) -> Composite ()
forall a. Signal a -> (a -> Event ()) -> Composite ()
handleSignalComposite Signal Double
signal ((Double -> Event ()) -> Composite ())
-> (Double -> Event ()) -> Composite ()
forall a b. (a -> b) -> a -> b
$ \Double
_ ->
[(ResultValue (Either Double (SamplingStats Double)),
MVar (SamplingStats Double))]
-> ((ResultValue (Either Double (SamplingStats Double)),
MVar (SamplingStats Double))
-> Event ())
-> Event ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([ResultValue (Either Double (SamplingStats Double))]
-> [MVar (SamplingStats Double)]
-> [(ResultValue (Either Double (SamplingStats Double)),
MVar (SamplingStats Double))]
forall a b. [a] -> [b] -> [(a, b)]
zip [ResultValue (Either Double (SamplingStats Double))]
exts [MVar (SamplingStats Double)]
values) (((ResultValue (Either Double (SamplingStats Double)),
MVar (SamplingStats Double))
-> Event ())
-> Event ())
-> ((ResultValue (Either Double (SamplingStats Double)),
MVar (SamplingStats Double))
-> Event ())
-> Event ()
forall a b. (a -> b) -> a -> b
$ \(ResultValue (Either Double (SamplingStats Double))
ext, MVar (SamplingStats Double)
value) ->
do Either Double (SamplingStats Double)
x <- ResultValue (Either Double (SamplingStats Double))
-> ResultData (Either Double (SamplingStats Double))
forall e. ResultValue e -> ResultData e
resultValueData ResultValue (Either Double (SamplingStats Double))
ext
IO () -> Event ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Event ()) -> IO () -> Event ()
forall a b. (a -> b) -> a -> b
$
MVar (SamplingStats Double)
-> (SamplingStats Double -> IO (SamplingStats Double)) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (SamplingStats Double)
value ((SamplingStats Double -> IO (SamplingStats Double)) -> IO ())
-> (SamplingStats Double -> IO (SamplingStats Double)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \SamplingStats Double
y ->
let y' :: SamplingStats Double
y' = Either Double (SamplingStats Double)
-> SamplingStats Double -> SamplingStats Double
forall a.
SamplingData a =>
Either a (SamplingStats a) -> SamplingStats a -> SamplingStats a
combineSamplingStatsEither Either Double (SamplingStats Double)
x SamplingStats Double
y
in SamplingStats Double
y' SamplingStats Double
-> IO (SamplingStats Double) -> IO (SamplingStats Double)
`seq` SamplingStats Double -> IO (SamplingStats Double)
forall (m :: * -> *) a. Monad m => a -> m a
return SamplingStats Double
y'
finalStatsHtml :: FinalStatsViewState -> Int -> HtmlWriter ()
finalStatsHtml :: FinalStatsViewState -> Int -> HtmlWriter ()
finalStatsHtml FinalStatsViewState
st Int
index =
do FinalStatsViewState -> Int -> HtmlWriter ()
header FinalStatsViewState
st Int
index
Maybe FinalStatsResults
results <- IO (Maybe FinalStatsResults)
-> HtmlWriter (Maybe FinalStatsResults)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FinalStatsResults)
-> HtmlWriter (Maybe FinalStatsResults))
-> IO (Maybe FinalStatsResults)
-> HtmlWriter (Maybe FinalStatsResults)
forall a b. (a -> b) -> a -> b
$ MVar (Maybe FinalStatsResults) -> IO (Maybe FinalStatsResults)
forall a. MVar a -> IO a
readMVar (FinalStatsViewState -> MVar (Maybe FinalStatsResults)
finalStatsResults FinalStatsViewState
st)
case Maybe FinalStatsResults
results of
Maybe FinalStatsResults
Nothing -> () -> HtmlWriter ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just FinalStatsResults
results ->
do let names :: [String]
names = FinalStatsResults -> [String]
finalStatsNames FinalStatsResults
results
values :: [MVar (SamplingStats Double)]
values = FinalStatsResults -> [MVar (SamplingStats Double)]
finalStatsValues FinalStatsResults
results
writer :: SamplingStatsWriter Double
writer = FinalStatsView -> SamplingStatsWriter Double
finalStatsWriter (FinalStatsViewState -> FinalStatsView
finalStatsView FinalStatsViewState
st)
write :: SamplingStatsWriter Double
-> String -> SamplingStats Double -> HtmlWriter ()
write = SamplingStatsWriter Double
-> SamplingStatsWriter Double
-> String
-> SamplingStats Double
-> HtmlWriter ()
forall a.
SamplingStatsWriter a
-> SamplingStatsWriter a
-> String
-> SamplingStats a
-> HtmlWriter ()
samplingStatsWrite SamplingStatsWriter Double
writer
[(String, MVar (SamplingStats Double))]
-> ((String, MVar (SamplingStats Double)) -> HtmlWriter ())
-> HtmlWriter ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([String]
-> [MVar (SamplingStats Double)]
-> [(String, MVar (SamplingStats Double))]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
names [MVar (SamplingStats Double)]
values) (((String, MVar (SamplingStats Double)) -> HtmlWriter ())
-> HtmlWriter ())
-> ((String, MVar (SamplingStats Double)) -> HtmlWriter ())
-> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$ \(String
name, MVar (SamplingStats Double)
value) ->
do SamplingStats Double
stats <- IO (SamplingStats Double) -> HtmlWriter (SamplingStats Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SamplingStats Double) -> HtmlWriter (SamplingStats Double))
-> IO (SamplingStats Double) -> HtmlWriter (SamplingStats Double)
forall a b. (a -> b) -> a -> b
$ MVar (SamplingStats Double) -> IO (SamplingStats Double)
forall a. MVar a -> IO a
readMVar MVar (SamplingStats Double)
value
SamplingStatsWriter Double
-> String -> SamplingStats Double -> HtmlWriter ()
write SamplingStatsWriter Double
writer String
name SamplingStats Double
stats
header :: FinalStatsViewState -> Int -> HtmlWriter ()
FinalStatsViewState
st Int
index =
do String -> HtmlWriter () -> HtmlWriter ()
writeHtmlHeader3WithId (String
"id" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
index) (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
String -> HtmlWriter ()
writeHtmlText (FinalStatsView -> String
finalStatsTitle (FinalStatsView -> String) -> FinalStatsView -> String
forall a b. (a -> b) -> a -> b
$ FinalStatsViewState -> FinalStatsView
finalStatsView FinalStatsViewState
st)
let description :: String
description = FinalStatsView -> String
finalStatsDescription (FinalStatsView -> String) -> FinalStatsView -> String
forall a b. (a -> b) -> a -> b
$ FinalStatsViewState -> FinalStatsView
finalStatsView FinalStatsViewState
st
Bool -> HtmlWriter () -> HtmlWriter ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
description) (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
HtmlWriter () -> HtmlWriter ()
writeHtmlParagraph (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
String -> HtmlWriter ()
writeHtmlText String
description
finalStatsTOCHtml :: FinalStatsViewState -> Int -> HtmlWriter ()
finalStatsTOCHtml :: FinalStatsViewState -> Int -> HtmlWriter ()
finalStatsTOCHtml FinalStatsViewState
st Int
index =
HtmlWriter () -> HtmlWriter ()
writeHtmlListItem (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
String -> HtmlWriter () -> HtmlWriter ()
writeHtmlLink (String
"#id" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
index) (HtmlWriter () -> HtmlWriter ()) -> HtmlWriter () -> HtmlWriter ()
forall a b. (a -> b) -> a -> b
$
String -> HtmlWriter ()
writeHtmlText (FinalStatsView -> String
finalStatsTitle (FinalStatsView -> String) -> FinalStatsView -> String
forall a b. (a -> b) -> a -> b
$ FinalStatsViewState -> FinalStatsView
finalStatsView FinalStatsViewState
st)