{-# LANGUAGE MultiParamTypeClasses #-} -- | -- Module : Simulation.Aivika.Experiment.Chart.HistogramView -- Copyright : Copyright (c) 2012-2015, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental -- Tested with: GHC 7.10.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.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 { histogramTitle :: String, -- ^ This is a title used in HTML. histogramDescription :: String, -- ^ This is a description used in HTML. histogramWidth :: Int, -- ^ The width of the histogram. histogramHeight :: Int, -- ^ The height of the histogram. 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\" -- @ histogramPredicate :: Event Bool, -- ^ It specifies the predicate that defines -- when we count data when plotting the histogram. histogramBuild :: [[Double]] -> Histogram, -- ^ Builds a histogram by the specified list of -- data series. histogramTransform :: ResultTransform, -- ^ The transform applied to the results before receiving series. histogramSeries :: ResultTransform, -- ^ It defines the series to be plotted on the histogram. 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\" -- @ 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\" -- @ 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. 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 { histogramTitle = "Histogram", histogramDescription = "It shows the histogram(s) by data gathered in the integration time points.", histogramWidth = 640, histogramHeight = 480, histogramFileName = UniqueFilePath "Histogram($RUN_INDEX)", histogramPredicate = return True, histogramBuild = histogram binSturges, histogramTransform = id, histogramSeries = mempty, histogramPlotTitle = "$TITLE", histogramRunPlotTitle = "$PLOT_TITLE / Run $RUN_INDEX of $RUN_COUNT", histogramPlotBars = colourisePlotBars, histogramLayout = id } instance ChartRendering r => ExperimentView HistogramView (WebPageRenderer r) where outputView v = let reporter exp (WebPageRenderer renderer) dir = do st <- newHistogram v exp renderer dir let context = WebPageContext $ WebPageWriter { reporterWriteTOCHtml = histogramTOCHtml st, reporterWriteHtml = histogramHtml st } return ExperimentReporter { reporterInitialise = return (), reporterFinalise = return (), reporterSimulate = simulateHistogram st, reporterContext = context } in ExperimentGenerator { generateReporter = reporter } instance ChartRendering r => ExperimentView HistogramView (FileRenderer r) where outputView v = let reporter exp (FileRenderer renderer) dir = do st <- newHistogram v exp renderer dir return ExperimentReporter { reporterInitialise = return (), reporterFinalise = return (), reporterSimulate = simulateHistogram st, reporterContext = FileContext } in ExperimentGenerator { generateReporter = reporter } -- | The state of the view. data HistogramViewState r = HistogramViewState { histogramView :: HistogramView, histogramExperiment :: Experiment, histogramRenderer :: r, histogramDir :: FilePath, histogramMap :: M.Map Int FilePath } -- | Create a new state of the view. newHistogram :: ChartRendering r => HistogramView -> Experiment -> r -> FilePath -> ExperimentWriter (HistogramViewState r) newHistogram view exp renderer dir = do let n = experimentRunCount exp fs <- forM [0..(n - 1)] $ \i -> resolveFilePath dir $ mapFilePath (flip replaceExtension $ renderableChartExtension renderer) $ expandFilePath (histogramFileName view) $ M.fromList [("$TITLE", histogramTitle view), ("$RUN_INDEX", show $ i + 1), ("$RUN_COUNT", show n)] liftIO $ forM_ fs $ flip writeFile [] -- reserve the file names let m = M.fromList $ zip [0..(n - 1)] fs return HistogramViewState { histogramView = view, histogramExperiment = exp, histogramRenderer = renderer, histogramDir = dir, histogramMap = m } -- | Plot the histogram during the simulation. simulateHistogram :: ChartRendering r => HistogramViewState r -> ExperimentData -> Event DisposableEvent simulateHistogram st expdata = do let view = histogramView st rs = histogramSeries view $ histogramTransform view $ experimentResults expdata exts = resultsToDoubleListValues rs names = map resultValueName exts signals = experimentPredefinedSignals expdata n = experimentRunCount $ histogramExperiment st build = histogramBuild view width = histogramWidth view height = histogramHeight view predicate = histogramPredicate view title = histogramTitle view plotTitle = histogramPlotTitle view runPlotTitle = histogramRunPlotTitle view bars = histogramPlotBars view layout = histogramLayout view renderer = histogramRenderer st i <- liftParameter simulationIndex let file = fromJust $ M.lookup (i - 1) (histogramMap st) plotTitle' = replace "$TITLE" title plotTitle runPlotTitle' = if n == 1 then plotTitle' else replace "$RUN_INDEX" (show i) $ replace "$RUN_COUNT" (show n) $ replace "$PLOT_TITLE" plotTitle' runPlotTitle hs <- forM exts $ \ext -> newSignalHistory $ mapSignalM (const $ resultValueData ext) $ filterSignalM (const predicate) $ resultSignalInIntegTimes signals return $ DisposableEvent $ do xs <- forM hs readSignalHistory let zs = histogramToBars . filterHistogram . build $ map (filterData . concat . elems . snd) xs p = plotBars $ bars $ plot_bars_values .~ zs $ plot_bars_titles .~ names $ def updateAxes = if null zs then let v = AxisVisibility True False False in \l -> layout_top_axis_visibility .~ v $ layout_bottom_axis_visibility .~ v $ layout_left_axis_visibility .~ v $ layout_right_axis_visibility .~ v $ l else id chart = layout . updateAxes $ layout_title .~ runPlotTitle' $ layout_plots .~ [p] $ def liftIO $ do renderChart renderer (width, height) file (toRenderable chart) when (experimentVerbose $ histogramExperiment st) $ putStr "Generated file " >> putStrLn file -- | Remove the NaN and inifity values. filterData :: [Double] -> [Double] filterData = filter (\x -> not $ isNaN x || isInfinite x) -- | Remove the NaN and inifity values. filterHistogram :: [(Double, a)] -> [(Double, a)] filterHistogram = filter (\(x, _) -> not $ isNaN x || isInfinite x) -- | Convert a histogram to the bars. histogramToBars :: [(Double, [Int])] -> [(Double, [Double])] histogramToBars = map $ \(x, ns) -> (x, map fromIntegral ns) -- | Get the HTML code. histogramHtml :: HistogramViewState r -> Int -> HtmlWriter () histogramHtml st index = let n = experimentRunCount $ histogramExperiment st in if n == 1 then histogramHtmlSingle st index else histogramHtmlMultiple st index -- | Get the HTML code for a single run. histogramHtmlSingle :: HistogramViewState r -> Int -> HtmlWriter () histogramHtmlSingle st index = do header st index let f = fromJust $ M.lookup 0 (histogramMap st) writeHtmlParagraph $ writeHtmlImage (makeRelative (histogramDir st) f) -- | Get the HTML code for multiple runs. histogramHtmlMultiple :: HistogramViewState r -> Int -> HtmlWriter () histogramHtmlMultiple st index = do header st index let n = experimentRunCount $ histogramExperiment st forM_ [0..(n - 1)] $ \i -> let f = fromJust $ M.lookup i (histogramMap st) in writeHtmlParagraph $ writeHtmlImage (makeRelative (histogramDir st) f) header :: HistogramViewState r -> Int -> HtmlWriter () header st index = do writeHtmlHeader3WithId ("id" ++ show index) $ writeHtmlText (histogramTitle $ histogramView st) let description = histogramDescription $ histogramView st unless (null description) $ writeHtmlParagraph $ writeHtmlText description -- | Get the TOC item. histogramTOCHtml :: HistogramViewState r -> Int -> HtmlWriter () histogramTOCHtml st index = writeHtmlListItem $ writeHtmlLink ("#id" ++ show index) $ writeHtmlText (histogramTitle $ histogramView st)