{-# LANGUAGE MultiParamTypeClasses #-}

-- |
-- Module     : Simulation.Aivika.Experiment.Chart.TimeSeriesView
-- 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 'TimeSeriesView' that plots the time series charts.
--

module Simulation.Aivika.Experiment.Chart.TimeSeriesView
       (TimeSeriesView(..), 
        defaultTimeSeriesView) where

import Control.Monad
import Control.Monad.Trans
import Control.Lens

import qualified Data.Map as M
import Data.IORef
import Data.Maybe
import Data.Either
import Data.Array
import Data.List
import Data.Monoid
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.Chart.Types
import Simulation.Aivika.Experiment.Chart.Utils (colourisePlotLines)

-- | Defines the 'View' that plots the time series charts.
data TimeSeriesView =
  TimeSeriesView { TimeSeriesView -> String
timeSeriesTitle       :: String,
                   -- ^ This is a title used in HTML.
                   TimeSeriesView -> String
timeSeriesDescription :: String,
                   -- ^ This is a description used in HTML.
                   TimeSeriesView -> Int
timeSeriesWidth       :: Int,
                   -- ^ The width of the chart.
                   TimeSeriesView -> Int
timeSeriesHeight      :: Int,
                   -- ^ The height of the chart.
                   TimeSeriesView -> Maybe Int
timeSeriesGridSize    :: Maybe Int,
                   -- ^ The size of the grid, where the series data are processed.
                   TimeSeriesView -> ExperimentFilePath
timeSeriesFileName    :: ExperimentFilePath,
                   -- ^ It defines the file name with optional extension for each image to be saved.
                   -- It may include special variables @$TITLE@, @$RUN_INDEX@ and @$RUN_COUNT@.
                   --
                   -- An example is
                   --
                   -- @
                   --   timeSeriesFileName = UniqueFilePath \"$TITLE - $RUN_INDEX\"
                   -- @
                   TimeSeriesView -> Event Bool
timeSeriesPredicate   :: Event Bool,
                   -- ^ It specifies the predicate that defines
                   -- when we plot data in the chart.
                   TimeSeriesView -> ResultTransform
timeSeriesTransform    :: ResultTransform,
                   -- ^ The transform applied to the results before receiving series.
                   TimeSeriesView -> ResultTransform
timeSeriesLeftYSeries  :: ResultTransform, 
                   -- ^ It defines the series plotted basing on the left Y axis.
                   TimeSeriesView -> ResultTransform
timeSeriesRightYSeries :: ResultTransform, 
                   -- ^ It defines the series plotted basing on the right Y axis.
                   TimeSeriesView -> String
timeSeriesPlotTitle    :: String,
                   -- ^ This is a title used in the chart when
                   -- simulating a single run. It may include 
                   -- special variable @$TITLE@.
                   --
                   -- An example is
                   --
                   -- @
                   --   timeSeriesPlotTitle = \"$TITLE\"
                   -- @
                   TimeSeriesView -> String
timeSeriesRunPlotTitle :: String,
                   -- ^ The run title for the chart. It is used 
                   -- when simulating multiple runs and it may 
                   -- include special variables @$RUN_INDEX@, 
                   -- @$RUN_COUNT@ and @$PLOT_TITLE@.
                   --
                   -- An example is 
                   --
                   -- @
                   --   timeSeriesRunPlotTitle = \"$PLOT_TITLE / Run $RUN_INDEX of $RUN_COUNT\"
                   -- @
                   TimeSeriesView
-> [PlotLines Double Double -> PlotLines Double Double]
timeSeriesPlotLines :: [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 must 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.
                   TimeSeriesView -> LayoutAxis Double -> LayoutAxis Double
timeSeriesBottomAxis :: LayoutAxis Double ->
                                           LayoutAxis Double,
                   -- ^ A transformation of the bottom axis, 
                   -- after title @time@ is added.
                   TimeSeriesView
-> LayoutLR Double Double Double -> LayoutLR Double Double Double
timeSeriesLayout :: LayoutLR Double Double Double ->
                                       LayoutLR Double Double Double
                   -- ^ A transformation of the plot layout, 
                   -- where you can redefine the axes, for example.
                 }
  
-- | The default time series view.  
defaultTimeSeriesView :: TimeSeriesView
defaultTimeSeriesView :: TimeSeriesView
defaultTimeSeriesView = 
  TimeSeriesView { timeSeriesTitle :: String
timeSeriesTitle       = String
"Time Series",
                   timeSeriesDescription :: String
timeSeriesDescription = String
"It shows the Time Series chart(s).",
                   timeSeriesWidth :: Int
timeSeriesWidth       = Int
640,
                   timeSeriesHeight :: Int
timeSeriesHeight      = Int
480,
                   timeSeriesGridSize :: Maybe Int
timeSeriesGridSize    = forall a. a -> Maybe a
Just (Int
2 forall a. Num a => a -> a -> a
* Int
640),
                   timeSeriesFileName :: ExperimentFilePath
timeSeriesFileName    = String -> ExperimentFilePath
UniqueFilePath String
"TimeSeries($RUN_INDEX)",
                   timeSeriesPredicate :: Event Bool
timeSeriesPredicate   = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True,
                   timeSeriesTransform :: ResultTransform
timeSeriesTransform   = forall a. a -> a
id,
                   timeSeriesLeftYSeries :: ResultTransform
timeSeriesLeftYSeries  = forall a b. a -> b -> a
const forall a. Monoid a => a
mempty,
                   timeSeriesRightYSeries :: ResultTransform
timeSeriesRightYSeries = forall a b. a -> b -> a
const forall a. Monoid a => a
mempty,
                   timeSeriesPlotTitle :: String
timeSeriesPlotTitle    = String
"$TITLE",
                   timeSeriesRunPlotTitle :: String
timeSeriesRunPlotTitle = String
"$PLOT_TITLE / Run $RUN_INDEX of $RUN_COUNT",
                   timeSeriesPlotLines :: [PlotLines Double Double -> PlotLines Double Double]
timeSeriesPlotLines   = forall x y. [PlotLines x y -> PlotLines x y]
colourisePlotLines,
                   timeSeriesBottomAxis :: LayoutAxis Double -> LayoutAxis Double
timeSeriesBottomAxis  = forall a. a -> a
id,
                   timeSeriesLayout :: LayoutLR Double Double Double -> LayoutLR Double Double Double
timeSeriesLayout      = forall a. a -> a
id }

instance ChartRendering r => ExperimentView TimeSeriesView (WebPageRenderer r) where
  
  outputView :: TimeSeriesView -> ExperimentGenerator (WebPageRenderer r)
outputView TimeSeriesView
v = 
    let reporter :: Experiment
-> WebPageRenderer r
-> String
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
reporter Experiment
exp (WebPageRenderer r
renderer ExperimentFilePath
_) String
dir =
          do TimeSeriesViewState r
st <- forall r.
ChartRendering r =>
TimeSeriesView
-> Experiment
-> r
-> String
-> ExperimentWriter (TimeSeriesViewState r)
newTimeSeries TimeSeriesView
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. TimeSeriesViewState r -> Int -> HtmlWriter ()
timeSeriesTOCHtml TimeSeriesViewState r
st,
                                   reporterWriteHtml :: Int -> HtmlWriter ()
reporterWriteHtml    = forall r. TimeSeriesViewState r -> Int -> HtmlWriter ()
timeSeriesHtml TimeSeriesViewState 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 (m :: * -> *) a. Monad m => a -> m a
return (),
                                         reporterSimulate :: ExperimentData -> Composite ()
reporterSimulate   = forall r.
ChartRendering r =>
TimeSeriesViewState r -> ExperimentData -> Composite ()
simulateTimeSeries TimeSeriesViewState 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 TimeSeriesView (FileRenderer r) where
  
  outputView :: TimeSeriesView -> ExperimentGenerator (FileRenderer r)
outputView TimeSeriesView
v = 
    let reporter :: Experiment
-> FileRenderer r
-> String
-> ExperimentWriter (ExperimentReporter (FileRenderer a))
reporter Experiment
exp (FileRenderer r
renderer ExperimentFilePath
_) String
dir =
          do TimeSeriesViewState r
st <- forall r.
ChartRendering r =>
TimeSeriesView
-> Experiment
-> r
-> String
-> ExperimentWriter (TimeSeriesViewState r)
newTimeSeries TimeSeriesView
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 (m :: * -> *) a. Monad m => a -> m a
return (),
                                         reporterSimulate :: ExperimentData -> Composite ()
reporterSimulate   = forall r.
ChartRendering r =>
TimeSeriesViewState r -> ExperimentData -> Composite ()
simulateTimeSeries TimeSeriesViewState 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 TimeSeriesViewState r =
  TimeSeriesViewState { forall r. TimeSeriesViewState r -> TimeSeriesView
timeSeriesView       :: TimeSeriesView,
                        forall r. TimeSeriesViewState r -> Experiment
timeSeriesExperiment :: Experiment,
                        forall r. TimeSeriesViewState r -> r
timeSeriesRenderer   :: r,
                        forall r. TimeSeriesViewState r -> String
timeSeriesDir        :: FilePath, 
                        forall r. TimeSeriesViewState r -> Map Int String
timeSeriesMap        :: M.Map Int FilePath }
  
-- | Create a new state of the view.
newTimeSeries :: ChartRendering r => TimeSeriesView -> Experiment -> r -> FilePath -> ExperimentWriter (TimeSeriesViewState r)
newTimeSeries :: forall r.
ChartRendering r =>
TimeSeriesView
-> Experiment
-> r
-> String
-> ExperimentWriter (TimeSeriesViewState r)
newTimeSeries TimeSeriesView
view Experiment
exp r
renderer String
dir =
  do let n :: Int
n = Experiment -> Int
experimentRunCount Experiment
exp
     [String]
fs <- 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 ->
       String -> ExperimentFilePath -> ExperimentWriter String
resolveFilePath String
dir 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 (TimeSeriesView -> ExperimentFilePath
timeSeriesFileName TimeSeriesView
view) forall a b. (a -> b) -> a -> b
$
       forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(String
"$TITLE", TimeSeriesView -> String
timeSeriesTitle TimeSeriesView
view),
                   (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),
                   (String
"$RUN_COUNT", forall a. Show a => a -> String
show Int
n)]
     forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
fs forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> String -> IO ()
writeFile []  -- reserve the file names
     let m :: Map Int String
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)] [String]
fs
     forall (m :: * -> *) a. Monad m => a -> m a
return TimeSeriesViewState { timeSeriesView :: TimeSeriesView
timeSeriesView       = TimeSeriesView
view,
                                  timeSeriesExperiment :: Experiment
timeSeriesExperiment = Experiment
exp,
                                  timeSeriesRenderer :: r
timeSeriesRenderer   = r
renderer,
                                  timeSeriesDir :: String
timeSeriesDir        = String
dir, 
                                  timeSeriesMap :: Map Int String
timeSeriesMap        = Map Int String
m }
       
-- | Plot the time series chart within simulation.
simulateTimeSeries :: ChartRendering r => TimeSeriesViewState r -> ExperimentData -> Composite ()
simulateTimeSeries :: forall r.
ChartRendering r =>
TimeSeriesViewState r -> ExperimentData -> Composite ()
simulateTimeSeries TimeSeriesViewState r
st ExperimentData
expdata =
  do let view :: TimeSeriesView
view    = forall r. TimeSeriesViewState r -> TimeSeriesView
timeSeriesView TimeSeriesViewState 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. TimeSeriesViewState r -> Experiment
timeSeriesExperiment TimeSeriesViewState r
st
         rs1 :: Results
rs1     = TimeSeriesView -> ResultTransform
timeSeriesLeftYSeries TimeSeriesView
view forall a b. (a -> b) -> a -> b
$
                   TimeSeriesView -> ResultTransform
timeSeriesTransform TimeSeriesView
view forall a b. (a -> b) -> a -> b
$
                   ExperimentData -> Results
experimentResults ExperimentData
expdata
         rs2 :: Results
rs2     = TimeSeriesView -> ResultTransform
timeSeriesRightYSeries TimeSeriesView
view forall a b. (a -> b) -> a -> b
$
                   TimeSeriesView -> ResultTransform
timeSeriesTransform TimeSeriesView
view forall a b. (a -> b) -> a -> b
$
                   ExperimentData -> Results
experimentResults ExperimentData
expdata
         exts1 :: [ResultValue Double]
exts1   = Results -> [ResultValue Double]
resultsToDoubleValues Results
rs1
         exts2 :: [ResultValue Double]
exts2   = Results -> [ResultValue Double]
resultsToDoubleValues Results
rs2
         signals :: ResultPredefinedSignals
signals = ExperimentData -> ResultPredefinedSignals
experimentPredefinedSignals ExperimentData
expdata
         n :: Int
n = Experiment -> Int
experimentRunCount forall a b. (a -> b) -> a -> b
$ forall r. TimeSeriesViewState r -> Experiment
timeSeriesExperiment TimeSeriesViewState r
st
         width :: Int
width   = TimeSeriesView -> Int
timeSeriesWidth TimeSeriesView
view
         height :: Int
height  = TimeSeriesView -> Int
timeSeriesHeight TimeSeriesView
view
         predicate :: Event Bool
predicate  = TimeSeriesView -> Event Bool
timeSeriesPredicate TimeSeriesView
view
         title :: String
title   = TimeSeriesView -> String
timeSeriesTitle TimeSeriesView
view
         plotTitle :: String
plotTitle  = TimeSeriesView -> String
timeSeriesPlotTitle TimeSeriesView
view
         runPlotTitle :: String
runPlotTitle = TimeSeriesView -> String
timeSeriesRunPlotTitle TimeSeriesView
view
         plotLines :: [PlotLines Double Double -> PlotLines Double Double]
plotLines  = TimeSeriesView
-> [PlotLines Double Double -> PlotLines Double Double]
timeSeriesPlotLines TimeSeriesView
view
         plotBottomAxis :: LayoutAxis Double -> LayoutAxis Double
plotBottomAxis = TimeSeriesView -> LayoutAxis Double -> LayoutAxis Double
timeSeriesBottomAxis TimeSeriesView
view
         plotLayout :: LayoutLR Double Double Double -> LayoutLR Double Double Double
plotLayout = TimeSeriesView
-> LayoutLR Double Double Double -> LayoutLR Double Double Double
timeSeriesLayout TimeSeriesView
view
         renderer :: r
renderer   = forall r. TimeSeriesViewState r -> r
timeSeriesRenderer TimeSeriesViewState r
st
     Int
i <- forall (m :: * -> *) a. ParameterLift m => Parameter a -> m a
liftParameter Parameter Int
simulationIndex
     let file :: String
file  = 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 r. TimeSeriesViewState r -> Map Int String
timeSeriesMap TimeSeriesViewState r
st)
         plotTitle' :: String
plotTitle' = 
           String -> String -> String -> String
replace String
"$TITLE" String
title
           String
plotTitle
         runPlotTitle' :: String
runPlotTitle' =
           if Int
n forall a. Eq a => a -> a -> Bool
== Int
1
           then String
plotTitle'
           else String -> String -> String -> String
replace String
"$RUN_INDEX" (forall a. Show a => a -> String
show Int
i) 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
"$PLOT_TITLE" String
plotTitle'
                String
runPlotTitle
         inputSignal :: ResultValue e -> m (Signal ())
inputSignal ResultValue e
ext =
           case TimeSeriesView -> Maybe Int
timeSeriesGridSize TimeSeriesView
view of
             Just Int
m ->
               forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent forall a b. (a -> b) -> a -> b
$
               forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> Signal a -> Signal b
mapSignal forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const ()) forall a b. (a -> b) -> a -> b
$
               Int -> Event (Signal Int)
newSignalInTimeGrid Int
m
             Maybe Int
Nothing ->
               forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
               ResultPredefinedSignals -> ResultSignal -> Signal ()
pureResultSignal ResultPredefinedSignals
signals forall a b. (a -> b) -> a -> b
$
               forall e. ResultValue e -> ResultSignal
resultValueSignal ResultValue e
ext
         inputHistory :: t (ResultValue a) -> Composite (t (SignalHistory a))
inputHistory t (ResultValue a)
exts =
           forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM t (ResultValue a)
exts forall a b. (a -> b) -> a -> b
$ \ResultValue a
ext ->
           do let transform :: () -> Event a
transform () =
                    do Bool
x <- Event Bool
predicate
                       if Bool
x
                         then forall e. ResultValue e -> ResultData e
resultValueData ResultValue a
ext
                         else forall (m :: * -> *) a. Monad m => a -> m a
return (a
1forall a. Fractional a => a -> a -> a
/a
0)  -- the infinite values will be ignored then
              Signal ()
s <- forall {m :: * -> *} {e}.
(EventLift m, Monad m) =>
ResultValue e -> m (Signal ())
inputSignal ResultValue a
ext
              forall a. Signal a -> Composite (SignalHistory a)
newSignalHistory forall a b. (a -> b) -> a -> b
$
                forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM () -> Event a
transform Signal ()
s
     [SignalHistory Double]
hs1 <- forall {t :: * -> *} {a}.
(Traversable t, Fractional a) =>
t (ResultValue a) -> Composite (t (SignalHistory a))
inputHistory [ResultValue Double]
exts1
     [SignalHistory Double]
hs2 <- forall {t :: * -> *} {a}.
(Traversable t, Fractional a) =>
t (ResultValue a) -> Composite (t (SignalHistory a))
inputHistory [ResultValue Double]
exts2
     DisposableEvent -> Composite ()
disposableComposite forall a b. (a -> b) -> a -> b
$
       Event () -> DisposableEvent
DisposableEvent forall a b. (a -> b) -> a -> b
$
       do let plots :: [SignalHistory Double]
-> [ResultValue e]
-> [[PlotLines Double Double -> a x y]]
-> Event ([Plot x y], [[PlotLines Double Double -> a x y]])
plots [SignalHistory Double]
hs [ResultValue e]
exts [[PlotLines Double Double -> a x y]]
plotLineTails =
                do [Plot x y]
ps <-
                     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 [SignalHistory Double]
hs [ResultValue e]
exts (forall a. [a] -> a
head [[PlotLines Double Double -> a x y]]
plotLineTails)) forall a b. (a -> b) -> a -> b
$
                     \(SignalHistory Double
h, ResultValue e
ext, PlotLines Double Double -> a x y
plotLines) ->
                     do (Array Int Double
ts, Array Int Double
xs) <- forall a. SignalHistory a -> Event (Array Int Double, Array Int a)
readSignalHistory SignalHistory Double
h 
                        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                          forall (a :: * -> * -> *) x y. ToPlot a => a x y -> Plot x y
toPlot forall a b. (a -> b) -> a -> b
$
                          PlotLines Double Double -> a x y
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 (forall a b. [a] -> [b] -> [(a, b)]
zip (forall i e. Array i e -> [e]
elems Array Int Double
ts) (forall i e. Array i e -> [e]
elems Array Int Double
xs)) 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
.~ ([ResultId] -> String
loc forall a b. (a -> b) -> a -> b
$ forall e. ResultValue e -> [ResultId]
resultValueIdPath ResultValue e
ext) forall a b. (a -> b) -> a -> b
$
                          forall a. Default a => a
def
                   forall (m :: * -> *) a. Monad m => a -> m a
return ([Plot x y]
ps, forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [SignalHistory Double]
hs) [[PlotLines Double Double -> a x y]]
plotLineTails)
          ([Plot Double Double]
ps1, [[PlotLines Double Double -> PlotLines Double Double]]
plotLineTails) <- forall {a :: * -> * -> *} {e} {x} {y}.
ToPlot a =>
[SignalHistory Double]
-> [ResultValue e]
-> [[PlotLines Double Double -> a x y]]
-> Event ([Plot x y], [[PlotLines Double Double -> a x y]])
plots [SignalHistory Double]
hs1 [ResultValue Double]
exts1 (forall a. [a] -> [[a]]
tails [PlotLines Double Double -> PlotLines Double Double]
plotLines)
          ([Plot Double Double]
ps2, [[PlotLines Double Double -> PlotLines Double Double]]
plotLineTails) <- forall {a :: * -> * -> *} {e} {x} {y}.
ToPlot a =>
[SignalHistory Double]
-> [ResultValue e]
-> [[PlotLines Double Double -> a x y]]
-> Event ([Plot x y], [[PlotLines Double Double -> a x y]])
plots [SignalHistory Double]
hs2 [ResultValue Double]
exts2 [[PlotLines Double Double -> PlotLines Double Double]]
plotLineTails
          let ps1' :: [Either (Plot Double Double) b]
ps1' = forall a b. (a -> b) -> [a] -> [b]
map forall a b. a -> Either a b
Left [Plot Double Double]
ps1
              ps2' :: [Either a (Plot Double Double)]
ps2' = forall a b. (a -> b) -> [a] -> [b]
map forall a b. b -> Either a b
Right [Plot Double Double]
ps2
              ps' :: [Either (Plot Double Double) (Plot Double Double)]
ps'  = forall {b}. [Either (Plot Double Double) b]
ps1' forall a. [a] -> [a] -> [a]
++ forall {a}. [Either a (Plot Double Double)]
ps2'
              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 [Plot Double Double]
ps1
                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 [Plot Double Double]
ps2
                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
runPlotTitle' 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 (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
            do 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. TimeSeriesViewState r -> Experiment
timeSeriesExperiment TimeSeriesViewState 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
     
-- | 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)

-- | Get the HTML code.     
timeSeriesHtml :: TimeSeriesViewState r -> Int -> HtmlWriter ()     
timeSeriesHtml :: forall r. TimeSeriesViewState r -> Int -> HtmlWriter ()
timeSeriesHtml TimeSeriesViewState r
st Int
index =
  let n :: Int
n = Experiment -> Int
experimentRunCount forall a b. (a -> b) -> a -> b
$ forall r. TimeSeriesViewState r -> Experiment
timeSeriesExperiment TimeSeriesViewState r
st
  in if Int
n forall a. Eq a => a -> a -> Bool
== Int
1
     then forall r. TimeSeriesViewState r -> Int -> HtmlWriter ()
timeSeriesHtmlSingle TimeSeriesViewState r
st Int
index
     else forall r. TimeSeriesViewState r -> Int -> HtmlWriter ()
timeSeriesHtmlMultiple TimeSeriesViewState r
st Int
index
     
-- | Get the HTML code for a single run.
timeSeriesHtmlSingle :: TimeSeriesViewState r -> Int -> HtmlWriter ()
timeSeriesHtmlSingle :: forall r. TimeSeriesViewState r -> Int -> HtmlWriter ()
timeSeriesHtmlSingle TimeSeriesViewState r
st Int
index =
  do forall r. TimeSeriesViewState r -> Int -> HtmlWriter ()
header TimeSeriesViewState r
st Int
index
     let f :: String
f = 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 (forall r. TimeSeriesViewState r -> Map Int String
timeSeriesMap TimeSeriesViewState r
st)
     HtmlWriter () -> HtmlWriter ()
writeHtmlParagraph forall a b. (a -> b) -> a -> b
$
       String -> HtmlWriter ()
writeHtmlImage (String -> String -> String
makeRelative (forall r. TimeSeriesViewState r -> String
timeSeriesDir TimeSeriesViewState r
st) String
f)

-- | Get the HTML code for multiple runs.
timeSeriesHtmlMultiple :: TimeSeriesViewState r -> Int -> HtmlWriter ()
timeSeriesHtmlMultiple :: forall r. TimeSeriesViewState r -> Int -> HtmlWriter ()
timeSeriesHtmlMultiple TimeSeriesViewState r
st Int
index =
  do forall r. TimeSeriesViewState r -> Int -> HtmlWriter ()
header TimeSeriesViewState r
st Int
index
     let n :: Int
n = Experiment -> Int
experimentRunCount forall a b. (a -> b) -> a -> b
$ forall r. TimeSeriesViewState r -> Experiment
timeSeriesExperiment TimeSeriesViewState r
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 ->
       let f :: String
f = 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 r. TimeSeriesViewState r -> Map Int String
timeSeriesMap TimeSeriesViewState r
st)
       in HtmlWriter () -> HtmlWriter ()
writeHtmlParagraph forall a b. (a -> b) -> a -> b
$
          String -> HtmlWriter ()
writeHtmlImage (String -> String -> String
makeRelative (forall r. TimeSeriesViewState r -> String
timeSeriesDir TimeSeriesViewState r
st) String
f)

header :: TimeSeriesViewState r -> Int -> HtmlWriter ()
header :: forall r. TimeSeriesViewState r -> Int -> HtmlWriter ()
header TimeSeriesViewState 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 (TimeSeriesView -> String
timeSeriesTitle forall a b. (a -> b) -> a -> b
$ forall r. TimeSeriesViewState r -> TimeSeriesView
timeSeriesView TimeSeriesViewState r
st)
     let description :: String
description = TimeSeriesView -> String
timeSeriesDescription forall a b. (a -> b) -> a -> b
$ forall r. TimeSeriesViewState r -> TimeSeriesView
timeSeriesView TimeSeriesViewState 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.
timeSeriesTOCHtml :: TimeSeriesViewState r -> Int -> HtmlWriter ()
timeSeriesTOCHtml :: forall r. TimeSeriesViewState r -> Int -> HtmlWriter ()
timeSeriesTOCHtml TimeSeriesViewState 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 (TimeSeriesView -> String
timeSeriesTitle forall a b. (a -> b) -> a -> b
$ forall r. TimeSeriesViewState r -> TimeSeriesView
timeSeriesView TimeSeriesViewState r
st)