{-# LANGUAGE MultiParamTypeClasses #-}

-- |
-- Module     : Simulation.Aivika.Experiment.Chart.DeviationChartView
-- 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 'DeviationChartView' that plots the deviation chart using rule of 3-sigma.
--

module Simulation.Aivika.Experiment.Chart.DeviationChartView
       (DeviationChartView(..), 
        defaultDeviationChartView) where

import Control.Monad
import Control.Monad.Trans
import Control.Concurrent.MVar
import Control.Lens

import qualified Data.Map as M
import Data.IORef
import Data.Maybe
import Data.Either
import Data.Monoid
import Data.Array
import Data.Array.IO.Safe
import Data.Default.Class

import System.IO
import System.FilePath

import Graphics.Rendering.Chart

import Simulation.Aivika
import Simulation.Aivika.Experiment
import Simulation.Aivika.Experiment.Base
import Simulation.Aivika.Experiment.Concurrent.MVar
import Simulation.Aivika.Experiment.Chart.Types
import Simulation.Aivika.Experiment.Chart.Utils (colourisePlotLines, colourisePlotFillBetween)

-- | Defines the 'View' that plots the deviation chart in time points by the specified grid.
data DeviationChartView =
  DeviationChartView { DeviationChartView -> String
deviationChartTitle       :: String,
                       -- ^ This is a title used in HTML.
                       DeviationChartView -> String
deviationChartDescription :: String,
                       -- ^ This is a description used in HTML.
                       DeviationChartView -> Int
deviationChartWidth       :: Int,
                       -- ^ The width of the chart.
                       DeviationChartView -> Int
deviationChartHeight      :: Int,
                       -- ^ The height of the chart.
                       DeviationChartView -> Int
deviationChartGridSize    :: Int,
                       -- ^ The size of the grid, where the series data are collected.
                       DeviationChartView -> ExperimentFilePath
deviationChartFileName    :: ExperimentFilePath,
                       -- ^ It defines the file name with optional extension for each image to be saved.
                       -- It may include special variable @$TITLE@.
                       --
                       -- An example is
                       --
                       -- @
                       --   deviationChartFileName = UniqueFilePath \"$TITLE\"
                       -- @
                       DeviationChartView -> ResultTransform
deviationChartTransform :: ResultTransform,
                       -- ^ The transform applied to the results before receiving series.
                       DeviationChartView -> ResultTransform
deviationChartLeftYSeries  :: ResultTransform, 
                       -- ^ It defines the series to be plotted basing on the left Y axis.
                       DeviationChartView -> ResultTransform
deviationChartRightYSeries :: ResultTransform, 
                       -- ^ It defines the series to be plotted basing on the right Y axis.
                       DeviationChartView -> String
deviationChartPlotTitle :: String,
                       -- ^ This is a title used in the chart. 
                       -- It may include special variable @$TITLE@.
                       --
                       -- An example is
                       --
                       -- @
                       --   deviationChartPlotTitle = \"$TITLE\"
                       -- @
                       DeviationChartView
-> [PlotLines Double Double -> PlotLines Double Double]
deviationChartPlotLines :: [PlotLines Double Double ->
                                                   PlotLines Double Double],
                       -- ^ Probably, an infinite sequence of plot 
                       -- transformations based on which the plot
                       -- is constructed for each series. Generally,
                       -- it may not coincide with a sequence of 
                       -- labels as one label may denote a whole list 
                       -- or an array of data providers.
                       --
                       -- Here you can define a colour or style of
                       -- the plot lines.
                       DeviationChartView
-> [PlotFillBetween Double Double -> PlotFillBetween Double Double]
deviationChartPlotFillBetween :: [PlotFillBetween Double Double ->
                                                         PlotFillBetween Double Double],
                       -- ^ Corresponds exactly to 'deviationChartPlotLines'
                       -- but used for plotting the deviation areas
                       -- by the rule of 3-sigma, while the former 
                       -- is used for plotting the trends of the 
                       -- random processes.
                       DeviationChartView -> LayoutAxis Double -> LayoutAxis Double
deviationChartBottomAxis :: LayoutAxis Double ->
                                                   LayoutAxis Double,
                       -- ^ A transformation of the bottom axis, 
                       -- after title @time@ is added.
                       DeviationChartView
-> LayoutLR Double Double Double -> LayoutLR Double Double Double
deviationChartLayout :: LayoutLR Double Double Double ->
                                               LayoutLR Double Double Double
                       -- ^ A transformation of the plot layout, 
                       -- where you can redefine the axes, for example.
                 }
  
-- | The default deviation chart view.  
defaultDeviationChartView :: DeviationChartView
defaultDeviationChartView :: DeviationChartView
defaultDeviationChartView = 
  DeviationChartView { deviationChartTitle :: String
deviationChartTitle       = String
"Deviation Chart",
                       deviationChartDescription :: String
deviationChartDescription = String
"It shows the Deviation chart by rule 3-sigma.",
                       deviationChartWidth :: Int
deviationChartWidth       = Int
640,
                       deviationChartHeight :: Int
deviationChartHeight      = Int
480,
                       deviationChartGridSize :: Int
deviationChartGridSize    = Int
2 forall a. Num a => a -> a -> a
* Int
640,
                       deviationChartFileName :: ExperimentFilePath
deviationChartFileName    = String -> ExperimentFilePath
UniqueFilePath String
"DeviationChart",
                       deviationChartTransform :: ResultTransform
deviationChartTransform   = forall a. a -> a
id,
                       deviationChartLeftYSeries :: ResultTransform
deviationChartLeftYSeries  = forall a. Monoid a => a
mempty, 
                       deviationChartRightYSeries :: ResultTransform
deviationChartRightYSeries = forall a. Monoid a => a
mempty, 
                       deviationChartPlotTitle :: String
deviationChartPlotTitle   = String
"$TITLE",
                       deviationChartPlotLines :: [PlotLines Double Double -> PlotLines Double Double]
deviationChartPlotLines   = forall x y. [PlotLines x y -> PlotLines x y]
colourisePlotLines,
                       deviationChartPlotFillBetween :: [PlotFillBetween Double Double -> PlotFillBetween Double Double]
deviationChartPlotFillBetween = forall x y. [PlotFillBetween x y -> PlotFillBetween x y]
colourisePlotFillBetween,
                       deviationChartBottomAxis :: LayoutAxis Double -> LayoutAxis Double
deviationChartBottomAxis  = forall a. a -> a
id,
                       deviationChartLayout :: LayoutLR Double Double Double -> LayoutLR Double Double Double
deviationChartLayout      = forall a. a -> a
id }

instance ChartRendering r => ExperimentView DeviationChartView (WebPageRenderer r) where
  
  outputView :: DeviationChartView -> ExperimentGenerator (WebPageRenderer r)
outputView DeviationChartView
v = 
    let reporter :: Experiment
-> WebPageRenderer r
-> String
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
reporter Experiment
exp (WebPageRenderer r
renderer ExperimentFilePath
_) String
dir =
          do DeviationChartViewState r
st <- forall r.
DeviationChartView
-> Experiment
-> r
-> String
-> ExperimentWriter (DeviationChartViewState r)
newDeviationChart DeviationChartView
v Experiment
exp r
renderer 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 = forall r. DeviationChartViewState r -> Int -> HtmlWriter ()
deviationChartTOCHtml DeviationChartViewState r
st,
                                   reporterWriteHtml :: Int -> HtmlWriter ()
reporterWriteHtml    = forall r. DeviationChartViewState r -> Int -> HtmlWriter ()
deviationChartHtml DeviationChartViewState r
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 r.
ChartRendering r =>
DeviationChartViewState r -> ExperimentWriter ()
finaliseDeviationChart DeviationChartViewState r
st,
                                         reporterSimulate :: ExperimentData -> Composite ()
reporterSimulate   = forall r.
DeviationChartViewState r -> ExperimentData -> Composite ()
simulateDeviationChart DeviationChartViewState r
st,
                                         reporterContext :: ExperimentContext (WebPageRenderer a)
reporterContext    = forall {a}. ExperimentContext (WebPageRenderer a)
context }
    in ExperimentGenerator { generateReporter :: Experiment
-> WebPageRenderer r
-> ExperimentEnvironment (WebPageRenderer r)
-> ExperimentMonad
     (WebPageRenderer r) (ExperimentReporter (WebPageRenderer r))
generateReporter = forall {r} {a}.
ChartRendering r =>
Experiment
-> WebPageRenderer r
-> String
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
reporter }

instance ChartRendering r => ExperimentView DeviationChartView (FileRenderer r) where
  
  outputView :: DeviationChartView -> ExperimentGenerator (FileRenderer r)
outputView DeviationChartView
v = 
    let reporter :: Experiment
-> FileRenderer r
-> String
-> ExperimentWriter (ExperimentReporter (FileRenderer a))
reporter Experiment
exp (FileRenderer r
renderer ExperimentFilePath
_) String
dir =
          do DeviationChartViewState r
st <- forall r.
DeviationChartView
-> Experiment
-> r
-> String
-> ExperimentWriter (DeviationChartViewState r)
newDeviationChart DeviationChartView
v Experiment
exp r
renderer String
dir
             forall (m :: * -> *) a. Monad m => a -> m a
return ExperimentReporter { reporterInitialise :: ExperimentMonad (FileRenderer a) ()
reporterInitialise = forall (m :: * -> *) a. Monad m => a -> m a
return (),
                                         reporterFinalise :: ExperimentMonad (FileRenderer a) ()
reporterFinalise   = forall r.
ChartRendering r =>
DeviationChartViewState r -> ExperimentWriter ()
finaliseDeviationChart DeviationChartViewState r
st,
                                         reporterSimulate :: ExperimentData -> Composite ()
reporterSimulate   = forall r.
DeviationChartViewState r -> ExperimentData -> Composite ()
simulateDeviationChart DeviationChartViewState r
st,
                                         reporterContext :: ExperimentContext (FileRenderer a)
reporterContext    = forall a. ExperimentContext (FileRenderer a)
FileContext }
    in ExperimentGenerator { generateReporter :: Experiment
-> FileRenderer r
-> ExperimentEnvironment (FileRenderer r)
-> ExperimentMonad
     (FileRenderer r) (ExperimentReporter (FileRenderer r))
generateReporter = forall {r} {a}.
ChartRendering r =>
Experiment
-> FileRenderer r
-> String
-> ExperimentWriter (ExperimentReporter (FileRenderer a))
reporter }
  
-- | The state of the view.
data DeviationChartViewState r =
  DeviationChartViewState { forall r. DeviationChartViewState r -> DeviationChartView
deviationChartView       :: DeviationChartView,
                            forall r. DeviationChartViewState r -> Experiment
deviationChartExperiment :: Experiment,
                            forall r. DeviationChartViewState r -> r
deviationChartRenderer   :: r,
                            forall r. DeviationChartViewState r -> String
deviationChartDir        :: FilePath, 
                            forall r. DeviationChartViewState r -> IORef (Maybe String)
deviationChartFile       :: IORef (Maybe FilePath),
                            forall r.
DeviationChartViewState r -> MVar (Maybe DeviationChartResults)
deviationChartResults    :: MVar (Maybe DeviationChartResults) }

-- | The deviation chart item.
data DeviationChartResults =
  DeviationChartResults { DeviationChartResults -> IOArray Int Double
deviationChartTimes :: IOArray Int Double,
                          DeviationChartResults -> [Either String String]
deviationChartNames :: [Either String String],
                          DeviationChartResults
-> [MVar (IOArray Int (SamplingStats Double))]
deviationChartStats :: [MVar (IOArray Int (SamplingStats Double))] }
  
-- | Create a new state of the view.
newDeviationChart :: DeviationChartView -> Experiment -> r -> FilePath -> ExperimentWriter (DeviationChartViewState r)
newDeviationChart :: forall r.
DeviationChartView
-> Experiment
-> r
-> String
-> ExperimentWriter (DeviationChartViewState r)
newDeviationChart DeviationChartView
view Experiment
exp r
renderer String
dir =
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 
  do IORef (Maybe String)
f <- forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
     MVar (Maybe DeviationChartResults)
r <- forall a. a -> IO (MVar a)
newMVar forall a. Maybe a
Nothing
     forall (m :: * -> *) a. Monad m => a -> m a
return DeviationChartViewState { deviationChartView :: DeviationChartView
deviationChartView       = DeviationChartView
view,
                                      deviationChartExperiment :: Experiment
deviationChartExperiment = Experiment
exp,
                                      deviationChartRenderer :: r
deviationChartRenderer   = r
renderer,
                                      deviationChartDir :: String
deviationChartDir        = String
dir, 
                                      deviationChartFile :: IORef (Maybe String)
deviationChartFile       = IORef (Maybe String)
f,
                                      deviationChartResults :: MVar (Maybe DeviationChartResults)
deviationChartResults    = MVar (Maybe DeviationChartResults)
r }
       
-- | Create new chart results.
newDeviationChartResults :: DeviationChartViewState r -> [Either String String] -> IO DeviationChartResults
newDeviationChartResults :: forall r.
DeviationChartViewState r
-> [Either String String] -> IO DeviationChartResults
newDeviationChartResults DeviationChartViewState r
st [Either String String]
names =
  do let exp :: Experiment
exp   = forall r. DeviationChartViewState r -> Experiment
deviationChartExperiment DeviationChartViewState r
st
         view :: DeviationChartView
view  = forall r. DeviationChartViewState r -> DeviationChartView
deviationChartView DeviationChartViewState r
st
         size :: Int
size  = DeviationChartView -> Int
deviationChartGridSize DeviationChartView
view
         specs :: Specs
specs = Experiment -> Specs
experimentSpecs Experiment
exp
         grid :: [(Int, Double)]
grid  = Specs -> Int -> [(Int, Double)]
timeGrid Specs
specs Int
size
         bnds :: (Int, Int)
bnds  = (Int
0, Int
1 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Double)]
grid)
     IOArray Int Double
times <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> [e] -> m (a i e)
newListArray (Int, Int)
bnds forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Int, Double)]
grid
     [MVar (IOArray Int (SamplingStats Double))]
stats <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Either String String]
names forall a b. (a -> b) -> a -> b
$ \Either String String
_ -> 
       forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int, Int)
bnds forall a. SamplingData a => SamplingStats a
emptySamplingStats forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> IO (MVar a)
newMVar
     forall (m :: * -> *) a. Monad m => a -> m a
return DeviationChartResults { deviationChartTimes :: IOArray Int Double
deviationChartTimes = IOArray Int Double
times,
                                    deviationChartNames :: [Either String String]
deviationChartNames = [Either String String]
names,
                                    deviationChartStats :: [MVar (IOArray Int (SamplingStats Double))]
deviationChartStats = [MVar (IOArray Int (SamplingStats Double))]
stats }

-- | Require to return unique chart results associated with the specified state. 
requireDeviationChartResults :: DeviationChartViewState r -> [Either String String] -> IO DeviationChartResults
requireDeviationChartResults :: forall r.
DeviationChartViewState r
-> [Either String String] -> IO DeviationChartResults
requireDeviationChartResults DeviationChartViewState r
st [Either String String]
names =
  forall a b. MVar (Maybe a) -> IO a -> (a -> IO b) -> IO b
maybePutMVar (forall r.
DeviationChartViewState r -> MVar (Maybe DeviationChartResults)
deviationChartResults DeviationChartViewState r
st)
  (forall r.
DeviationChartViewState r
-> [Either String String] -> IO DeviationChartResults
newDeviationChartResults DeviationChartViewState r
st [Either String String]
names) forall a b. (a -> b) -> a -> b
$ \DeviationChartResults
results ->
  if ([Either String String]
names forall a. Eq a => a -> a -> Bool
/= DeviationChartResults -> [Either String String]
deviationChartNames DeviationChartResults
results)
  then forall a. HasCallStack => String -> a
error String
"Series with different names are returned for different runs: requireDeviationChartResults"
  else forall (m :: * -> *) a. Monad m => a -> m a
return DeviationChartResults
results
       
-- | Simulate the specified series.
simulateDeviationChart :: DeviationChartViewState r -> ExperimentData -> Composite ()
simulateDeviationChart :: forall r.
DeviationChartViewState r -> ExperimentData -> Composite ()
simulateDeviationChart DeviationChartViewState r
st ExperimentData
expdata =
  do let view :: DeviationChartView
view    = forall r. DeviationChartViewState r -> DeviationChartView
deviationChartView DeviationChartViewState r
st
         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
$
                   forall r. DeviationChartViewState r -> Experiment
deviationChartExperiment DeviationChartViewState r
st
         rs1 :: Results
rs1     = DeviationChartView -> ResultTransform
deviationChartLeftYSeries DeviationChartView
view forall a b. (a -> b) -> a -> b
$
                   DeviationChartView -> ResultTransform
deviationChartTransform DeviationChartView
view forall a b. (a -> b) -> a -> b
$
                   ExperimentData -> Results
experimentResults ExperimentData
expdata
         rs2 :: Results
rs2     = DeviationChartView -> ResultTransform
deviationChartRightYSeries DeviationChartView
view forall a b. (a -> b) -> a -> b
$
                   DeviationChartView -> ResultTransform
deviationChartTransform DeviationChartView
view forall a b. (a -> b) -> a -> b
$
                   ExperimentData -> Results
experimentResults ExperimentData
expdata
         exts1 :: [ResultValue (Either Double (SamplingStats Double))]
exts1   = Results -> [ResultValue (Either Double (SamplingStats Double))]
resultsToDoubleStatsEitherValues Results
rs1
         exts2 :: [ResultValue (Either Double (SamplingStats Double))]
exts2   = Results -> [ResultValue (Either Double (SamplingStats Double))]
resultsToDoubleStatsEitherValues Results
rs2
         exts :: [ResultValue (Either Double (SamplingStats Double))]
exts    = [ResultValue (Either Double (SamplingStats Double))]
exts1 forall a. [a] -> [a] -> [a]
++ [ResultValue (Either Double (SamplingStats Double))]
exts2
         names1 :: [String]
names1  = 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))]
exts1
         names2 :: [String]
names2  = 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))]
exts2
         names :: [Either String String]
names   = forall a b. (a -> b) -> [a] -> [b]
map forall a b. a -> Either a b
Left [String]
names1 forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a b. b -> Either a b
Right [String]
names2
     Signal Int
signal <- forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent forall a b. (a -> b) -> a -> b
$
               Int -> Event (Signal Int)
newSignalInTimeGrid forall a b. (a -> b) -> a -> b
$
               DeviationChartView -> Int
deviationChartGridSize DeviationChartView
view
     [SignalHistory (Either Double (SamplingStats Double))]
hs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ResultValue (Either Double (SamplingStats Double))]
exts forall a b. (a -> b) -> a -> b
$ \ResultValue (Either Double (SamplingStats Double))
ext ->
           forall a. Signal a -> Composite (SignalHistory a)
newSignalHistory forall a b. (a -> b) -> a -> b
$
           forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM Signal Int
signal forall a b. (a -> b) -> a -> b
$ \Int
i ->
           forall e. ResultValue e -> ResultData e
resultValueData ResultValue (Either Double (SamplingStats Double))
ext
     DisposableEvent -> Composite ()
disposableComposite forall a b. (a -> b) -> a -> b
$
       Event () -> DisposableEvent
DisposableEvent forall a b. (a -> b) -> a -> b
$
       do DeviationChartResults
results <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall r.
DeviationChartViewState r
-> [Either String String] -> IO DeviationChartResults
requireDeviationChartResults DeviationChartViewState r
st [Either String String]
names
          let stats :: [MVar (IOArray Int (SamplingStats Double))]
stats = DeviationChartResults
-> [MVar (IOArray Int (SamplingStats Double))]
deviationChartStats DeviationChartResults
results
          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [SignalHistory (Either Double (SamplingStats Double))]
hs [MVar (IOArray Int (SamplingStats Double))]
stats) forall a b. (a -> b) -> a -> b
$ \(SignalHistory (Either Double (SamplingStats Double))
h, MVar (IOArray Int (SamplingStats Double))
stats') ->
            do (Array Int Double
ts, Array Int (Either Double (SamplingStats Double))
xs) <- forall a. SignalHistory a -> Event (Array Int Double, Array Int a)
readSignalHistory SignalHistory (Either Double (SamplingStats Double))
h
               let (Int
lo, Int
hi) = forall i e. Array i e -> (i, i)
bounds Array Int Double
ts
               forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
                 forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar (IOArray Int (SamplingStats Double))
stats' forall a b. (a -> b) -> a -> b
$ \IOArray Int (SamplingStats Double)
stats'' ->
                 forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
lo..Int
hi] forall a b. (a -> b) -> a -> b
$ \Int
i ->
                 do let x :: Either Double (SamplingStats Double)
x = Array Int (Either Double (SamplingStats Double))
xs forall i e. Ix i => Array i e -> i -> e
! Int
i
                    SamplingStats Double
y <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOArray Int (SamplingStats Double)
stats'' Int
i
                    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
                    SamplingStats Double
y' seq :: forall a b. a -> b -> b
`seq` forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOArray Int (SamplingStats Double)
stats'' Int
i SamplingStats Double
y'
     
-- | Plot the deviation chart after the simulation is complete.
finaliseDeviationChart :: ChartRendering r => DeviationChartViewState r -> ExperimentWriter ()
finaliseDeviationChart :: forall r.
ChartRendering r =>
DeviationChartViewState r -> ExperimentWriter ()
finaliseDeviationChart DeviationChartViewState r
st =
  do let view :: DeviationChartView
view = forall r. DeviationChartViewState r -> DeviationChartView
deviationChartView DeviationChartViewState r
st
         title :: String
title = DeviationChartView -> String
deviationChartTitle DeviationChartView
view
         plotTitle :: String
plotTitle = DeviationChartView -> String
deviationChartPlotTitle DeviationChartView
view
         plotTitle' :: String
plotTitle' = 
           String -> String -> String -> String
replace String
"$TITLE" String
title
           String
plotTitle
         width :: Int
width = DeviationChartView -> Int
deviationChartWidth DeviationChartView
view
         height :: Int
height = DeviationChartView -> Int
deviationChartHeight DeviationChartView
view
         plotLines :: [PlotLines Double Double -> PlotLines Double Double]
plotLines = DeviationChartView
-> [PlotLines Double Double -> PlotLines Double Double]
deviationChartPlotLines DeviationChartView
view
         plotFillBetween :: [PlotFillBetween Double Double -> PlotFillBetween Double Double]
plotFillBetween = DeviationChartView
-> [PlotFillBetween Double Double -> PlotFillBetween Double Double]
deviationChartPlotFillBetween DeviationChartView
view
         plotBottomAxis :: LayoutAxis Double -> LayoutAxis Double
plotBottomAxis = DeviationChartView -> LayoutAxis Double -> LayoutAxis Double
deviationChartBottomAxis DeviationChartView
view
         plotLayout :: LayoutLR Double Double Double -> LayoutLR Double Double Double
plotLayout = DeviationChartView
-> LayoutLR Double Double Double -> LayoutLR Double Double Double
deviationChartLayout DeviationChartView
view
         renderer :: r
renderer = forall r. DeviationChartViewState r -> r
deviationChartRenderer DeviationChartViewState r
st
     String
file <- String -> ExperimentFilePath -> ExperimentWriter String
resolveFilePath (forall r. DeviationChartViewState r -> String
deviationChartDir DeviationChartViewState r
st) forall a b. (a -> b) -> a -> b
$
             (String -> String) -> ExperimentFilePath -> ExperimentFilePath
mapFilePath (forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> String -> String
replaceExtension forall a b. (a -> b) -> a -> b
$ forall r. ChartRendering r => r -> String
renderableChartExtension r
renderer) forall a b. (a -> b) -> a -> b
$
             ExperimentFilePath -> Map String String -> ExperimentFilePath
expandFilePath (DeviationChartView -> ExperimentFilePath
deviationChartFileName DeviationChartView
view) forall a b. (a -> b) -> a -> b
$
             forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(String
"$TITLE", String
title)]
     Maybe DeviationChartResults
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 forall a b. (a -> b) -> a -> b
$ forall r.
DeviationChartViewState r -> MVar (Maybe DeviationChartResults)
deviationChartResults DeviationChartViewState r
st
     case Maybe DeviationChartResults
results of
       Maybe DeviationChartResults
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Just DeviationChartResults
results ->
         forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
         do let times :: IOArray Int Double
times = DeviationChartResults -> IOArray Int Double
deviationChartTimes DeviationChartResults
results
                names :: [Either String String]
names = DeviationChartResults -> [Either String String]
deviationChartNames DeviationChartResults
results
                stats :: [MVar (IOArray Int (SamplingStats Double))]
stats = DeviationChartResults
-> [MVar (IOArray Int (SamplingStats Double))]
deviationChartStats DeviationChartResults
results
            [Either (Plot Double Double) (Plot Double Double)]
ps1 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Either String String]
names [MVar (IOArray Int (SamplingStats Double))]
stats [PlotLines Double Double -> PlotLines Double Double]
plotLines) forall a b. (a -> b) -> a -> b
$ \(Either String String
name, MVar (IOArray Int (SamplingStats Double))
stats', PlotLines Double Double -> PlotLines Double Double
plotLines) ->
              do IOArray Int (SamplingStats Double)
stats'' <- forall a. MVar a -> IO a
readMVar MVar (IOArray Int (SamplingStats Double))
stats'
                 [(Int, SamplingStats Double)]
xs <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m [(i, e)]
getAssocs IOArray Int (SamplingStats Double)
stats''
                 [(Double, Double)]
zs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Int, SamplingStats Double)]
xs forall a b. (a -> b) -> a -> b
$ \(Int
i, SamplingStats Double
stats) ->
                   do Double
t <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOArray Int Double
times Int
i
                      forall (m :: * -> *) a. Monad m => a -> m a
return (Double
t, forall a. SamplingStats a -> Double
samplingStatsMean SamplingStats Double
stats)
                 let p :: Plot Double Double
p = forall (a :: * -> * -> *) x y. ToPlot a => a x y -> Plot x y
toPlot forall a b. (a -> b) -> a -> b
$
                         PlotLines Double Double -> PlotLines Double Double
plotLines forall a b. (a -> b) -> a -> b
$
                         forall x y. Lens' (PlotLines x y) [[(x, y)]]
plot_lines_values forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Double, Double)] -> [[(Double, Double)]]
filterPlotLinesValues [(Double, Double)]
zs forall a b. (a -> b) -> a -> b
$
                         forall x y. Lens' (PlotLines x y) String
plot_lines_title forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id forall a. a -> a
id Either String String
name forall a b. (a -> b) -> a -> b
$
                         forall a. Default a => a
def
                 case Either String String
name of
                   Left String
_  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Plot Double Double
p
                   Right String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Plot Double Double
p
            [Either (Plot Double Double) (Plot Double Double)]
ps2 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Either String String]
names [MVar (IOArray Int (SamplingStats Double))]
stats [PlotFillBetween Double Double -> PlotFillBetween Double Double]
plotFillBetween) forall a b. (a -> b) -> a -> b
$ \(Either String String
name, MVar (IOArray Int (SamplingStats Double))
stats', PlotFillBetween Double Double -> PlotFillBetween Double Double
plotFillBetween) ->
              do IOArray Int (SamplingStats Double)
stats'' <- forall a. MVar a -> IO a
readMVar MVar (IOArray Int (SamplingStats Double))
stats'
                 [(Int, SamplingStats Double)]
xs <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m [(i, e)]
getAssocs IOArray Int (SamplingStats Double)
stats''
                 [(Double, (Double, Double))]
zs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Int, SamplingStats Double)]
xs forall a b. (a -> b) -> a -> b
$ \(Int
i, SamplingStats Double
stats) ->
                   do Double
t <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOArray Int Double
times Int
i
                      let mu :: Double
mu    = forall a. SamplingStats a -> Double
samplingStatsMean SamplingStats Double
stats
                          sigma :: Double
sigma = forall a. SamplingStats a -> Double
samplingStatsDeviation SamplingStats Double
stats
                      forall (m :: * -> *) a. Monad m => a -> m a
return (Double
t, (Double
mu forall a. Num a => a -> a -> a
- Double
3 forall a. Num a => a -> a -> a
* Double
sigma, Double
mu forall a. Num a => a -> a -> a
+ Double
3 forall a. Num a => a -> a -> a
* Double
sigma))
                 let p :: Plot Double Double
p = forall (a :: * -> * -> *) x y. ToPlot a => a x y -> Plot x y
toPlot forall a b. (a -> b) -> a -> b
$
                         PlotFillBetween Double Double -> PlotFillBetween Double Double
plotFillBetween forall a b. (a -> b) -> a -> b
$
                         forall x1 y1 x2 y2.
Lens
  (PlotFillBetween x1 y1)
  (PlotFillBetween x2 y2)
  [(x1, (y1, y1))]
  [(x2, (y2, y2))]
plot_fillbetween_values forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Double, (Double, Double))] -> [(Double, (Double, Double))]
filterPlotFillBetweenValues [(Double, (Double, Double))]
zs forall a b. (a -> b) -> a -> b
$
                         forall x y. Lens' (PlotFillBetween x y) String
plot_fillbetween_title forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id forall a. a -> a
id Either String String
name forall a b. (a -> b) -> a -> b
$
                         forall a. Default a => a
def
                 case Either String String
name of
                   Left String
_  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Plot Double Double
p
                   Right String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Plot Double Double
p
            let ps :: [Either (Plot Double Double) (Plot Double Double)]
ps = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map (forall a b. [a] -> [b] -> [(a, b)]
zip [Either (Plot Double Double) (Plot Double Double)]
ps1 [Either (Plot Double Double) (Plot Double Double)]
ps2) forall a b. (a -> b) -> a -> b
$ \(Either (Plot Double Double) (Plot Double Double)
p1, Either (Plot Double Double) (Plot Double Double)
p2) -> [Either (Plot Double Double) (Plot Double Double)
p2, Either (Plot Double Double) (Plot Double Double)
p1]
                axis :: LayoutAxis Double
axis = LayoutAxis Double -> LayoutAxis Double
plotBottomAxis forall a b. (a -> b) -> a -> b
$
                       forall x. Lens' (LayoutAxis x) String
laxis_title forall s t a b. ASetter s t a b -> b -> s -> t
.~ String
"time" forall a b. (a -> b) -> a -> b
$
                       forall a. Default a => a
def
                updateLeftAxis :: LayoutLR x y1 y2 -> LayoutLR x y1 y2
updateLeftAxis =
                  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ forall a b. [Either a b] -> [a]
lefts [Either (Plot Double Double) (Plot Double Double)]
ps
                  then forall x y1 y2. Lens' (LayoutLR x y1 y2) AxisVisibility
layoutlr_left_axis_visibility forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool -> Bool -> Bool -> AxisVisibility
AxisVisibility Bool
False Bool
False Bool
False
                  else forall a. a -> a
id
                updateRightAxis :: LayoutLR x y1 y2 -> LayoutLR x y1 y2
updateRightAxis =
                  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ forall a b. [Either a b] -> [b]
rights [Either (Plot Double Double) (Plot Double Double)]
ps
                  then forall x y1 y2. Lens' (LayoutLR x y1 y2) AxisVisibility
layoutlr_right_axis_visibility forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool -> Bool -> Bool -> AxisVisibility
AxisVisibility Bool
False Bool
False Bool
False
                  else forall a. a -> a
id
                chart :: LayoutLR Double Double Double
chart = LayoutLR Double Double Double -> LayoutLR Double Double Double
plotLayout forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        forall r.
ChartRendering r =>
r -> LayoutLR Double Double Double -> LayoutLR Double Double Double
renderingLayoutLR r
renderer forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        forall {x} {y1} {y2}. LayoutLR x y1 y2 -> LayoutLR x y1 y2
updateLeftAxis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {x} {y1} {y2}. LayoutLR x y1 y2 -> LayoutLR x y1 y2
updateRightAxis forall a b. (a -> b) -> a -> b
$
                        forall x y1 y2. Lens' (LayoutLR x y1 y2) (LayoutAxis x)
layoutlr_x_axis forall s t a b. ASetter s t a b -> b -> s -> t
.~ LayoutAxis Double
axis forall a b. (a -> b) -> a -> b
$
                        forall x y1 y2. Lens' (LayoutLR x y1 y2) String
layoutlr_title forall s t a b. ASetter s t a b -> b -> s -> t
.~ String
plotTitle' forall a b. (a -> b) -> a -> b
$
                        forall x y1 y2.
Lens' (LayoutLR x y1 y2) [Either (Plot x y1) (Plot x y2)]
layoutlr_plots forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Either (Plot Double Double) (Plot Double Double)]
ps forall a b. (a -> b) -> a -> b
$
                        forall a. Default a => a
def
            forall r c.
ChartRendering r =>
r -> (Int, Int) -> String -> Renderable c -> IO (PickFn c)
renderChart r
renderer (Int
width, Int
height) String
file (forall a. ToRenderable a => a -> Renderable ()
toRenderable LayoutLR Double Double Double
chart)
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Experiment -> Bool
experimentVerbose forall a b. (a -> b) -> a -> b
$ forall r. DeviationChartViewState r -> Experiment
deviationChartExperiment DeviationChartViewState r
st) forall a b. (a -> b) -> a -> b
$
              String -> IO ()
putStr String
"Generated file " forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
putStrLn String
file
            forall a. IORef a -> a -> IO ()
writeIORef (forall r. DeviationChartViewState r -> IORef (Maybe String)
deviationChartFile DeviationChartViewState r
st) forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just String
file
     
-- | Remove the NaN and inifity values.     
filterPlotLinesValues :: [(Double, Double)] -> [[(Double, Double)]]
filterPlotLinesValues :: [(Double, Double)] -> [[(Double, Double)]]
filterPlotLinesValues = 
  forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall a. (a -> Bool) -> [a] -> [[a]]
divideBy (\(Double
t, Double
x) -> forall a. RealFloat a => a -> Bool
isNaN Double
x Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isInfinite Double
x)

-- | Remove the NaN and inifity values.     
filterPlotFillBetweenValues :: [(Double, (Double, Double))] -> [(Double, (Double, Double))]
filterPlotFillBetweenValues :: [(Double, (Double, Double))] -> [(Double, (Double, Double))]
filterPlotFillBetweenValues = 
  forall a. (a -> Bool) -> [a] -> [a]
filter forall a b. (a -> b) -> a -> b
$ \(Double
t, (Double
x1, Double
x2)) -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => a -> Bool
isNaN Double
x1 Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isInfinite Double
x1 Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isNaN Double
x2 Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isInfinite Double
x2

-- | Get the HTML code.     
deviationChartHtml :: DeviationChartViewState r -> Int -> HtmlWriter ()
deviationChartHtml :: forall r. DeviationChartViewState r -> Int -> HtmlWriter ()
deviationChartHtml DeviationChartViewState r
st Int
index =
  do forall r. DeviationChartViewState r -> Int -> HtmlWriter ()
header DeviationChartViewState r
st Int
index
     Maybe String
file <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef (forall r. DeviationChartViewState r -> IORef (Maybe String)
deviationChartFile DeviationChartViewState r
st)
     case Maybe String
file of
       Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Just String
f  ->
         HtmlWriter () -> HtmlWriter ()
writeHtmlParagraph forall a b. (a -> b) -> a -> b
$
         String -> HtmlWriter ()
writeHtmlImage (String -> String -> String
makeRelative (forall r. DeviationChartViewState r -> String
deviationChartDir DeviationChartViewState r
st) String
f)

header :: DeviationChartViewState r -> Int -> HtmlWriter ()
header :: forall r. DeviationChartViewState r -> Int -> HtmlWriter ()
header DeviationChartViewState r
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 (DeviationChartView -> String
deviationChartTitle forall a b. (a -> b) -> a -> b
$ forall r. DeviationChartViewState r -> DeviationChartView
deviationChartView DeviationChartViewState r
st)
     let description :: String
description = DeviationChartView -> String
deviationChartDescription forall a b. (a -> b) -> a -> b
$ forall r. DeviationChartViewState r -> DeviationChartView
deviationChartView DeviationChartViewState r
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.
deviationChartTOCHtml :: DeviationChartViewState r -> Int -> HtmlWriter ()
deviationChartTOCHtml :: forall r. DeviationChartViewState r -> Int -> HtmlWriter ()
deviationChartTOCHtml DeviationChartViewState r
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 (DeviationChartView -> String
deviationChartTitle forall a b. (a -> b) -> a -> b
$ forall r. DeviationChartViewState r -> DeviationChartView
deviationChartView DeviationChartViewState r
st)