{-# LANGUAGE MultiParamTypeClasses #-}

-- |
-- Module     : Simulation.Aivika.Experiment.Base.TimingStatsView
-- 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 'TimingStatsView' that shows the timing statistics
-- for the variables for every simulation run separately.
--

module Simulation.Aivika.Experiment.Base.TimingStatsView 
       (TimingStatsView(..),
        defaultTimingStatsView) where

import Control.Monad
import Control.Monad.Trans

import qualified Data.Map as M
import Data.IORef
import Data.Maybe
import Data.Monoid

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.TimingStatsWriter
import Simulation.Aivika.Experiment.Utils (replace)

-- | Defines the 'View' that shows the timing statistics
-- for variables for every simulation run separately.
data TimingStatsView =
  TimingStatsView { TimingStatsView -> String
timingStatsTitle       :: String,
                    -- ^ The title for the view.
                    TimingStatsView -> String
timingStatsRunTitle    :: String,
                    -- ^ The run title for the view. It may include
                    -- special variables @$RUN_INDEX@, @$RUN_COUNT@ and 
                    -- @$TITLE@.
                    --
                    -- An example is 
                    --
                    -- @
                    --   timingStatsRunTitle = \"$TITLE / Run $RUN_INDEX of $RUN_COUNT\"
                    -- @
                    TimingStatsView -> String
timingStatsDescription :: String,
                    -- ^ The description for the view.
                    TimingStatsView -> TimingStatsWriter Double
timingStatsWriter      :: TimingStatsWriter Double,
                    -- ^ It shows the timing statistics.
                    TimingStatsView -> Event Bool
timingStatsPredicate   :: Event Bool,
                    -- ^ Specifies when gathering the statistics.
                    TimingStatsView -> ResultTransform
timingStatsTransform   :: ResultTransform,
                    -- ^ The transform applied to the results before receiving series.
                    TimingStatsView -> ResultTransform
timingStatsSeries      :: ResultTransform 
                    -- ^ It defines the series for which the statistics to be collected.
                  }
  
-- | This is the default view.
defaultTimingStatsView :: TimingStatsView
defaultTimingStatsView :: TimingStatsView
defaultTimingStatsView =  
  TimingStatsView { timingStatsTitle :: String
timingStatsTitle       = String
"Statistics for Time-Persistent Variables",
                    timingStatsRunTitle :: String
timingStatsRunTitle    = String
"$TITLE / Run $RUN_INDEX of $RUN_COUNT",
                    timingStatsDescription :: String
timingStatsDescription = String
"The statistical data are gathered in the time points.",
                    timingStatsWriter :: TimingStatsWriter Double
timingStatsWriter      = forall a. (Show a, TimingData a) => TimingStatsWriter a
defaultTimingStatsWriter,
                    timingStatsPredicate :: Event Bool
timingStatsPredicate   = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True,
                    timingStatsTransform :: ResultTransform
timingStatsTransform   = forall a. a -> a
id,
                    timingStatsSeries :: ResultTransform
timingStatsSeries      = forall a. a -> a
id }

instance ExperimentView TimingStatsView (WebPageRenderer a) where  
  
  outputView :: TimingStatsView -> ExperimentGenerator (WebPageRenderer a)
outputView TimingStatsView
v = 
    let reporter :: Experiment
-> p
-> p
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
reporter Experiment
exp p
renderer p
dir =
          do TimingStatsViewState
st <- TimingStatsView
-> Experiment -> ExperimentWriter TimingStatsViewState
newTimingStats TimingStatsView
v Experiment
exp
             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 = TimingStatsViewState -> Int -> HtmlWriter ()
timingStatsTOCHtml TimingStatsViewState
st,
                                   reporterWriteHtml :: Int -> HtmlWriter ()
reporterWriteHtml    = TimingStatsViewState -> Int -> HtmlWriter ()
timingStatsHtml TimingStatsViewState
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   = TimingStatsViewState -> ExperimentData -> Composite ()
simulateTimingStats TimingStatsViewState
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} {p} {a}.
Experiment
-> p
-> p
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
reporter }
  
-- | The state of the view.
data TimingStatsViewState =
  TimingStatsViewState { TimingStatsViewState -> TimingStatsView
timingStatsView       :: TimingStatsView,
                         TimingStatsViewState -> Experiment
timingStatsExperiment :: Experiment,
                         TimingStatsViewState
-> Map Int (IORef [(String, IORef (TimingStats Double))])
timingStatsMap        :: M.Map Int (IORef [(String, IORef (TimingStats Double))]) }
  
-- | Create a new state of the view.
newTimingStats :: TimingStatsView -> Experiment -> ExperimentWriter TimingStatsViewState
newTimingStats :: TimingStatsView
-> Experiment -> ExperimentWriter TimingStatsViewState
newTimingStats TimingStatsView
view Experiment
exp =
  do let n :: Int
n = Experiment -> Int
experimentRunCount Experiment
exp
     [IORef [(String, IORef (TimingStats Double))]]
rs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0..(Int
n forall a. Num a => a -> a -> a
- Int
1)] forall a b. (a -> b) -> a -> b
$ \Int
i -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef []    
     let m :: Map Int (IORef [(String, IORef (TimingStats Double))])
m = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..(Int
n forall a. Num a => a -> a -> a
- Int
1)] [IORef [(String, IORef (TimingStats Double))]]
rs
     forall (m :: * -> *) a. Monad m => a -> m a
return TimingStatsViewState { timingStatsView :: TimingStatsView
timingStatsView       = TimingStatsView
view,
                                   timingStatsExperiment :: Experiment
timingStatsExperiment = Experiment
exp,
                                   timingStatsMap :: Map Int (IORef [(String, IORef (TimingStats Double))])
timingStatsMap        = Map Int (IORef [(String, IORef (TimingStats Double))])
m }
       
-- | Get the timing statistics during the simulation.
simulateTimingStats :: TimingStatsViewState -> ExperimentData -> Composite ()
simulateTimingStats :: TimingStatsViewState -> ExperimentData -> Composite ()
simulateTimingStats TimingStatsViewState
st ExperimentData
expdata =
  do let view :: TimingStatsView
view    = TimingStatsViewState -> TimingStatsView
timingStatsView TimingStatsViewState
st
         rs :: Results
rs      = TimingStatsView -> ResultTransform
timingStatsSeries TimingStatsView
view forall a b. (a -> b) -> a -> b
$
                   TimingStatsView -> ResultTransform
timingStatsTransform TimingStatsView
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
$
                   TimingStatsViewState -> Experiment
timingStatsExperiment TimingStatsViewState
st
         exts :: [ResultValue Double]
exts    = Results -> [ResultValue Double]
resultsToDoubleValues Results
rs
         signals :: ResultPredefinedSignals
signals = ExperimentData -> ResultPredefinedSignals
experimentPredefinedSignals ExperimentData
expdata
         signal :: Signal ()
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 -> ResultSignal -> Signal ()
pureResultSignal ResultPredefinedSignals
signals forall a b. (a -> b) -> a -> b
$
                   Results -> ResultSignal
resultSignal Results
rs
         predicate :: Event Bool
predicate = TimingStatsView -> Event Bool
timingStatsPredicate TimingStatsView
view
     Int
i <- forall (m :: * -> *) a. ParameterLift m => Parameter a -> m a
liftParameter Parameter Int
simulationIndex
     let r :: IORef [(String, IORef (TimingStats Double))]
r = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Int
i forall a. Num a => a -> a -> a
- Int
1) forall a b. (a -> b) -> a -> b
$ TimingStatsViewState
-> Map Int (IORef [(String, IORef (TimingStats Double))])
timingStatsMap TimingStatsViewState
st
     forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ResultValue Double]
exts forall a b. (a -> b) -> a -> b
$ \ResultValue Double
ext ->
       do IORef (TimingStats Double)
stats <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef forall a. TimingData a => TimingStats a
emptyTimingStats
          let name :: String
name = [ResultId] -> String
loc forall a b. (a -> b) -> a -> b
$ forall e. ResultValue e -> [ResultId]
resultValueIdPath ResultValue Double
ext
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [(String, IORef (TimingStats Double))]
r ((:) (String
name, IORef (TimingStats Double)
stats))
          forall a. Signal a -> (a -> Event ()) -> Composite ()
handleSignalComposite Signal ()
signal forall a b. (a -> b) -> a -> b
$ \()
_ ->
            do Double
t <- forall (m :: * -> *) a. DynamicsLift m => Dynamics a -> m a
liftDynamics Dynamics Double
time
               Double
x <- forall e. ResultValue e -> ResultData e
resultValueData ResultValue Double
ext
               forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
                 do TimingStats Double
y <- forall a. IORef a -> IO a
readIORef IORef (TimingStats Double)
stats
                    let y' :: TimingStats Double
y' = forall a.
TimingData a =>
Double -> a -> TimingStats a -> TimingStats a
addTimingStats Double
t Double
x TimingStats Double
y
                    TimingStats Double
y' seq :: forall a b. a -> b -> b
`seq` forall a. IORef a -> a -> IO ()
writeIORef IORef (TimingStats Double)
stats TimingStats Double
y'
     
-- | Get the HTML code.     
timingStatsHtml :: TimingStatsViewState -> Int -> HtmlWriter ()     
timingStatsHtml :: TimingStatsViewState -> Int -> HtmlWriter ()
timingStatsHtml TimingStatsViewState
st Int
index =
  let n :: Int
n = Experiment -> Int
experimentRunCount forall a b. (a -> b) -> a -> b
$ TimingStatsViewState -> Experiment
timingStatsExperiment TimingStatsViewState
st
  in if Int
n forall a. Eq a => a -> a -> Bool
== Int
1
     then TimingStatsViewState -> Int -> HtmlWriter ()
timingStatsHtmlSingle TimingStatsViewState
st Int
index
     else TimingStatsViewState -> Int -> HtmlWriter ()
timingStatsHtmlMultiple TimingStatsViewState
st Int
index
     
-- | Get the HTML code for a single run.
timingStatsHtmlSingle :: TimingStatsViewState -> Int -> HtmlWriter ()
timingStatsHtmlSingle :: TimingStatsViewState -> Int -> HtmlWriter ()
timingStatsHtmlSingle TimingStatsViewState
st Int
index =
  do TimingStatsViewState -> Int -> HtmlWriter ()
header TimingStatsViewState
st Int
index
     let r :: IORef [(String, IORef (TimingStats Double))]
r = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
0 (TimingStatsViewState
-> Map Int (IORef [(String, IORef (TimingStats Double))])
timingStatsMap TimingStatsViewState
st)
     [(String, IORef (TimingStats Double))]
pairs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef [(String, IORef (TimingStats Double))]
r
     forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a. [a] -> [a]
reverse [(String, IORef (TimingStats Double))]
pairs) forall a b. (a -> b) -> a -> b
$ \(String
name, IORef (TimingStats Double)
r) ->
       do TimingStats Double
stats <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef (TimingStats Double)
r
          let writer :: TimingStatsWriter Double
writer = TimingStatsView -> TimingStatsWriter Double
timingStatsWriter (TimingStatsViewState -> TimingStatsView
timingStatsView TimingStatsViewState
st)
              write :: TimingStatsWriter Double
-> String -> TimingStats Double -> HtmlWriter ()
write  = forall a.
TimingStatsWriter a
-> TimingStatsWriter a -> String -> TimingStats a -> HtmlWriter ()
timingStatsWrite TimingStatsWriter Double
writer
          TimingStatsWriter Double
-> String -> TimingStats Double -> HtmlWriter ()
write TimingStatsWriter Double
writer String
name TimingStats Double
stats

-- | Get the HTML code for multiple runs
timingStatsHtmlMultiple :: TimingStatsViewState -> Int -> HtmlWriter ()
timingStatsHtmlMultiple :: TimingStatsViewState -> Int -> HtmlWriter ()
timingStatsHtmlMultiple TimingStatsViewState
st Int
index =
  do TimingStatsViewState -> Int -> HtmlWriter ()
header TimingStatsViewState
st Int
index
     let n :: Int
n = Experiment -> Int
experimentRunCount forall a b. (a -> b) -> a -> b
$ TimingStatsViewState -> Experiment
timingStatsExperiment TimingStatsViewState
st
     forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..(Int
n forall a. Num a => a -> a -> a
- Int
1)] forall a b. (a -> b) -> a -> b
$ \Int
i ->
       do let subtitle :: String
subtitle = 
                String -> String -> String -> String
replace String
"$RUN_INDEX" (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Int
i forall a. Num a => a -> a -> a
+ Int
1) forall a b. (a -> b) -> a -> b
$
                String -> String -> String -> String
replace String
"$RUN_COUNT" (forall a. Show a => a -> String
show Int
n) forall a b. (a -> b) -> a -> b
$
                String -> String -> String -> String
replace String
"$TITLE" (TimingStatsView -> String
timingStatsTitle forall a b. (a -> b) -> a -> b
$ TimingStatsViewState -> TimingStatsView
timingStatsView TimingStatsViewState
st)
                (TimingStatsView -> String
timingStatsRunTitle forall a b. (a -> b) -> a -> b
$ TimingStatsViewState -> TimingStatsView
timingStatsView TimingStatsViewState
st)
          HtmlWriter () -> HtmlWriter ()
writeHtmlHeader4 forall a b. (a -> b) -> a -> b
$
            String -> HtmlWriter ()
writeHtmlText String
subtitle
          let r :: IORef [(String, IORef (TimingStats Double))]
r = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
i (TimingStatsViewState
-> Map Int (IORef [(String, IORef (TimingStats Double))])
timingStatsMap TimingStatsViewState
st)
          [(String, IORef (TimingStats Double))]
pairs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef [(String, IORef (TimingStats Double))]
r
          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a. [a] -> [a]
reverse [(String, IORef (TimingStats Double))]
pairs) forall a b. (a -> b) -> a -> b
$ \(String
name, IORef (TimingStats Double)
r) ->
            do TimingStats Double
stats <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef (TimingStats Double)
r
               let writer :: TimingStatsWriter Double
writer = TimingStatsView -> TimingStatsWriter Double
timingStatsWriter (TimingStatsViewState -> TimingStatsView
timingStatsView TimingStatsViewState
st)
                   write :: TimingStatsWriter Double
-> String -> TimingStats Double -> HtmlWriter ()
write  = forall a.
TimingStatsWriter a
-> TimingStatsWriter a -> String -> TimingStats a -> HtmlWriter ()
timingStatsWrite TimingStatsWriter Double
writer
               TimingStatsWriter Double
-> String -> TimingStats Double -> HtmlWriter ()
write TimingStatsWriter Double
writer String
name TimingStats Double
stats

header :: TimingStatsViewState -> Int -> HtmlWriter ()
header :: TimingStatsViewState -> Int -> HtmlWriter ()
header TimingStatsViewState
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 (TimingStatsView -> String
timingStatsTitle forall a b. (a -> b) -> a -> b
$ TimingStatsViewState -> TimingStatsView
timingStatsView TimingStatsViewState
st)
     let description :: String
description = TimingStatsView -> String
timingStatsDescription forall a b. (a -> b) -> a -> b
$ TimingStatsViewState -> TimingStatsView
timingStatsView TimingStatsViewState
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     
timingStatsTOCHtml :: TimingStatsViewState -> Int -> HtmlWriter ()
timingStatsTOCHtml :: TimingStatsViewState -> Int -> HtmlWriter ()
timingStatsTOCHtml TimingStatsViewState
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 (TimingStatsView -> String
timingStatsTitle forall a b. (a -> b) -> a -> b
$ TimingStatsViewState -> TimingStatsView
timingStatsView TimingStatsViewState
st)