{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} -- | -- Module : Simulation.Aivika.Experiment.Chart.DeviationChartView -- Copyright : Copyright (c) 2012-2014, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental -- Tested with: GHC 7.8.3 -- -- The module defines 'DeviationChartView' that plots the deviation chart using rule of 3-sigma. -- module Simulation.Aivika.Experiment.Chart.DeviationChartView (DeviationChartView(..), defaultDeviationChartView) where import Control.Monad import Control.Monad.Trans import Control.Concurrent.MVar import Control.Lens import qualified Data.Map as M import Data.IORef import Data.Maybe import Data.Either import Data.Monoid import Data.Array import Data.Array.IO.Safe import Data.Default.Class import System.IO import System.FilePath import Graphics.Rendering.Chart import Simulation.Aivika import Simulation.Aivika.Experiment import Simulation.Aivika.Experiment.MRef import Simulation.Aivika.Experiment.Chart.Types import Simulation.Aivika.Experiment.Chart.Utils (colourisePlotLines, colourisePlotFillBetween) -- | Defines the 'View' that plots the deviation chart. data DeviationChartView = DeviationChartView { deviationChartTitle :: String, -- ^ This is a title used in HTML. deviationChartDescription :: String, -- ^ This is a description used in HTML. deviationChartWidth :: Int, -- ^ The width of the chart. deviationChartHeight :: Int, -- ^ The height of the chart. deviationChartFileName :: ExperimentFilePath, -- ^ It defines the file name with optional extension for each image to be saved. -- It may include special variable @$TITLE@. -- -- An example is -- -- @ -- deviationChartFileName = UniqueFilePath \"$TITLE\" -- @ deviationChartTransform :: ResultTransform, -- ^ The transform applied to the results before receiving series. deviationChartLeftYSeries :: ResultTransform, -- ^ It defines the series to be plotted basing on the left Y axis. deviationChartRightYSeries :: ResultTransform, -- ^ It defines the series to be plotted basing on the right Y axis. deviationChartPlotTitle :: String, -- ^ This is a title used in the chart. -- It may include special variable @$TITLE@. -- -- An example is -- -- @ -- deviationChartPlotTitle = \"$TITLE\" -- @ deviationChartPlotLines :: [PlotLines Double Double -> PlotLines Double Double], -- ^ Probably, an infinite sequence of plot -- transformations based on which the plot -- is constructed for each series. Generally, -- it may not coincide with a sequence of -- labels as one label may denote a whole list -- or an array of data providers. -- -- Here you can define a colour or style of -- the plot lines. deviationChartPlotFillBetween :: [PlotFillBetween Double Double -> PlotFillBetween Double Double], -- ^ Corresponds exactly to 'deviationChartPlotLines' -- but used for plotting the deviation areas -- by the rule of 3-sigma, while the former -- is used for plotting the trends of the -- random processes. deviationChartBottomAxis :: LayoutAxis Double -> LayoutAxis Double, -- ^ A transformation of the bottom axis, -- after title @time@ is added. deviationChartLayout :: LayoutLR Double Double Double -> LayoutLR Double Double Double -- ^ A transformation of the plot layout, -- where you can redefine the axes, for example. } -- | The default deviation chart view. defaultDeviationChartView :: DeviationChartView defaultDeviationChartView = DeviationChartView { deviationChartTitle = "Deviation Chart", deviationChartDescription = "It shows the Deviation chart by rule 3-sigma.", deviationChartWidth = 640, deviationChartHeight = 480, deviationChartFileName = UniqueFilePath "$TITLE", deviationChartTransform = id, deviationChartLeftYSeries = mempty, deviationChartRightYSeries = mempty, deviationChartPlotTitle = "$TITLE", deviationChartPlotLines = colourisePlotLines, deviationChartPlotFillBetween = colourisePlotFillBetween, deviationChartBottomAxis = id, deviationChartLayout = id } instance WebPageCharting r => ExperimentView DeviationChartView r WebPageWriter where outputView v = let reporter exp renderer dir = do st <- newDeviationChart v exp renderer dir let writer = WebPageWriter { reporterWriteTOCHtml = deviationChartTOCHtml st, reporterWriteHtml = deviationChartHtml st } return ExperimentReporter { reporterInitialise = return (), reporterFinalise = finaliseDeviationChart st, reporterSimulate = simulateDeviationChart st, reporterRequest = writer } in ExperimentGenerator { generateReporter = reporter } -- | The state of the view. data DeviationChartViewState r = DeviationChartViewState { deviationChartView :: DeviationChartView, deviationChartExperiment :: Experiment, deviationChartRenderer :: r, deviationChartDir :: FilePath, deviationChartFile :: IORef (Maybe FilePath), deviationChartLock :: MVar (), deviationChartResults :: MRef (Maybe DeviationChartResults) } -- | The deviation chart item. data DeviationChartResults = DeviationChartResults { deviationChartTimes :: IOArray Int Double, deviationChartNames :: [Either String String], deviationChartStats :: [IOArray Int (SamplingStats Double)] } -- | Create a new state of the view. newDeviationChart :: DeviationChartView -> Experiment -> r -> FilePath -> IO (DeviationChartViewState r) newDeviationChart view exp renderer dir = do f <- newIORef Nothing l <- newMVar () r <- newMRef Nothing return DeviationChartViewState { deviationChartView = view, deviationChartExperiment = exp, deviationChartRenderer = renderer, deviationChartDir = dir, deviationChartFile = f, deviationChartLock = l, deviationChartResults = r } -- | Create new chart results. newDeviationChartResults :: [Either String String] -> Experiment -> IO DeviationChartResults newDeviationChartResults names exp = do let specs = experimentSpecs exp bnds = integIterationBnds specs times <- liftIO $ newListArray bnds (integTimes specs) stats <- forM names $ \_ -> liftIO $ newArray bnds emptySamplingStats return DeviationChartResults { deviationChartTimes = times, deviationChartNames = names, deviationChartStats = stats } -- | Require to return unique chart results associated with the specified state. requireDeviationChartResults :: DeviationChartViewState r -> [Either String String] -> IO DeviationChartResults requireDeviationChartResults st names = maybeWriteMRef (deviationChartResults st) (newDeviationChartResults names (deviationChartExperiment st)) $ \results -> if (names /= deviationChartNames results) then error "Series with different names are returned for different runs: requireDeviationChartResults" else results -- | Simulate the specified series. simulateDeviationChart :: DeviationChartViewState r -> ExperimentData -> Event DisposableEvent simulateDeviationChart st expdata = do let view = deviationChartView st rs1 = deviationChartLeftYSeries view $ deviationChartTransform view $ experimentResults expdata rs2 = deviationChartRightYSeries view $ deviationChartTransform view $ experimentResults expdata exts1 = extractDoubleStatsEitherResults rs1 exts2 = extractDoubleStatsEitherResults rs2 exts = exts1 ++ exts2 names1 = map resultExtractName exts1 names2 = map resultExtractName exts2 names = map Left names1 ++ map Right names2 signals = experimentPredefinedSignals expdata signal = resultSignalInIntegTimes signals lock = deviationChartLock st results <- liftIO $ requireDeviationChartResults st names let stats = deviationChartStats results handleSignal signal $ \_ -> do xs <- forM exts resultExtractData i <- liftDynamics integIteration liftIO $ forM_ (zip xs stats) $ \(x, stats) -> withMVar lock $ \() -> do y <- readArray stats i let y' = combineSamplingStatsEither x y y' `seq` writeArray stats i y' -- | Plot the deviation chart after the simulation is complete. finaliseDeviationChart :: WebPageCharting r => DeviationChartViewState r -> IO () finaliseDeviationChart st = do let view = deviationChartView st title = deviationChartTitle view plotTitle = deviationChartPlotTitle view plotTitle' = replace "$TITLE" title plotTitle width = deviationChartWidth view height = deviationChartHeight view plotLines = deviationChartPlotLines view plotFillBetween = deviationChartPlotFillBetween view plotBottomAxis = deviationChartBottomAxis view plotLayout = deviationChartLayout view renderer = deviationChartRenderer st results <- readMRef $ deviationChartResults st case results of Nothing -> return () Just results -> do let times = deviationChartTimes results names = deviationChartNames results stats = deviationChartStats results ps1 <- forM (zip3 names stats plotLines) $ \(name, stats, plotLines) -> do xs <- getAssocs stats zs <- forM xs $ \(i, stats) -> do t <- readArray times i return (t, samplingStatsMean stats) let p = toPlot $ plotLines $ plot_lines_values .~ filterPlotLinesValues zs $ plot_lines_title .~ either id id name $ def case name of Left _ -> return $ Left p Right _ -> return $ Right p ps2 <- forM (zip3 names stats plotFillBetween) $ \(name, stats, plotFillBetween) -> do xs <- getAssocs stats zs <- forM xs $ \(i, stats) -> do t <- readArray times i let mu = samplingStatsMean stats sigma = samplingStatsDeviation stats return (t, (mu - 3 * sigma, mu + 3 * sigma)) let p = toPlot $ plotFillBetween $ plot_fillbetween_values .~ filterPlotFillBetweenValues zs $ plot_fillbetween_title .~ either id id name $ def case name of Left _ -> return $ Left p Right _ -> return $ Right p let ps = join $ flip map (zip ps1 ps2) $ \(p1, p2) -> [p2, p1] axis = plotBottomAxis $ laxis_title .~ "time" $ def updateLeftAxis = if null $ lefts ps then layoutlr_left_axis_visibility .~ AxisVisibility False False False else id updateRightAxis = if null $ rights ps then layoutlr_right_axis_visibility .~ AxisVisibility False False False else id chart = plotLayout . updateLeftAxis . updateRightAxis $ layoutlr_x_axis .~ axis $ layoutlr_title .~ plotTitle' $ layoutlr_plots .~ ps $ def file <- resolveFilePath (deviationChartDir st) $ mapFilePath (flip replaceExtension $ renderableChartExtension renderer) $ expandFilePath (deviationChartFileName view) $ M.fromList [("$TITLE", title)] renderChart renderer (width, height) file (toRenderable chart) when (experimentVerbose $ deviationChartExperiment st) $ putStr "Generated file " >> putStrLn file writeIORef (deviationChartFile st) $ Just file -- | Remove the NaN and inifity values. filterPlotLinesValues :: [(Double, Double)] -> [[(Double, Double)]] filterPlotLinesValues = filter (not . null) . divideBy (\(t, x) -> isNaN x || isInfinite x) -- | Remove the NaN and inifity values. filterPlotFillBetweenValues :: [(Double, (Double, Double))] -> [(Double, (Double, Double))] filterPlotFillBetweenValues = filter $ \(t, (x1, x2)) -> not $ isNaN x1 || isInfinite x1 || isNaN x2 || isInfinite x2 -- | Get the HTML code. deviationChartHtml :: DeviationChartViewState r -> Int -> HtmlWriter () deviationChartHtml st index = do header st index file <- liftIO $ readIORef (deviationChartFile st) case file of Nothing -> return () Just f -> writeHtmlParagraph $ writeHtmlImage (makeRelative (deviationChartDir st) f) header :: DeviationChartViewState r -> Int -> HtmlWriter () header st index = do writeHtmlHeader3WithId ("id" ++ show index) $ writeHtmlText (deviationChartTitle $ deviationChartView st) let description = deviationChartDescription $ deviationChartView st unless (null description) $ writeHtmlParagraph $ writeHtmlText description -- | Get the TOC item. deviationChartTOCHtml :: DeviationChartViewState r -> Int -> HtmlWriter () deviationChartTOCHtml st index = writeHtmlListItem $ writeHtmlLink ("#id" ++ show index) $ writeHtmlText (deviationChartTitle $ deviationChartView st)