{-# LANGUAGE MultiParamTypeClasses #-}

-- |
-- Module     : Simulation.Aivika.Experiment.Chart.HistogramView
-- 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 'HistogramView' that plots the histogram
-- collecting statistics in all integration time points and does
-- it for every simulation run separately.
--

module Simulation.Aivika.Experiment.Chart.HistogramView
       (HistogramView(..), 
        defaultHistogramView) 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.Monoid
import Data.Array
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 (colourisePlotBars)
import Simulation.Aivika.Experiment.Histogram

-- | Defines the 'View' that plots the histogram collecting statistics
-- for all integration time points but for each simulation run separately.
data HistogramView =
  HistogramView { HistogramView -> String
histogramTitle       :: String,
                  -- ^ This is a title used in HTML.
                  HistogramView -> String
histogramDescription :: String,
                  -- ^ This is a description used in HTML.
                  HistogramView -> Int
histogramWidth       :: Int,
                  -- ^ The width of the histogram.
                  HistogramView -> Int
histogramHeight      :: Int,
                  -- ^ The height of the histogram.
                  HistogramView -> ExperimentFilePath
histogramFileName    :: 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
                  --
                  -- @
                  --   histogramFileName = UniqueFilePath \"$TITLE - $RUN_INDEX\"
                  -- @
                  HistogramView -> Event Bool
histogramPredicate   :: Event Bool,
                  -- ^ It specifies the predicate that defines
                  -- when we count data when plotting the histogram.
                  HistogramView -> [[Double]] -> Histogram
histogramBuild       :: [[Double]] -> Histogram, 
                  -- ^ Builds a histogram by the specified list of 
                  -- data series.
                  HistogramView -> ResultTransform
histogramTransform   :: ResultTransform,
                  -- ^ The transform applied to the results before receiving series.
                  HistogramView -> ResultTransform
histogramSeries      :: ResultTransform, 
                  -- ^ It defines the series to be plotted on the histogram.
                  HistogramView -> String
histogramPlotTitle   :: String,
                  -- ^ This is a title used in the histogram when
                  -- simulating a single run. It may include 
                  -- special variable @$TITLE@.
                  --
                  -- An example is
                  --
                  -- @
                  --   histogramPlotTitle = \"$TITLE\"
                  -- @
                  HistogramView -> String
histogramRunPlotTitle :: String,
                  -- ^ The run title for the histogram. It is used 
                  -- when simulating multiple runs and it may 
                  -- include special variables @$RUN_INDEX@, 
                  -- @$RUN_COUNT@ and @$PLOT_TITLE@.
                  --
                  -- An example is 
                  --
                  -- @
                  --   histogramRunPlotTitle = \"$PLOT_TITLE / Run $RUN_INDEX of $RUN_COUNT\"
                  -- @
                  HistogramView -> PlotBars Double Double -> PlotBars Double Double
histogramPlotBars :: PlotBars Double Double ->
                                       PlotBars Double Double,
                  -- ^ A transformation based on which the plot bar
                  -- is constructed for the series. 
                  --
                  -- Here you can define a colour or style of
                  -- the plot bars.
                  HistogramView -> Layout Double Double -> Layout Double Double
histogramLayout :: Layout Double Double ->
                                     Layout Double Double
                  -- ^ A transformation of the plot layout, 
                  -- where you can redefine the axes, for example.
                }
  
-- | The default histogram view.  
defaultHistogramView :: HistogramView
defaultHistogramView :: HistogramView
defaultHistogramView = 
  HistogramView { histogramTitle :: String
histogramTitle       = String
"Histogram",
                  histogramDescription :: String
histogramDescription = String
"It shows the histogram(s) by data gathered in the integration time points.",
                  histogramWidth :: Int
histogramWidth       = Int
640,
                  histogramHeight :: Int
histogramHeight      = Int
480,
                  histogramFileName :: ExperimentFilePath
histogramFileName    = String -> ExperimentFilePath
UniqueFilePath String
"Histogram($RUN_INDEX)",
                  histogramPredicate :: Event Bool
histogramPredicate   = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True,
                  histogramBuild :: [[Double]] -> Histogram
histogramBuild       = BinningStrategy -> [[Double]] -> Histogram
histogram BinningStrategy
binSturges,
                  histogramTransform :: ResultTransform
histogramTransform   = forall a. a -> a
id,
                  histogramSeries :: ResultTransform
histogramSeries      = forall a. Monoid a => a
mempty, 
                  histogramPlotTitle :: String
histogramPlotTitle   = String
"$TITLE",
                  histogramRunPlotTitle :: String
histogramRunPlotTitle = String
"$PLOT_TITLE / Run $RUN_INDEX of $RUN_COUNT",
                  histogramPlotBars :: PlotBars Double Double -> PlotBars Double Double
histogramPlotBars    = forall x y. PlotBars x y -> PlotBars x y
colourisePlotBars,
                  histogramLayout :: Layout Double Double -> Layout Double Double
histogramLayout      = forall a. a -> a
id }

instance ChartRendering r => ExperimentView HistogramView (WebPageRenderer r) where
  
  outputView :: HistogramView -> ExperimentGenerator (WebPageRenderer r)
outputView HistogramView
v = 
    let reporter :: Experiment
-> WebPageRenderer r
-> String
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
reporter Experiment
exp (WebPageRenderer r
renderer ExperimentFilePath
_) String
dir =
          do HistogramViewState r
st <- forall r.
ChartRendering r =>
HistogramView
-> Experiment
-> r
-> String
-> ExperimentWriter (HistogramViewState r)
newHistogram HistogramView
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. HistogramViewState r -> Int -> HtmlWriter ()
histogramTOCHtml HistogramViewState r
st,
                                   reporterWriteHtml :: Int -> HtmlWriter ()
reporterWriteHtml    = forall r. HistogramViewState r -> Int -> HtmlWriter ()
histogramHtml HistogramViewState 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 =>
HistogramViewState r -> ExperimentData -> Composite ()
simulateHistogram HistogramViewState 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 HistogramView (FileRenderer r) where
  
  outputView :: HistogramView -> ExperimentGenerator (FileRenderer r)
outputView HistogramView
v = 
    let reporter :: Experiment
-> FileRenderer r
-> String
-> ExperimentWriter (ExperimentReporter (FileRenderer a))
reporter Experiment
exp (FileRenderer r
renderer ExperimentFilePath
_) String
dir =
          do HistogramViewState r
st <- forall r.
ChartRendering r =>
HistogramView
-> Experiment
-> r
-> String
-> ExperimentWriter (HistogramViewState r)
newHistogram HistogramView
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 =>
HistogramViewState r -> ExperimentData -> Composite ()
simulateHistogram HistogramViewState 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 HistogramViewState r =
  HistogramViewState { forall r. HistogramViewState r -> HistogramView
histogramView       :: HistogramView,
                       forall r. HistogramViewState r -> Experiment
histogramExperiment :: Experiment,
                       forall r. HistogramViewState r -> r
histogramRenderer   :: r,
                       forall r. HistogramViewState r -> String
histogramDir        :: FilePath, 
                       forall r. HistogramViewState r -> Map Int String
histogramMap        :: M.Map Int FilePath }
  
-- | Create a new state of the view.
newHistogram :: ChartRendering r => HistogramView -> Experiment -> r -> FilePath -> ExperimentWriter (HistogramViewState r)
newHistogram :: forall r.
ChartRendering r =>
HistogramView
-> Experiment
-> r
-> String
-> ExperimentWriter (HistogramViewState r)
newHistogram HistogramView
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 (HistogramView -> ExperimentFilePath
histogramFileName HistogramView
view) forall a b. (a -> b) -> a -> b
$
       forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(String
"$TITLE", HistogramView -> String
histogramTitle HistogramView
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 HistogramViewState { histogramView :: HistogramView
histogramView       = HistogramView
view,
                                 histogramExperiment :: Experiment
histogramExperiment = Experiment
exp,
                                 histogramRenderer :: r
histogramRenderer   = r
renderer,
                                 histogramDir :: String
histogramDir        = String
dir, 
                                 histogramMap :: Map Int String
histogramMap        = Map Int String
m }
       
-- | Plot the histogram during the simulation.
simulateHistogram :: ChartRendering r => HistogramViewState r -> ExperimentData -> Composite ()
simulateHistogram :: forall r.
ChartRendering r =>
HistogramViewState r -> ExperimentData -> Composite ()
simulateHistogram HistogramViewState r
st ExperimentData
expdata =
  do let view :: HistogramView
view    = forall r. HistogramViewState r -> HistogramView
histogramView HistogramViewState 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. HistogramViewState r -> Experiment
histogramExperiment HistogramViewState r
st
         rs :: Results
rs      = HistogramView -> ResultTransform
histogramSeries HistogramView
view forall a b. (a -> b) -> a -> b
$
                   HistogramView -> ResultTransform
histogramTransform HistogramView
view forall a b. (a -> b) -> a -> b
$
                   ExperimentData -> Results
experimentResults ExperimentData
expdata
         exts :: [ResultValue [Double]]
exts    = Results -> [ResultValue [Double]]
resultsToDoubleListValues Results
rs
         names :: [String]
names   = forall a b. (a -> b) -> [a] -> [b]
map ([ResultId] -> String
loc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. ResultValue e -> [ResultId]
resultValueIdPath) [ResultValue [Double]]
exts
         signals :: ResultPredefinedSignals
signals = ExperimentData -> ResultPredefinedSignals
experimentPredefinedSignals ExperimentData
expdata
         n :: Int
n = Experiment -> Int
experimentRunCount forall a b. (a -> b) -> a -> b
$ forall r. HistogramViewState r -> Experiment
histogramExperiment HistogramViewState r
st
         build :: [[Double]] -> Histogram
build   = HistogramView -> [[Double]] -> Histogram
histogramBuild HistogramView
view
         width :: Int
width   = HistogramView -> Int
histogramWidth HistogramView
view
         height :: Int
height  = HistogramView -> Int
histogramHeight HistogramView
view
         predicate :: Event Bool
predicate  = HistogramView -> Event Bool
histogramPredicate HistogramView
view
         title :: String
title   = HistogramView -> String
histogramTitle HistogramView
view
         plotTitle :: String
plotTitle  = HistogramView -> String
histogramPlotTitle HistogramView
view
         runPlotTitle :: String
runPlotTitle = HistogramView -> String
histogramRunPlotTitle HistogramView
view
         bars :: PlotBars Double Double -> PlotBars Double Double
bars       = HistogramView -> PlotBars Double Double -> PlotBars Double Double
histogramPlotBars HistogramView
view
         layout :: Layout Double Double -> Layout Double Double
layout     = HistogramView -> Layout Double Double -> Layout Double Double
histogramLayout HistogramView
view
         renderer :: r
renderer   = forall r. HistogramViewState r -> r
histogramRenderer HistogramViewState 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. HistogramViewState r -> Map Int String
histogramMap HistogramViewState 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
     [SignalHistory [Double]]
hs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ResultValue [Double]]
exts forall a b. (a -> b) -> a -> b
$ \ResultValue [Double]
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 (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall e. ResultValue e -> ResultData e
resultValueData ResultValue [Double]
ext) forall a b. (a -> b) -> a -> b
$
       forall a. (a -> Event Bool) -> Signal a -> Signal a
filterSignalM (forall a b. a -> b -> a
const Event Bool
predicate) forall a b. (a -> b) -> a -> b
$
       ResultPredefinedSignals -> Signal Double
resultSignalInIntegTimes ResultPredefinedSignals
signals
     DisposableEvent -> Composite ()
disposableComposite forall a b. (a -> b) -> a -> b
$
       Event () -> DisposableEvent
DisposableEvent forall a b. (a -> b) -> a -> b
$
       do [(Array Int Double, Array Int [Double])]
xs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [SignalHistory [Double]]
hs forall a. SignalHistory a -> Event (Array Int Double, Array Int a)
readSignalHistory
          let zs :: [(Double, [Double])]
zs = Histogram -> [(Double, [Double])]
histogramToBars forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [(Double, a)] -> [(Double, a)]
filterHistogram forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Double]] -> Histogram
build forall a b. (a -> b) -> a -> b
$ 
                   forall a b. (a -> b) -> [a] -> [b]
map ([Double] -> [Double]
filterData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i e. Array i e -> [e]
elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Array Int Double, Array Int [Double])]
xs
              p :: Plot Double Double
p  = forall y x. BarsPlotValue y => PlotBars x y -> Plot x y
plotBars forall a b. (a -> b) -> a -> b
$
                   PlotBars Double Double -> PlotBars Double Double
bars forall a b. (a -> b) -> a -> b
$
                   forall x1 y x2.
Lens (PlotBars x1 y) (PlotBars x2 y) [(x1, [y])] [(x2, [y])]
plot_bars_values forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Double, [Double])]
zs forall a b. (a -> b) -> a -> b
$
                   forall x y. Lens' (PlotBars x y) [String]
plot_bars_titles forall s t a b. ASetter s t a b -> b -> s -> t
.~ [String]
names forall a b. (a -> b) -> a -> b
$
                   forall a. Default a => a
def
              updateAxes :: Layout x y -> Layout x y
updateAxes =
                if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Double, [Double])]
zs
                then let v :: AxisVisibility
v = Bool -> Bool -> Bool -> AxisVisibility
AxisVisibility Bool
True Bool
False Bool
False
                     in \Layout x y
l -> forall x y. Lens' (Layout x y) AxisVisibility
layout_top_axis_visibility forall s t a b. ASetter s t a b -> b -> s -> t
.~ AxisVisibility
v forall a b. (a -> b) -> a -> b
$
                              forall x y. Lens' (Layout x y) AxisVisibility
layout_bottom_axis_visibility forall s t a b. ASetter s t a b -> b -> s -> t
.~ AxisVisibility
v forall a b. (a -> b) -> a -> b
$
                              forall x y. Lens' (Layout x y) AxisVisibility
layout_left_axis_visibility forall s t a b. ASetter s t a b -> b -> s -> t
.~ AxisVisibility
v forall a b. (a -> b) -> a -> b
$
                              forall x y. Lens' (Layout x y) AxisVisibility
layout_right_axis_visibility forall s t a b. ASetter s t a b -> b -> s -> t
.~ AxisVisibility
v forall a b. (a -> b) -> a -> b
$
                              Layout x y
l
                else forall a. a -> a
id
              chart :: Layout Double Double
chart = Layout Double Double -> Layout Double Double
layout forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      forall r.
ChartRendering r =>
r -> Layout Double Double -> Layout Double Double
renderingLayout r
renderer forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      forall {x} {y}. Layout x y -> Layout x y
updateAxes forall a b. (a -> b) -> a -> b
$
                      forall x y. Lens' (Layout x y) String
layout_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 y. Lens' (Layout x y) [Plot x y]
layout_plots forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Plot Double Double
p] 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 Layout Double Double
chart)
               forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Experiment -> Bool
experimentVerbose forall a b. (a -> b) -> a -> b
$ forall r. HistogramViewState r -> Experiment
histogramExperiment HistogramViewState 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.     
filterData :: [Double] -> [Double]
filterData :: [Double] -> [Double]
filterData = forall a. (a -> Bool) -> [a] -> [a]
filter (\Double
x -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ 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.     
filterHistogram :: [(Double, a)] -> [(Double, a)]
filterHistogram :: forall a. [(Double, a)] -> [(Double, a)]
filterHistogram = forall a. (a -> Bool) -> [a] -> [a]
filter (\(Double
x, a
_) -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => a -> Bool
isNaN Double
x Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isInfinite Double
x)
  
-- | Convert a histogram to the bars.
histogramToBars :: [(Double, [Int])] -> [(Double, [Double])]
histogramToBars :: Histogram -> [(Double, [Double])]
histogramToBars = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a -> b) -> a -> b
$ \(Double
x, [Int]
ns) -> (Double
x, forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int]
ns)

-- | Get the HTML code.     
histogramHtml :: HistogramViewState r -> Int -> HtmlWriter ()     
histogramHtml :: forall r. HistogramViewState r -> Int -> HtmlWriter ()
histogramHtml HistogramViewState r
st Int
index =
  let n :: Int
n = Experiment -> Int
experimentRunCount forall a b. (a -> b) -> a -> b
$ forall r. HistogramViewState r -> Experiment
histogramExperiment HistogramViewState r
st
  in if Int
n forall a. Eq a => a -> a -> Bool
== Int
1
     then forall r. HistogramViewState r -> Int -> HtmlWriter ()
histogramHtmlSingle HistogramViewState r
st Int
index
     else forall r. HistogramViewState r -> Int -> HtmlWriter ()
histogramHtmlMultiple HistogramViewState r
st Int
index
     
-- | Get the HTML code for a single run.
histogramHtmlSingle :: HistogramViewState r -> Int -> HtmlWriter ()
histogramHtmlSingle :: forall r. HistogramViewState r -> Int -> HtmlWriter ()
histogramHtmlSingle HistogramViewState r
st Int
index =
  do forall r. HistogramViewState r -> Int -> HtmlWriter ()
header HistogramViewState 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. HistogramViewState r -> Map Int String
histogramMap HistogramViewState r
st)
     HtmlWriter () -> HtmlWriter ()
writeHtmlParagraph forall a b. (a -> b) -> a -> b
$
       String -> HtmlWriter ()
writeHtmlImage (String -> String -> String
makeRelative (forall r. HistogramViewState r -> String
histogramDir HistogramViewState r
st) String
f)

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

header :: HistogramViewState r -> Int -> HtmlWriter ()
header :: forall r. HistogramViewState r -> Int -> HtmlWriter ()
header HistogramViewState 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 (HistogramView -> String
histogramTitle forall a b. (a -> b) -> a -> b
$ forall r. HistogramViewState r -> HistogramView
histogramView HistogramViewState r
st)
     let description :: String
description = HistogramView -> String
histogramDescription forall a b. (a -> b) -> a -> b
$ forall r. HistogramViewState r -> HistogramView
histogramView HistogramViewState 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.
histogramTOCHtml :: HistogramViewState r -> Int -> HtmlWriter ()
histogramTOCHtml :: forall r. HistogramViewState r -> Int -> HtmlWriter ()
histogramTOCHtml HistogramViewState 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 (HistogramView -> String
histogramTitle forall a b. (a -> b) -> a -> b
$ forall r. HistogramViewState r -> HistogramView
histogramView HistogramViewState r
st)