{-# LANGUAGE MultiParamTypeClasses #-}

-- |
-- Module     : Simulation.Aivika.Experiment.Base.FinalStatsView
-- 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 'FinalStatsView' that gathers the statistics
-- in the final time points for different simulation runs.
--

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

-- | Defines the 'View' that gathers the statistics
-- in the final time points.
data FinalStatsView =
  FinalStatsView { FinalStatsView -> String
finalStatsTitle       :: String,
                   -- ^ This is a title for the view.
                   FinalStatsView -> String
finalStatsDescription :: String,
                   -- ^ This is a description used in HTML.
                   FinalStatsView -> SamplingStatsWriter Double
finalStatsWriter      :: SamplingStatsWriter Double,
                   -- ^ It shows the sampling statistics.
                   FinalStatsView -> Event Bool
finalStatsPredicate   :: Event Bool,
                   -- ^ It specifies the predicate that defines
                   -- when we count data when gathering the statistics.
                   FinalStatsView -> ResultTransform
finalStatsTransform   :: ResultTransform,
                   -- ^ The transform applied to the results before receiving series.
                   FinalStatsView -> ResultTransform
finalStatsSeries      :: ResultTransform 
                   -- ^ It defines the series for which the statistics to be collected.
                 }
  
-- | The default statistics view.  
defaultFinalStatsView :: FinalStatsView
defaultFinalStatsView :: FinalStatsView
defaultFinalStatsView = 
  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      = forall a. Show a => SamplingStatsWriter a
defaultSamplingStatsWriter,
                   finalStatsPredicate :: Event Bool
finalStatsPredicate   = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True,
                   finalStatsTransform :: ResultTransform
finalStatsTransform   = forall a. a -> a
id,
                   finalStatsSeries :: ResultTransform
finalStatsSeries      = 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 =
                   forall a. WebPageWriter -> ExperimentContext (WebPageRenderer a)
WebPageContext forall a b. (a -> b) -> a -> b
$
                   WebPageWriter { reporterWriteTOCHtml :: Int -> HtmlWriter ()
reporterWriteTOCHtml = FinalStatsViewState -> Int -> HtmlWriter ()
finalStatsTOCHtml FinalStatsViewState
st,
                                   reporterWriteHtml :: Int -> HtmlWriter ()
reporterWriteHtml    = FinalStatsViewState -> Int -> HtmlWriter ()
finalStatsHtml FinalStatsViewState
st }
             forall (m :: * -> *) a. Monad m => a -> m a
return ExperimentReporter { reporterInitialise :: ExperimentMonad (WebPageRenderer a) ()
reporterInitialise = forall (m :: * -> *) a. Monad m => a -> m a
return (),
                                         reporterFinalise :: ExperimentMonad (WebPageRenderer a) ()
reporterFinalise   = forall (m :: * -> *) a. Monad m => a -> m a
return (),
                                         reporterSimulate :: ExperimentData -> Composite ()
reporterSimulate   = FinalStatsViewState -> ExperimentData -> Composite ()
simulateFinalStats FinalStatsViewState
st,
                                         reporterContext :: ExperimentContext (WebPageRenderer a)
reporterContext    = forall {a}. ExperimentContext (WebPageRenderer a)
context }
    in ExperimentGenerator { generateReporter :: Experiment
-> WebPageRenderer a
-> ExperimentEnvironment (WebPageRenderer a)
-> ExperimentMonad
     (WebPageRenderer a) (ExperimentReporter (WebPageRenderer a))
generateReporter = forall {p} {a}.
Experiment
-> p
-> String
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
reporter }
  
-- | The state of the view.
data FinalStatsViewState =
  FinalStatsViewState { FinalStatsViewState -> FinalStatsView
finalStatsView       :: FinalStatsView,
                        FinalStatsViewState -> Experiment
finalStatsExperiment :: Experiment,
                        FinalStatsViewState -> MVar (Maybe FinalStatsResults)
finalStatsResults    :: MVar (Maybe FinalStatsResults) }

-- | The statistics results.
data FinalStatsResults =
  FinalStatsResults { FinalStatsResults -> [String]
finalStatsNames  :: [String],
                      FinalStatsResults -> [MVar (SamplingStats Double)]
finalStatsValues :: [MVar (SamplingStats Double)] }
  
-- | Create a new state of the view.
newFinalStats :: FinalStatsView -> Experiment -> FilePath -> ExperimentWriter FinalStatsViewState
newFinalStats :: FinalStatsView
-> Experiment -> String -> ExperimentWriter FinalStatsViewState
newFinalStats FinalStatsView
view Experiment
exp String
dir =
  do MVar (Maybe FinalStatsResults)
r <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (MVar a)
newMVar forall a. Maybe a
Nothing
     forall (m :: * -> *) a. Monad m => a -> m a
return FinalStatsViewState { finalStatsView :: FinalStatsView
finalStatsView       = FinalStatsView
view,
                                  finalStatsExperiment :: Experiment
finalStatsExperiment = Experiment
exp,
                                  finalStatsResults :: MVar (Maybe FinalStatsResults)
finalStatsResults    = MVar (Maybe FinalStatsResults)
r }
       
-- | Create new statistics results.
newFinalStatsResults :: [String] -> Experiment -> IO FinalStatsResults
newFinalStatsResults :: [String] -> Experiment -> IO FinalStatsResults
newFinalStatsResults [String]
names Experiment
exp =
  do [MVar (SamplingStats Double)]
values <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
names forall a b. (a -> b) -> a -> b
$ \String
_ -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (MVar a)
newMVar forall a. SamplingData a => SamplingStats a
emptySamplingStats
     forall (m :: * -> *) a. Monad m => a -> m a
return FinalStatsResults { finalStatsNames :: [String]
finalStatsNames  = [String]
names,
                                finalStatsValues :: [MVar (SamplingStats Double)]
finalStatsValues = [MVar (SamplingStats Double)]
values }

-- | Require to return unique final statistics results associated with the specified state. 
requireFinalStatsResults :: FinalStatsViewState -> [String] -> IO FinalStatsResults
requireFinalStatsResults :: FinalStatsViewState -> [String] -> IO FinalStatsResults
requireFinalStatsResults FinalStatsViewState
st [String]
names =
  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)) forall a b. (a -> b) -> a -> b
$ \FinalStatsResults
results ->
  if ([String]
names forall a. Eq a => a -> a -> Bool
/= FinalStatsResults -> [String]
finalStatsNames FinalStatsResults
results)
  then forall a. HasCallStack => String -> a
error String
"Series with different names are returned for different runs: requireFinalStatsResults"
  else forall (m :: * -> *) a. Monad m => a -> m a
return FinalStatsResults
results
       
-- | Simulate the specified series.
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 forall a b. (a -> b) -> a -> b
$
                   FinalStatsView -> ResultTransform
finalStatsTransform FinalStatsView
view forall a b. (a -> b) -> a -> b
$
                   ExperimentData -> Results
experimentResults ExperimentData
expdata
         loc :: [ResultId] -> String
loc     = ResultLocalisation -> [ResultId] -> String
localisePathResultTitle forall a b. (a -> b) -> a -> b
$
                   Experiment -> ResultLocalisation
experimentLocalisation 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  = forall a. (a -> Event Bool) -> Signal a -> Signal a
filterSignalM (forall a b. a -> b -> a
const Event Bool
predicate) forall a b. (a -> b) -> a -> b
$
                   ResultPredefinedSignals -> Signal Double
resultSignalInStopTime ResultPredefinedSignals
signals
         names :: [String]
names   = forall a b. (a -> b) -> [a] -> [b]
map ([ResultId] -> String
loc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. ResultValue e -> [ResultId]
resultValueIdPath) [ResultValue (Either Double (SamplingStats Double))]
exts
         predicate :: Event Bool
predicate = FinalStatsView -> Event Bool
finalStatsPredicate FinalStatsView
view
     FinalStatsResults
results <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 
     forall a. Signal a -> (a -> Event ()) -> Composite ()
handleSignalComposite Signal Double
signal forall a b. (a -> b) -> a -> b
$ \Double
_ ->
       forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [ResultValue (Either Double (SamplingStats Double))]
exts [MVar (SamplingStats Double)]
values) forall a b. (a -> b) -> a -> b
$ \(ResultValue (Either Double (SamplingStats Double))
ext, MVar (SamplingStats Double)
value) ->
       do Either Double (SamplingStats Double)
x <- forall e. ResultValue e -> ResultData e
resultValueData ResultValue (Either Double (SamplingStats Double))
ext
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
            forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (SamplingStats Double)
value forall a b. (a -> b) -> a -> b
$ \SamplingStats Double
y ->
            let y' :: SamplingStats Double
y' = 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' seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. Monad m => a -> m a
return SamplingStats Double
y'

-- | Get the HTML code.     
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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
readMVar (FinalStatsViewState -> MVar (Maybe FinalStatsResults)
finalStatsResults FinalStatsViewState
st)
     case Maybe FinalStatsResults
results of
       Maybe FinalStatsResults
Nothing -> 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  = forall a.
SamplingStatsWriter a
-> SamplingStatsWriter a
-> String
-> SamplingStats a
-> HtmlWriter ()
samplingStatsWrite SamplingStatsWriter Double
writer
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [String]
names [MVar (SamplingStats Double)]
values) forall a b. (a -> b) -> a -> b
$ \(String
name, MVar (SamplingStats Double)
value) ->
              do SamplingStats Double
stats <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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 ()
header :: FinalStatsViewState -> Int -> HtmlWriter ()
header FinalStatsViewState
st Int
index =
  do String -> HtmlWriter () -> HtmlWriter ()
writeHtmlHeader3WithId (String
"id" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
index) forall a b. (a -> b) -> a -> b
$ 
       String -> HtmlWriter ()
writeHtmlText (FinalStatsView -> String
finalStatsTitle forall a b. (a -> b) -> a -> b
$ FinalStatsViewState -> FinalStatsView
finalStatsView FinalStatsViewState
st)
     let description :: String
description = FinalStatsView -> String
finalStatsDescription forall a b. (a -> b) -> a -> b
$ FinalStatsViewState -> FinalStatsView
finalStatsView FinalStatsViewState
st
     forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
description) forall a b. (a -> b) -> a -> b
$
       HtmlWriter () -> HtmlWriter ()
writeHtmlParagraph forall a b. (a -> b) -> a -> b
$ 
       String -> HtmlWriter ()
writeHtmlText String
description

-- | Get the TOC item.
finalStatsTOCHtml :: FinalStatsViewState -> Int -> HtmlWriter ()
finalStatsTOCHtml :: FinalStatsViewState -> Int -> HtmlWriter ()
finalStatsTOCHtml FinalStatsViewState
st Int
index =
  HtmlWriter () -> HtmlWriter ()
writeHtmlListItem forall a b. (a -> b) -> a -> b
$
  String -> HtmlWriter () -> HtmlWriter ()
writeHtmlLink (String
"#id" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
index) forall a b. (a -> b) -> a -> b
$
  String -> HtmlWriter ()
writeHtmlText (FinalStatsView -> String
finalStatsTitle forall a b. (a -> b) -> a -> b
$ FinalStatsViewState -> FinalStatsView
finalStatsView FinalStatsViewState
st)