{-# LANGUAGE MultiParamTypeClasses #-}

-- |
-- Module     : Simulation.Aivika.Experiment.Chart.FinalHistogramView
-- 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 'FinalHistogramView' that plots a histogram
-- by the specified series in final time points collected from different 
-- simulation runs.
--

module Simulation.Aivika.Experiment.Chart.FinalHistogramView
       (FinalHistogramView(..), 
        defaultFinalHistogramView) 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 (colourisePlotBars)

-- | Defines the 'View' that plots the histogram
-- for the specified series in final time points
-- collected from different simulation runs.
data FinalHistogramView =
  FinalHistogramView { FinalHistogramView -> String
finalHistogramTitle       :: String,
                       -- ^ This is a title used in HTML.
                       FinalHistogramView -> String
finalHistogramDescription :: String,
                       -- ^ This is a description used in HTML.
                       FinalHistogramView -> Int
finalHistogramWidth       :: Int,
                       -- ^ The width of the histogram.
                       FinalHistogramView -> Int
finalHistogramHeight      :: Int,
                       -- ^ The height of the histogram.
                       FinalHistogramView -> ExperimentFilePath
finalHistogramFileName    :: ExperimentFilePath,
                       -- ^ It defines the file name with optional extension for each image to be saved.
                       -- It may include special variable @$TITLE@.
                       --
                       -- An example is
                       --
                       -- @
                       --   finalHistogramFileName = UniqueFilePath \"$TITLE\"
                       -- @
                       FinalHistogramView -> Event Bool
finalHistogramPredicate   :: Event Bool,
                       -- ^ It specifies the predicate that defines
                       -- when we count data when plotting the histogram.
                       FinalHistogramView -> [[Double]] -> Histogram
finalHistogramBuild       :: [[Double]] -> Histogram, 
                       -- ^ Builds a histogram by the specified list of 
                       -- data series.
                       FinalHistogramView -> ResultTransform
finalHistogramTransform   :: ResultTransform,
                       -- ^ The transform applied to the results before receiving series.
                       FinalHistogramView -> ResultTransform
finalHistogramSeries      :: ResultTransform, 
                       -- ^ It defines the series to be plotted on the histogram.
                       FinalHistogramView -> String
finalHistogramPlotTitle   :: String,
                       -- ^ This is a title used in the histogram. 
                       -- It may include special variable @$TITLE@.
                       --
                       -- An example is
                       --
                       -- @
                       --   finalHistogramPlotTitle = \"$TITLE\"
                       -- @
                       FinalHistogramView
-> PlotBars Double Double -> PlotBars Double Double
finalHistogramPlotBars :: 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.
                       FinalHistogramView -> Layout Double Double -> Layout Double Double
finalHistogramLayout :: Layout Double Double ->
                                               Layout Double Double
                       -- ^ A transformation of the plot layout, 
                       -- where you can redefine the axes, for example.
                 }
  
-- | The default histogram view.  
defaultFinalHistogramView :: FinalHistogramView
defaultFinalHistogramView :: FinalHistogramView
defaultFinalHistogramView = 
  FinalHistogramView { finalHistogramTitle :: String
finalHistogramTitle       = String
"Final Histogram",
                       finalHistogramDescription :: String
finalHistogramDescription = String
"It shows a histogram by data gathered in the final time points.",
                       finalHistogramWidth :: Int
finalHistogramWidth       = Int
640,
                       finalHistogramHeight :: Int
finalHistogramHeight      = Int
480,
                       finalHistogramFileName :: ExperimentFilePath
finalHistogramFileName    = String -> ExperimentFilePath
UniqueFilePath String
"FinalHistogram",
                       finalHistogramPredicate :: Event Bool
finalHistogramPredicate   = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True,
                       finalHistogramBuild :: [[Double]] -> Histogram
finalHistogramBuild       = BinningStrategy -> [[Double]] -> Histogram
histogram BinningStrategy
binSturges,
                       finalHistogramTransform :: ResultTransform
finalHistogramTransform   = forall a. a -> a
id,
                       finalHistogramSeries :: ResultTransform
finalHistogramSeries      = forall a. Monoid a => a
mempty, 
                       finalHistogramPlotTitle :: String
finalHistogramPlotTitle   = String
"$TITLE",
                       finalHistogramPlotBars :: PlotBars Double Double -> PlotBars Double Double
finalHistogramPlotBars    = forall x y. PlotBars x y -> PlotBars x y
colourisePlotBars,
                       finalHistogramLayout :: Layout Double Double -> Layout Double Double
finalHistogramLayout      = forall a. a -> a
id }

instance ChartRendering r => ExperimentView FinalHistogramView (WebPageRenderer r) where
  
  outputView :: FinalHistogramView -> ExperimentGenerator (WebPageRenderer r)
outputView FinalHistogramView
v = 
    let reporter :: Experiment
-> WebPageRenderer r
-> String
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
reporter Experiment
exp (WebPageRenderer r
renderer ExperimentFilePath
_) String
dir =
          do FinalHistogramViewState r
st <- forall r.
FinalHistogramView
-> Experiment
-> r
-> String
-> ExperimentWriter (FinalHistogramViewState r)
newFinalHistogram FinalHistogramView
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. FinalHistogramViewState r -> Int -> HtmlWriter ()
finalHistogramTOCHtml FinalHistogramViewState r
st,
                                   reporterWriteHtml :: Int -> HtmlWriter ()
reporterWriteHtml    = forall r. FinalHistogramViewState r -> Int -> HtmlWriter ()
finalHistogramHtml FinalHistogramViewState 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 =>
FinalHistogramViewState r -> ExperimentWriter ()
finaliseFinalHistogram FinalHistogramViewState r
st,
                                         reporterSimulate :: ExperimentData -> Composite ()
reporterSimulate   = forall r.
FinalHistogramViewState r -> ExperimentData -> Composite ()
simulateFinalHistogram FinalHistogramViewState 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 FinalHistogramView (FileRenderer r) where
  
  outputView :: FinalHistogramView -> ExperimentGenerator (FileRenderer r)
outputView FinalHistogramView
v = 
    let reporter :: Experiment
-> FileRenderer r
-> String
-> ExperimentWriter (ExperimentReporter (FileRenderer a))
reporter Experiment
exp (FileRenderer r
renderer ExperimentFilePath
_) String
dir =
          do FinalHistogramViewState r
st <- forall r.
FinalHistogramView
-> Experiment
-> r
-> String
-> ExperimentWriter (FinalHistogramViewState r)
newFinalHistogram FinalHistogramView
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 =>
FinalHistogramViewState r -> ExperimentWriter ()
finaliseFinalHistogram FinalHistogramViewState r
st,
                                         reporterSimulate :: ExperimentData -> Composite ()
reporterSimulate   = forall r.
FinalHistogramViewState r -> ExperimentData -> Composite ()
simulateFinalHistogram FinalHistogramViewState 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 FinalHistogramViewState r =
  FinalHistogramViewState { forall r. FinalHistogramViewState r -> FinalHistogramView
finalHistogramView       :: FinalHistogramView,
                            forall r. FinalHistogramViewState r -> Experiment
finalHistogramExperiment :: Experiment,
                            forall r. FinalHistogramViewState r -> r
finalHistogramRenderer   :: r,
                            forall r. FinalHistogramViewState r -> String
finalHistogramDir        :: FilePath, 
                            forall r. FinalHistogramViewState r -> IORef (Maybe String)
finalHistogramFile       :: IORef (Maybe FilePath),
                            forall r.
FinalHistogramViewState r -> MVar (Maybe FinalHistogramResults)
finalHistogramResults    :: MVar (Maybe FinalHistogramResults) }

-- | The histogram item.
data FinalHistogramResults =
  FinalHistogramResults { FinalHistogramResults -> [String]
finalHistogramNames  :: [String],
                          FinalHistogramResults -> [MVar [Double]]
finalHistogramValues :: [MVar [Double]] }
  
-- | Create a new state of the view.
newFinalHistogram :: FinalHistogramView -> Experiment -> r -> FilePath -> ExperimentWriter (FinalHistogramViewState r)
newFinalHistogram :: forall r.
FinalHistogramView
-> Experiment
-> r
-> String
-> ExperimentWriter (FinalHistogramViewState r)
newFinalHistogram FinalHistogramView
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 FinalHistogramResults)
r <- forall a. a -> IO (MVar a)
newMVar forall a. Maybe a
Nothing
     forall (m :: * -> *) a. Monad m => a -> m a
return FinalHistogramViewState { finalHistogramView :: FinalHistogramView
finalHistogramView       = FinalHistogramView
view,
                                      finalHistogramExperiment :: Experiment
finalHistogramExperiment = Experiment
exp,
                                      finalHistogramRenderer :: r
finalHistogramRenderer   = r
renderer,
                                      finalHistogramDir :: String
finalHistogramDir        = String
dir, 
                                      finalHistogramFile :: IORef (Maybe String)
finalHistogramFile       = IORef (Maybe String)
f,
                                      finalHistogramResults :: MVar (Maybe FinalHistogramResults)
finalHistogramResults    = MVar (Maybe FinalHistogramResults)
r }
       
-- | Create new histogram results.
newFinalHistogramResults :: [String] -> Experiment -> IO FinalHistogramResults
newFinalHistogramResults :: [String] -> Experiment -> IO FinalHistogramResults
newFinalHistogramResults [String]
names Experiment
exp =
  do [MVar [Double]]
values <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
names forall a b. (a -> b) -> a -> b
$ \String
_ -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (MVar a)
newMVar []
     forall (m :: * -> *) a. Monad m => a -> m a
return FinalHistogramResults { finalHistogramNames :: [String]
finalHistogramNames  = [String]
names,
                                    finalHistogramValues :: [MVar [Double]]
finalHistogramValues = [MVar [Double]]
values }
       
-- | Require to return unique results associated with the specified state. 
requireFinalHistogramResults :: FinalHistogramViewState r -> [String] -> IO FinalHistogramResults
requireFinalHistogramResults :: forall r.
FinalHistogramViewState r -> [String] -> IO FinalHistogramResults
requireFinalHistogramResults FinalHistogramViewState r
st [String]
names =
  forall a b. MVar (Maybe a) -> IO a -> (a -> IO b) -> IO b
maybePutMVar (forall r.
FinalHistogramViewState r -> MVar (Maybe FinalHistogramResults)
finalHistogramResults FinalHistogramViewState r
st)
  ([String] -> Experiment -> IO FinalHistogramResults
newFinalHistogramResults [String]
names (forall r. FinalHistogramViewState r -> Experiment
finalHistogramExperiment FinalHistogramViewState r
st)) forall a b. (a -> b) -> a -> b
$ \FinalHistogramResults
results ->
  if ([String]
names forall a. Eq a => a -> a -> Bool
/= FinalHistogramResults -> [String]
finalHistogramNames FinalHistogramResults
results)
  then forall a. HasCallStack => String -> a
error String
"Series with different names are returned for different runs: requireFinalHistogramResults"
  else forall (m :: * -> *) a. Monad m => a -> m a
return FinalHistogramResults
results

-- | Simulation of the specified series.
simulateFinalHistogram :: FinalHistogramViewState r -> ExperimentData -> Composite ()
simulateFinalHistogram :: forall r.
FinalHistogramViewState r -> ExperimentData -> Composite ()
simulateFinalHistogram FinalHistogramViewState r
st ExperimentData
expdata =
  do let view :: FinalHistogramView
view    = forall r. FinalHistogramViewState r -> FinalHistogramView
finalHistogramView FinalHistogramViewState 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. FinalHistogramViewState r -> Experiment
finalHistogramExperiment FinalHistogramViewState r
st
         rs :: Results
rs      = FinalHistogramView -> ResultTransform
finalHistogramSeries FinalHistogramView
view forall a b. (a -> b) -> a -> b
$
                   FinalHistogramView -> ResultTransform
finalHistogramTransform FinalHistogramView
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
         signal :: Signal Double
signal  = forall a. (a -> Event Bool) -> Signal a -> Signal a
filterSignalM (forall a b. a -> b -> a
const Event Bool
predicate) forall a b. (a -> b) -> a -> b
$
                   ResultPredefinedSignals -> Signal Double
resultSignalInStopTime ResultPredefinedSignals
signals
         predicate :: Event Bool
predicate = FinalHistogramView -> Event Bool
finalHistogramPredicate FinalHistogramView
view
     FinalHistogramResults
results <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall r.
FinalHistogramViewState r -> [String] -> IO FinalHistogramResults
requireFinalHistogramResults FinalHistogramViewState r
st [String]
names
     let values :: [MVar [Double]]
values = FinalHistogramResults -> [MVar [Double]]
finalHistogramValues FinalHistogramResults
results
     forall a. Signal a -> (a -> Event ()) -> Composite ()
handleSignalComposite Signal Double
signal forall a b. (a -> b) -> a -> b
$ \Double
_ ->
       do [[Double]]
xs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ResultValue [Double]]
exts forall e. ResultValue e -> ResultData e
resultValueData
          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_ (forall a b. [a] -> [b] -> [(a, b)]
zip [[Double]]
xs [MVar [Double]]
values) forall a b. (a -> b) -> a -> b
$ \([Double]
x, MVar [Double]
values) ->
            forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar [Double]
values forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a] -> [a]
(++) [Double]
x
     
-- | Plot the histogram after the simulation is complete.
finaliseFinalHistogram :: ChartRendering r => FinalHistogramViewState r -> ExperimentWriter ()
finaliseFinalHistogram :: forall r.
ChartRendering r =>
FinalHistogramViewState r -> ExperimentWriter ()
finaliseFinalHistogram FinalHistogramViewState r
st =
  do let view :: FinalHistogramView
view = forall r. FinalHistogramViewState r -> FinalHistogramView
finalHistogramView FinalHistogramViewState r
st
         title :: String
title = FinalHistogramView -> String
finalHistogramTitle FinalHistogramView
view
         plotTitle :: String
plotTitle = FinalHistogramView -> String
finalHistogramPlotTitle FinalHistogramView
view
         plotTitle' :: String
plotTitle' = 
           String -> String -> String -> String
replace String
"$TITLE" String
title
           String
plotTitle
         width :: Int
width = FinalHistogramView -> Int
finalHistogramWidth FinalHistogramView
view
         height :: Int
height = FinalHistogramView -> Int
finalHistogramHeight FinalHistogramView
view
         histogram :: [[Double]] -> Histogram
histogram = FinalHistogramView -> [[Double]] -> Histogram
finalHistogramBuild FinalHistogramView
view
         bars :: PlotBars Double Double -> PlotBars Double Double
bars = FinalHistogramView
-> PlotBars Double Double -> PlotBars Double Double
finalHistogramPlotBars FinalHistogramView
view
         layout :: Layout Double Double -> Layout Double Double
layout = FinalHistogramView -> Layout Double Double -> Layout Double Double
finalHistogramLayout FinalHistogramView
view
         renderer :: r
renderer = forall r. FinalHistogramViewState r -> r
finalHistogramRenderer FinalHistogramViewState r
st
     String
file <- String -> ExperimentFilePath -> ExperimentWriter String
resolveFilePath (forall r. FinalHistogramViewState r -> String
finalHistogramDir FinalHistogramViewState 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 (FinalHistogramView -> ExperimentFilePath
finalHistogramFileName FinalHistogramView
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 FinalHistogramResults
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.
FinalHistogramViewState r -> MVar (Maybe FinalHistogramResults)
finalHistogramResults FinalHistogramViewState r
st
     case Maybe FinalHistogramResults
results of
       Maybe FinalHistogramResults
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Just FinalHistogramResults
results ->
         forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
         do let names :: [String]
names  = FinalHistogramResults -> [String]
finalHistogramNames FinalHistogramResults
results
                values :: [MVar [Double]]
values = FinalHistogramResults -> [MVar [Double]]
finalHistogramValues FinalHistogramResults
results
            [[Double]]
xs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [MVar [Double]]
values forall a. MVar a -> IO a
readMVar
            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
histogram forall a b. (a -> b) -> a -> b
$ 
                     forall a b. (a -> b) -> [a] -> [b]
map [Double] -> [Double]
filterData [[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
plotTitle' 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 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. FinalHistogramViewState r -> Experiment
finalHistogramExperiment FinalHistogramViewState 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. FinalHistogramViewState r -> IORef (Maybe String)
finalHistogramFile FinalHistogramViewState r
st) forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just 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.     
finalHistogramHtml :: FinalHistogramViewState r -> Int -> HtmlWriter ()
finalHistogramHtml :: forall r. FinalHistogramViewState r -> Int -> HtmlWriter ()
finalHistogramHtml FinalHistogramViewState r
st Int
index =
  do forall r. FinalHistogramViewState r -> Int -> HtmlWriter ()
header FinalHistogramViewState 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. FinalHistogramViewState r -> IORef (Maybe String)
finalHistogramFile FinalHistogramViewState 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. FinalHistogramViewState r -> String
finalHistogramDir FinalHistogramViewState r
st) String
f)

header :: FinalHistogramViewState r -> Int -> HtmlWriter ()
header :: forall r. FinalHistogramViewState r -> Int -> HtmlWriter ()
header FinalHistogramViewState 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 (FinalHistogramView -> String
finalHistogramTitle forall a b. (a -> b) -> a -> b
$ forall r. FinalHistogramViewState r -> FinalHistogramView
finalHistogramView FinalHistogramViewState r
st)
     let description :: String
description = FinalHistogramView -> String
finalHistogramDescription forall a b. (a -> b) -> a -> b
$ forall r. FinalHistogramViewState r -> FinalHistogramView
finalHistogramView FinalHistogramViewState 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.
finalHistogramTOCHtml :: FinalHistogramViewState r -> Int -> HtmlWriter ()
finalHistogramTOCHtml :: forall r. FinalHistogramViewState r -> Int -> HtmlWriter ()
finalHistogramTOCHtml FinalHistogramViewState 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 (FinalHistogramView -> String
finalHistogramTitle forall a b. (a -> b) -> a -> b
$ forall r. FinalHistogramViewState r -> FinalHistogramView
finalHistogramView FinalHistogramViewState r
st)