aivika-experiment-chart 0.1 → 0.1.2

raw patch · 11 files changed

+1372/−95 lines, 11 filesdep ~aivika-experimentPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: aivika-experiment

API changes (from Hackage documentation)

Files

• Simulation/Aivika/Experiment/Chart.hs +13/−29
• Simulation/Aivika/Experiment/DeviationChartView.hs +35/−21
• Simulation/Aivika/Experiment/FinalHistogramView.hs +285/−0
• Simulation/Aivika/Experiment/FinalXYChartView.hs +325/−0
• Simulation/Aivika/Experiment/HistogramView.hs +273/−0
• Simulation/Aivika/Experiment/TimeSeriesView.hs +54/−26
• Simulation/Aivika/Experiment/XYChartView.hs +300/−0
• aivika-experiment-chart.cabal +6/−2
• examples/BassDiffusion.hs +6/−2
• examples/ChemicalReaction.hs +26/−2
• examples/MachRep3.hs +49/−13

@@ -12,7 +12,8 @@  module Simulation.Aivika.Experiment.Chart        (colourisePlotLines,-        colourisePlotFillBetween) where+        colourisePlotFillBetween,+        colourisePlotBars) where  import Data.Colour import Data.Colour.Names@@ -22,33 +23,16 @@  -- | Colourise the plot lines. colourisePlotLines :: [PlotLines x y -> PlotLines x y]-colourisePlotLines =-  (plot_lines_style .> line_color ^= opaque blue) :-  (plot_lines_style .> line_color ^= opaque green) :-  (plot_lines_style .> line_color ^= opaque red) :-  (plot_lines_style .> line_color ^= opaque black) :-  (plot_lines_style .> line_color ^= opaque grey) :-  (plot_lines_style .> line_color ^= opaque purple) :-  (plot_lines_style .> line_color ^= opaque violet) :-  (plot_lines_style .> line_color ^= opaque darkblue) :-  (plot_lines_style .> line_color ^= opaque darkgreen) :-  (plot_lines_style .> line_color ^= opaque darkgrey) :-  (plot_lines_style .> line_color ^= opaque darkviolet) :-  colourisePlotLines+colourisePlotLines = map mkstyle $ cycle defaultColorSeq+  where mkstyle c = plot_lines_style .> line_color ^= c --- | Colourise the plot areas that are filling between --- any two lines.+-- | Colourise the filling areas. colourisePlotFillBetween :: [PlotFillBetween x y -> PlotFillBetween x y]-colourisePlotFillBetween =-  (plot_fillbetween_style ^= solidFillStyle (withOpacity blue 0.4)) :-  (plot_fillbetween_style ^= solidFillStyle (withOpacity green 0.4)) :-  (plot_fillbetween_style ^= solidFillStyle (withOpacity red 0.4)) :-  (plot_fillbetween_style ^= solidFillStyle (withOpacity black 0.4)) :-  (plot_fillbetween_style ^= solidFillStyle (withOpacity grey 0.4)) :-  (plot_fillbetween_style ^= solidFillStyle (withOpacity purple 0.4)) :-  (plot_fillbetween_style ^= solidFillStyle (withOpacity violet 0.4)) :-  (plot_fillbetween_style ^= solidFillStyle (withOpacity darkblue 0.4)) :-  (plot_fillbetween_style ^= solidFillStyle (withOpacity darkgreen 0.4)) :-  (plot_fillbetween_style ^= solidFillStyle (withOpacity darkgrey 0.4)) :-  (plot_fillbetween_style ^= solidFillStyle (withOpacity darkviolet 0.4)) :-  colourisePlotFillBetween+colourisePlotFillBetween = map mkstyle $ cycle defaultColorSeq+  where mkstyle c = plot_fillbetween_style ^= solidFillStyle (dissolve 0.4 c)+  +-- | Colourise the plot bars.+colourisePlotBars :: PlotBars x y -> PlotBars x y+colourisePlotBars = plot_bars_item_styles ^= map mkstyle (cycle defaultColorSeq)+  where mkstyle c = (solidFillStyle c, Just $ solidLine 1.0 $ opaque black)+  

@@ -8,7 +8,7 @@ -- Tested with: GHC 7.4.1 -- -- The module defines 'DeviationChartView' that saves the deviation--- chart as the PNG file.+-- chart in the PNG file. --  module Simulation.Aivika.Experiment.DeviationChartView@@ -51,9 +51,9 @@ -- in the PNG file. data DeviationChartView =   DeviationChartView { deviationChartTitle       :: String,-                       -- ^ This is a title used in HTML and chart.+                       -- ^ This is a title used in HTML.                        deviationChartDescription :: String,-                       -- ^ This is a description in the HTML.+                       -- ^ This is a description used in HTML.                        deviationChartWidth       :: Int,                        -- ^ The width of the chart.                        deviationChartHeight      :: Int,@@ -67,23 +67,29 @@                        -- @                        --   deviationChartFileName = UniqueFileName \"$TITLE\", \".png\"                        -- @-                       deviationChartPredicate   :: Dynamics Bool,-                       -- ^ It specifies the predicate that defines-                       -- when we count data when plotting the chart.                        deviationChartSeries      :: [Either String String],                        -- ^ It contains the labels of data plotted-                       -- in the chart.+                       -- on the chart.+                       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 must not coincide with a sequence of +                       -- 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-                       -- of the plot lines.+                       -- the plot lines.                        deviationChartPlotFillBetween :: [PlotFillBetween Double Double ->                                                          PlotFillBetween Double Double],                        -- ^ Corresponds exactly to 'deviationChartPlotLines'@@ -91,6 +97,10 @@                        -- 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 :: Layout1 Double Double ->                                                Layout1 Double Double                        -- ^ A transformation of the plot layout, @@ -105,10 +115,11 @@                        deviationChartWidth       = 640,                        deviationChartHeight      = 480,                        deviationChartFileName    = UniqueFileName "$TITLE" ".png",-                       deviationChartPredicate   = return True,                        deviationChartSeries      = [], +                       deviationChartPlotTitle   = "$TITLE",                        deviationChartPlotLines   = colourisePlotLines,                        deviationChartPlotFillBetween = colourisePlotFillBetween,+                       deviationChartBottomAxis  = id,                        deviationChartLayout      = id }  instance View DeviationChartView where@@ -141,9 +152,7 @@ -- | Create a new state of the view. newDeviationChart :: DeviationChartView -> Experiment -> FilePath -> IO DeviationChartViewState newDeviationChart view exp dir =-  do let specs = experimentSpecs exp-         bnds  = integIterationBnds specs-     f <- newIORef Nothing+  do f <- newIORef Nothing      l <- newMVar ()       r <- newIORef Nothing      return DeviationChartViewState { deviationChartView       = view,@@ -165,7 +174,7 @@                                     deviationChartNames = names,                                     deviationChartStats = stats }        --- | Plot the time series chart during the simulation.+-- | Simulate the specified series. simulateDeviationChart :: DeviationChartViewState -> ExperimentData -> Dynamics (Dynamics ()) simulateDeviationChart st expdata =   do let protolabels = deviationChartSeries $ deviationChartView st@@ -187,7 +196,6 @@            case protoprovider of              Left provider  -> Left $ providerName provider              Right provider -> Right $ providerName provider-         predicate = deviationChartPredicate $ deviationChartView st          exp = deviationChartExperiment st          lock = deviationChartLock st      results <- liftIO $ readIORef (deviationChartResults st)@@ -203,8 +211,7 @@      let stats = deviationChartStats results      t0 <- starttime      enqueue (experimentQueue expdata) t0 $-       do let h = filterSignalM (const predicate) $-                  experimentSignalInIntegTimes expdata+       do let h = experimentSignalInIntegTimes expdata           -- we must subscribe through the event queue;           -- otherwise, we will loose a signal in the start time,           -- because the handleSignal_ function checks the event queue@@ -217,14 +224,18 @@                     writeArray stats i $ addSamplingStats x y      return $ return ()      --- | Plot the time series after the simulation is complete.+-- | Plot the deviation chart after the simulation is complete. finaliseDeviationChart :: DeviationChartViewState -> IO () finaliseDeviationChart st =   do let title = deviationChartTitle $ deviationChartView st+         plotTitle = +           replace "$TITLE" title+           (deviationChartPlotTitle $ deviationChartView st)          width = deviationChartWidth $ deviationChartView st          height = deviationChartHeight $ deviationChartView st          plotLines = deviationChartPlotLines $ deviationChartView st          plotFillBetween = deviationChartPlotFillBetween $ deviationChartView st+         plotBottomAxis = deviationChartBottomAxis $ deviationChartView st          plotLayout = deviationChartLayout $ deviationChartView st      results <- readIORef $ deviationChartResults st      case results of@@ -262,8 +273,12 @@                    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" $+                       defaultLayoutAxis                 chart = plotLayout $-                        layout1_title ^= title $+                        layout1_bottom_axis ^= axis $+                        layout1_title ^= plotTitle $                         layout1_plots ^= ps $                         defaultLayout1             file <- resolveFileName @@ -284,8 +299,7 @@ -- | Remove the NaN and inifity values.      filterPlotFillBetweenValues :: [(Double, (Double, Double))] -> [(Double, (Double, Double))] filterPlotFillBetweenValues = -  join . filter (not . null) .-  divideBy (\(t, (x1, x2)) -> isNaN x1 || isInfinite x1 || isNaN x2 || isInfinite x2)+  filter $ \(t, (x1, x2)) -> not $ isNaN x1 || isInfinite x1 || isNaN x2 || isInfinite x2  -- | Get the HTML code.      deviationChartHtml :: DeviationChartViewState -> Int -> HtmlWriter ()

@@ -0,0 +1,285 @@++-- |+-- Module     : Simulation.Aivika.Experiment.FinalHistogramView+-- Copyright  : Copyright (c) 2012, David Sorokin <david.sorokin@gmail.com>+-- License    : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability  : experimental+-- Tested with: GHC 7.4.1+--+-- The module defines 'FinalHistogramView' that draws a histogram+-- by the specified series in final time points collected from different +-- simulation runs.+--++module Simulation.Aivika.Experiment.FinalHistogramView+       (FinalHistogramView(..), +        defaultFinalHistogramView) where++import Control.Monad+import Control.Monad.Trans+import Control.Concurrent.MVar++import qualified Data.Map as M+import Data.IORef+import Data.Maybe+import Data.Either+import Data.Array+import Data.Array.IO++import Data.Accessor++import System.IO+import System.FilePath++import Data.String.Utils (replace)++import Graphics.Rendering.Chart++import Simulation.Aivika.Experiment+import Simulation.Aivika.Experiment.HtmlWriter+import Simulation.Aivika.Experiment.Utils (divideBy)+import Simulation.Aivika.Experiment.Chart (colourisePlotBars)+import Simulation.Aivika.Experiment.Histogram++import Simulation.Aivika.Dynamics+import Simulation.Aivika.Dynamics.Simulation+import Simulation.Aivika.Dynamics.Signal+import Simulation.Aivika.Dynamics.EventQueue+import Simulation.Aivika.Dynamics.Base (starttime, integIterationBnds, integTimes, integIteration)++-- | Defines the 'View' that saves the histogram+-- in the PNG file by the specified series in+-- final time points collected from different+-- simulation runs.+data FinalHistogramView =+  FinalHistogramView { finalHistogramTitle       :: String,+                       -- ^ This is a title used in HTML.+                       finalHistogramDescription :: String,+                       -- ^ This is a description used in HTML.+                       finalHistogramWidth       :: Int,+                       -- ^ The width of the histogram.+                       finalHistogramHeight      :: Int,+                       -- ^ The height of the histogram.+                       finalHistogramFileName    :: FileName,+                       -- ^ It defines the file name for the PNG file. +                       -- It may include special variable @$TITLE@.+                       --+                       -- An example is+                       --+                       -- @+                       --   finalHistogramFileName = UniqueFileName \"$TITLE\", \".png\"+                       -- @+                       finalHistogramPredicate   :: Dynamics Bool,+                       -- ^ It specifies the predicate that defines+                       -- when we count data when plotting the histogram.+                       finalHistogramBuild       :: [[Double]] -> Histogram, +                       -- ^ Builds a histogram by the specified list of +                       -- data series.+                       finalHistogramSeries      :: [String],+                       -- ^ It contains the labels of data plotted+                       -- on the histogram.+                       finalHistogramPlotTitle   :: String,+                       -- ^ This is a title used in the histogram. +                       -- It may include special variable @$TITLE@.+                       --+                       -- An example is+                       --+                       -- @+                       --   finalHistogramPlotTitle = \"$TITLE\"+                       -- @+                       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.+                       finalHistogramLayout :: Layout1 Double Double ->+                                               Layout1 Double Double+                       -- ^ A transformation of the plot layout, +                       -- where you can redefine the axes, for example.+                 }+  +-- | The default histogram view.  +defaultFinalHistogramView :: FinalHistogramView+defaultFinalHistogramView = +  FinalHistogramView { finalHistogramTitle       = "Final Histogram",+                       finalHistogramDescription = [],+                       finalHistogramWidth       = 640,+                       finalHistogramHeight      = 480,+                       finalHistogramFileName    = UniqueFileName "$TITLE" ".png",+                       finalHistogramPredicate   = return True,+                       finalHistogramBuild       = histogram binSturges,+                       finalHistogramSeries      = [], +                       finalHistogramPlotTitle   = "$TITLE",+                       finalHistogramPlotBars    = colourisePlotBars,+                       finalHistogramLayout      = id }++instance View FinalHistogramView where+  +  outputView v = +    let reporter exp dir =+          do st <- newFinalHistogram v exp dir+             return Reporter { reporterInitialise = return (),+                               reporterFinalise   = finaliseFinalHistogram st,+                               reporterSimulate   = simulateFinalHistogram st,+                               reporterTOCHtml    = finalHistogramTOCHtml st,+                               reporterHtml       = finalHistogramHtml st }+    in Generator { generateReporter = reporter }+  +-- | The state of the view.+data FinalHistogramViewState =+  FinalHistogramViewState { finalHistogramView       :: FinalHistogramView,+                            finalHistogramExperiment :: Experiment,+                            finalHistogramDir        :: FilePath, +                            finalHistogramFile       :: IORef (Maybe FilePath),+                            finalHistogramLock       :: MVar (),+                            finalHistogramResults    :: IORef (Maybe FinalHistogramResults) }++-- | The histogram item.+data FinalHistogramResults =+  FinalHistogramResults { finalHistogramNames  :: [String],+                          finalHistogramValues :: [IORef [Double]] }+  +-- | Create a new state of the view.+newFinalHistogram :: FinalHistogramView -> Experiment -> FilePath -> IO FinalHistogramViewState+newFinalHistogram view exp dir =+  do f <- newIORef Nothing+     l <- newMVar () +     r <- newIORef Nothing+     return FinalHistogramViewState { finalHistogramView       = view,+                                      finalHistogramExperiment = exp,+                                      finalHistogramDir        = dir, +                                      finalHistogramFile       = f,+                                      finalHistogramLock       = l, +                                      finalHistogramResults    = r }+       +-- | Create new histogram results.+newFinalHistogramResults :: [String] -> Experiment -> IO FinalHistogramResults+newFinalHistogramResults names exp =+  do values <- forM names $ \_ -> liftIO $ newIORef []+     return FinalHistogramResults { finalHistogramNames  = names,+                                    finalHistogramValues = values }+       +-- | Simulation the specified series.+simulateFinalHistogram :: FinalHistogramViewState -> ExperimentData -> Dynamics (Dynamics ())+simulateFinalHistogram st expdata =+  do let protolabels = finalHistogramSeries $ finalHistogramView st+         protoproviders = flip map protolabels $ \protolabel ->+           experimentSeriesProviders expdata [protolabel]+         providers = concat protoproviders+         input =+           flip map providers $ \provider ->+           case providerToDouble provider of+             Nothing -> error $+                        "Cannot represent series " +++                        providerName provider ++ +                        " as double values: simulateFinalHistogram"+             Just input -> input+         names = map providerName providers+         predicate = finalHistogramPredicate $ finalHistogramView st+         exp = finalHistogramExperiment st+         lock = finalHistogramLock st+     results <- liftIO $ readIORef (finalHistogramResults st)+     case results of+       Nothing ->+         liftIO $+         do results <- newFinalHistogramResults names exp+            writeIORef (finalHistogramResults st) $ Just results+       Just results ->+         when (names /= finalHistogramNames results) $+         error "Series with different names are returned for different runs: simulateFinalHistogram"+     results <- liftIO $ fmap fromJust $ readIORef (finalHistogramResults st)+     let values = finalHistogramValues results+     t0 <- starttime+     enqueue (experimentQueue expdata) t0 $+       do let h = filterSignalM (const predicate) $+                  experimentSignalInStopTime expdata+          -- we must subscribe through the event queue;+          -- otherwise, we will loose a signal in the start time,+          -- because the handleSignal_ function checks the event queue+          handleSignal_ h $ \_ ->+            do xs <- sequence input+               liftIO $ withMVar lock $ \() ->+                 forM_ (zip xs values) $ \(x, values) ->+                 modifyIORef values (x :)+     return $ return ()+     +-- | Plot the histogram after the simulation is complete.+finaliseFinalHistogram :: FinalHistogramViewState -> IO ()+finaliseFinalHistogram st =+  do let title = finalHistogramTitle $ finalHistogramView st+         plotTitle = +           replace "$TITLE" title+           (finalHistogramPlotTitle $ finalHistogramView st)+         width = finalHistogramWidth $ finalHistogramView st+         height = finalHistogramHeight $ finalHistogramView st+         histogram = finalHistogramBuild $ finalHistogramView st+         bars = finalHistogramPlotBars $ finalHistogramView st+         layout = finalHistogramLayout $ finalHistogramView st+     results <- readIORef $ finalHistogramResults st+     case results of+       Nothing -> return ()+       Just results ->+         do let names  = finalHistogramNames results+                values = finalHistogramValues results+            xs <- forM values readIORef+            let zs = histogramToBars . filterHistogram . histogram $ +                     map filterData xs+                p  = plotBars $+                     bars $+                     plot_bars_values ^= zs $+                     plot_bars_titles ^= names $+                     defaultPlotBars+            let chart = layout $+                        layout1_title ^= plotTitle $+                        layout1_plots ^= [Left p] $+                        defaultLayout1+            file <- resolveFileName +                    (Just $ finalHistogramDir st)+                    (finalHistogramFileName $ finalHistogramView st) $+                    M.fromList [("$TITLE", title)]+            renderableToPNGFile (toRenderable chart) width height file+            when (experimentVerbose $ finalHistogramExperiment st) $+              putStr "Generated file " >> putStrLn file+            writeIORef (finalHistogramFile st) $ Just 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.     +finalHistogramHtml :: FinalHistogramViewState -> Int -> HtmlWriter ()+finalHistogramHtml st index =+  do header st index+     file <- liftIO $ readIORef (finalHistogramFile st)+     case file of+       Nothing -> return ()+       Just f  ->+         writeHtmlParagraph $+         writeHtmlImage (makeRelative (finalHistogramDir st) f)++header :: FinalHistogramViewState -> Int -> HtmlWriter ()+header st index =+  do writeHtmlHeader3WithId ("id" ++ show index) $ +       writeHtmlText (finalHistogramTitle $ finalHistogramView st)+     let description = finalHistogramDescription $ finalHistogramView st+     unless (null description) $+       writeHtmlParagraph $ +       writeHtmlText description++-- | Get the TOC item.+finalHistogramTOCHtml :: FinalHistogramViewState -> Int -> HtmlWriter ()+finalHistogramTOCHtml st index =+  writeHtmlListItem $+  writeHtmlLink ("#id" ++ show index) $+  writeHtmlText (finalHistogramTitle $ finalHistogramView st)

@@ -0,0 +1,325 @@++-- |+-- Module     : Simulation.Aivika.Experiment.FinalXYChartView+-- Copyright  : Copyright (c) 2012, David Sorokin <david.sorokin@gmail.com>+-- License    : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability  : experimental+-- Tested with: GHC 7.4.1+--+-- The module defines 'FinalXYChartView' that saves the XY chart+-- by final time points for all simulation runs sequentially.+--++module Simulation.Aivika.Experiment.FinalXYChartView+       (FinalXYChartView(..), +        defaultFinalXYChartView) where++import Control.Monad+import Control.Monad.Trans+import Control.Concurrent.MVar++import qualified Data.Map as M+import Data.IORef+import Data.Maybe+import Data.Either+import Data.Array+import Data.Array.IO++import Data.Accessor++import System.IO+import System.FilePath++import Data.String.Utils (replace)++import Graphics.Rendering.Chart++import Simulation.Aivika.Experiment+import Simulation.Aivika.Experiment.HtmlWriter+import Simulation.Aivika.Experiment.Utils (divideBy)+import Simulation.Aivika.Experiment.Chart (colourisePlotLines)++import Simulation.Aivika.Dynamics+import Simulation.Aivika.Dynamics.Simulation+import Simulation.Aivika.Dynamics.Signal+import Simulation.Aivika.Dynamics.EventQueue+import Simulation.Aivika.Dynamics.Base (time)++-- | Defines the 'View' that saves the XY chart+-- in the PNG file by final time points for all+-- simulation runs sequentially.+data FinalXYChartView =+  FinalXYChartView { finalXYChartTitle       :: String,+                     -- ^ This is a title used HTML.+                     finalXYChartDescription :: String,+                     -- ^ This is a description used in HTML.+                     finalXYChartWidth       :: Int,+                     -- ^ The width of the chart.+                     finalXYChartHeight      :: Int,+                     -- ^ The height of the chart.+                     finalXYChartFileName    :: FileName,+                     -- ^ It defines the file name for the PNG file. +                     -- It may include special variable @$TITLE@.+                     --+                     -- An example is+                     --+                     -- @+                     --   finalXYChartFileName = UniqueFileName \"$TITLE\", \".png\"+                     -- @+                     finalXYChartPredicate   :: Dynamics Bool,+                     -- ^ It specifies the predicate that defines+                     -- when we count data when plotting the chart.+                     finalXYChartXSeries     :: Maybe String,+                     -- ^ It defines a label of the single X series.+                     --+                     -- You must define it, because it is 'Nothing' +                     -- by default.+                     finalXYChartYSeries     :: [Either String String],+                     -- ^ It contains the labels of Y series plotted+                     -- on the chart.+                     finalXYChartPlotTitle   :: String,+                     -- ^ This is a title used in the chart. +                     -- It may include special variable @$TITLE@.+                     --+                     -- An example is+                     --+                     -- @+                     --   finalXYChartPlotTitle = \"$TITLE\"+                     -- @+                     finalXYChartPlotLines :: [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.+                     finalXYChartBottomAxis :: LayoutAxis Double ->+                                               LayoutAxis Double,+                     -- ^ A transformation of the bottom axis, +                     -- after the X title is added.+                     finalXYChartLayout :: Layout1 Double Double ->+                                           Layout1 Double Double+                     -- ^ A transformation of the plot layout, +                     -- where you can redefine the axes, for example.+                   }+  +-- | The default XY chart view.  +defaultFinalXYChartView :: FinalXYChartView+defaultFinalXYChartView = +  FinalXYChartView { finalXYChartTitle       = "Final XY Chart",+                     finalXYChartDescription = [],+                     finalXYChartWidth       = 640,+                     finalXYChartHeight      = 480,+                     finalXYChartFileName    = UniqueFileName "$TITLE" ".png",+                     finalXYChartPredicate   = return True,+                     finalXYChartXSeries     = Nothing,+                     finalXYChartYSeries     = [], +                     finalXYChartPlotTitle   = "$TITLE",+                     finalXYChartPlotLines   = colourisePlotLines,+                     finalXYChartBottomAxis  = id,+                     finalXYChartLayout      = id }++instance View FinalXYChartView where+  +  outputView v = +    let reporter exp dir =+          do st <- newFinalXYChart v exp dir+             return Reporter { reporterInitialise = return (),+                               reporterFinalise   = finaliseFinalXYChart st,+                               reporterSimulate   = simulateFinalXYChart st,+                               reporterTOCHtml    = finalXYChartTOCHtml st,+                               reporterHtml       = finalXYChartHtml st }+    in Generator { generateReporter = reporter }+  +-- | The state of the view.+data FinalXYChartViewState =+  FinalXYChartViewState { finalXYChartView       :: FinalXYChartView,+                          finalXYChartExperiment :: Experiment,+                          finalXYChartDir        :: FilePath, +                          finalXYChartFile       :: IORef (Maybe FilePath),+                          finalXYChartLock       :: MVar (),+                          finalXYChartResults    :: IORef (Maybe FinalXYChartResults) }++-- | The XY chart results.+data FinalXYChartResults =+  FinalXYChartResults { finalXYChartXName  :: String,+                        finalXYChartYNames :: [Either String String],+                        finalXYChartXY     :: [IOArray Int (Maybe (Double, Double))] }+  +-- | Create a new state of the view.+newFinalXYChart :: FinalXYChartView -> Experiment -> FilePath -> IO FinalXYChartViewState+newFinalXYChart view exp dir =+  do f <- newIORef Nothing+     l <- newMVar () +     r <- newIORef Nothing+     return FinalXYChartViewState { finalXYChartView       = view,+                                    finalXYChartExperiment = exp,+                                    finalXYChartDir        = dir, +                                    finalXYChartFile       = f,+                                    finalXYChartLock       = l, +                                    finalXYChartResults    = r }+       +-- | Create new chart results.+newFinalXYChartResults :: String -> [Either String String] -> Experiment -> IO FinalXYChartResults+newFinalXYChartResults xname ynames exp =+  do let n = experimentRunCount exp+     xy <- forM ynames $ \_ -> +       liftIO $ newArray (1, n) Nothing+     return FinalXYChartResults { finalXYChartXName  = xname,+                                  finalXYChartYNames = ynames,+                                  finalXYChartXY     = xy }+       +-- | Simulation.+simulateFinalXYChart :: FinalXYChartViewState -> ExperimentData -> Dynamics (Dynamics ())+simulateFinalXYChart st expdata =+  do let yprotolabels = finalXYChartYSeries $ finalXYChartView st+         xprotolabel  = finalXYChartXSeries $ finalXYChartView st+         ylabels = flip map yprotolabels $ either id id+         xlabel  = flip fromMaybe xprotolabel $+                   error "X series is not provided: simulateFinalXYChart"+         yprotoproviders = flip map yprotolabels $ \protolabel ->+           case protolabel of+             Left label  -> map Left $ experimentSeriesProviders expdata [label]+             Right label -> map Right $ experimentSeriesProviders expdata [label]+         joinedproviders = join yprotoproviders+         yproviders = flip map joinedproviders $ either id id         +         xprovider  = +           case experimentSeriesProviders expdata [xlabel] of+             [provider] -> provider+             _ -> error $+                  "Only a single X series must be" +++                  " provided: simulateFinalXYChart"+         ys  = input yproviders+         [x] = input [xprovider]+         input providers =+           flip map providers $ \provider ->+           case providerToDouble provider of+             Nothing -> error $+                        "Cannot represent series " +++                        providerName provider ++ +                        " as double values: simulateFinalXYChart"+             Just input -> input+         ynames = flip map joinedproviders $ \protoprovider ->+           case protoprovider of+             Left provider  -> Left $ providerName provider+             Right provider -> Right $ providerName provider+         xname  = providerName xprovider+         predicate = finalXYChartPredicate $ finalXYChartView st+         exp = finalXYChartExperiment st+         lock = finalXYChartLock st+     results <- liftIO $ readIORef (finalXYChartResults st)+     case results of+       Nothing ->+         liftIO $+         do results <- newFinalXYChartResults xname ynames exp+            writeIORef (finalXYChartResults st) $ Just results+       Just results ->+         let diffnames = +               (xname /= finalXYChartXName results) || +               (ynames /= finalXYChartYNames results)+         in when diffnames $+            error "Series with different names are returned for different runs: simulateFinalXYChart"+     results <- liftIO $ fmap fromJust $ readIORef (finalXYChartResults st)+     let xys = finalXYChartXY results+     t <- time+     enqueue (experimentQueue expdata) t $+       do let h = filterSignalM (const predicate) $+                  experimentSignalInStopTime expdata+          -- we must subscribe through the event queue;+          -- otherwise, we will loose a signal in the start time,+          -- because the handleSignal_ function checks the event queue+          handleSignal_ h $ \_ ->+            do x'  <- x+               ys' <- sequence ys+               i   <- liftSimulation simulationIndex+               liftIO $ withMVar lock $ \() ->+                 forM_ (zip ys' xys) $ \(y', xy) ->+                 writeArray xy i $ Just (x', y')+     return $ return ()+     +-- | Plot the XY chart after the simulation is complete.+finaliseFinalXYChart :: FinalXYChartViewState -> IO ()+finaliseFinalXYChart st =+  do let title = finalXYChartTitle $ finalXYChartView st+         plotTitle = +           replace "$TITLE" title+           (finalXYChartPlotTitle $ finalXYChartView st)+         width = finalXYChartWidth $ finalXYChartView st+         height = finalXYChartHeight $ finalXYChartView st+         plotLines = finalXYChartPlotLines $ finalXYChartView st+         plotBottomAxis = finalXYChartBottomAxis $ finalXYChartView st+         plotLayout = finalXYChartLayout $ finalXYChartView st+     results <- readIORef $ finalXYChartResults st+     case results of+       Nothing -> return ()+       Just results ->+         do let xname  = finalXYChartXName results+                ynames = finalXYChartYNames results+                xys    = finalXYChartXY results+            ps <- forM (zip3 ynames xys plotLines) $ \(name, xy, plotLines) ->+              do zs <- getElems xy+                 let p = toPlot $+                         plotLines $+                         plot_lines_values ^= filterPlotLinesValues zs $+                         plot_lines_title ^= either id id name $+                         defaultPlotLines+                     r = case name of+                       Left _  -> Left p+                       Right _ -> Right p+                 return r+            let axis = plotBottomAxis $+                       laxis_title ^= xname $+                       defaultLayoutAxis+                chart = plotLayout $+                        layout1_bottom_axis ^= axis $+                        layout1_title ^= plotTitle $+                        layout1_plots ^= ps $+                        defaultLayout1+            file <- resolveFileName +                    (Just $ finalXYChartDir st)+                    (finalXYChartFileName $ finalXYChartView st) $+                    M.fromList [("$TITLE", title)]+            renderableToPNGFile (toRenderable chart) width height file+            when (experimentVerbose $ finalXYChartExperiment st) $+              putStr "Generated file " >> putStrLn file+            writeIORef (finalXYChartFile st) $ Just file+     +-- | Remove the NaN and inifity values.     +filterPlotLinesValues :: [Maybe (Double, Double)] -> [[(Double, Double)]]+filterPlotLinesValues = +  filter (not . null) . map (map fromJust) . divideBy pred+    where pred Nothing       = True+          pred (Just (x, y)) = isNaN x || isInfinite x || +                               isNaN y || isInfinite y++-- | Get the HTML code.     +finalXYChartHtml :: FinalXYChartViewState -> Int -> HtmlWriter ()+finalXYChartHtml st index =+  do header st index+     file <- liftIO $ readIORef (finalXYChartFile st)+     case file of+       Nothing -> return ()+       Just f  ->+         writeHtmlParagraph $+         writeHtmlImage (makeRelative (finalXYChartDir st) f)++header :: FinalXYChartViewState -> Int -> HtmlWriter ()+header st index =+  do writeHtmlHeader3WithId ("id" ++ show index) $ +       writeHtmlText (finalXYChartTitle $ finalXYChartView st)+     let description = finalXYChartDescription $ finalXYChartView st+     unless (null description) $+       writeHtmlParagraph $ +       writeHtmlText description++-- | Get the TOC item.+finalXYChartTOCHtml :: FinalXYChartViewState -> Int -> HtmlWriter ()+finalXYChartTOCHtml st index =+  writeHtmlListItem $+  writeHtmlLink ("#id" ++ show index) $+  writeHtmlText (finalXYChartTitle $ finalXYChartView st)

@@ -0,0 +1,273 @@++-- |+-- Module     : Simulation.Aivika.Experiment.HistogramView+-- Copyright  : Copyright (c) 2012, David Sorokin <david.sorokin@gmail.com>+-- License    : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability  : experimental+-- Tested with: GHC 7.4.1+--+-- The module defines 'HistogramView' that saves the histogram+-- in the PNG files by all integration time points for each +-- simulation run separately.+--++module Simulation.Aivika.Experiment.HistogramView+       (HistogramView(..), +        defaultHistogramView) where++import Control.Monad+import Control.Monad.Trans++import qualified Data.Map as M+import Data.IORef+import Data.Maybe+import Data.Either+import Data.Array++import Data.Accessor++import System.IO+import System.FilePath++import Data.String.Utils (replace)++import Graphics.Rendering.Chart++import Simulation.Aivika.Experiment+import Simulation.Aivika.Experiment.HtmlWriter+import Simulation.Aivika.Experiment.Utils (divideBy)+import Simulation.Aivika.Experiment.Chart (colourisePlotBars)+import Simulation.Aivika.Experiment.Histogram++import Simulation.Aivika.Dynamics+import Simulation.Aivika.Dynamics.Simulation+import Simulation.Aivika.Dynamics.Signal+import Simulation.Aivika.Dynamics.EventQueue++-- | Defines the 'View' that saves the histogram in +-- the PNG files by all integration time points 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    :: FileName,+                  -- ^ It defines the file name for each PNG file. +                  -- It may include special variables @$TITLE@, +                  -- @$RUN_INDEX@ and @$RUN_COUNT@.+                  --+                  -- An example is+                  --+                  -- @+                  --   histogramFileName = UniqueFileName \"$TITLE - $RUN_INDEX\", \".png\"+                  -- @+                  histogramPredicate   :: Dynamics 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.+                  histogramSeries      :: [String],+                  -- ^ It contains the labels of data for which+                  -- the histogram is plotted.+                  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 :: Layout1 Double Double ->+                                     Layout1 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 = [],+                  histogramWidth       = 640,+                  histogramHeight      = 480,+                  histogramFileName    = UniqueFileName "$TITLE - $RUN_INDEX" ".png",+                  histogramPredicate   = return True,+                  histogramBuild       = histogram binSturges,+                  histogramSeries      = [], +                  histogramPlotTitle   = "$TITLE",+                  histogramRunPlotTitle = "$PLOT_TITLE / Run $RUN_INDEX of $RUN_COUNT",+                  histogramPlotBars    = colourisePlotBars,+                  histogramLayout      = id }++instance View HistogramView where+  +  outputView v = +    let reporter exp dir =+          do st <- newHistogram v exp dir+             return Reporter { reporterInitialise = return (),+                               reporterFinalise   = return (),+                               reporterSimulate   = simulateHistogram st,+                               reporterTOCHtml    = histogramTOCHtml st,+                               reporterHtml       = histogramHtml st }+    in Generator { generateReporter = reporter }+  +-- | The state of the view.+data HistogramViewState =+  HistogramViewState { histogramView       :: HistogramView,+                       histogramExperiment :: Experiment,+                       histogramDir        :: FilePath, +                       histogramMap        :: M.Map Int FilePath }+  +-- | Create a new state of the view.+newHistogram :: HistogramView -> Experiment -> FilePath -> IO HistogramViewState+newHistogram view exp dir =+  do let n = experimentRunCount exp+     fs <- forM [0..(n - 1)] $ \i -> +       resolveFileName (Just dir) (histogramFileName view) $+       M.fromList [("$TITLE", histogramTitle view),+                   ("$RUN_INDEX", show $ i + 1),+                   ("$RUN_COUNT", show n)]+     forM_ fs $ flip writeFile []  -- reserve the file names+     let m = M.fromList $ zip [0..(n - 1)] fs+     return HistogramViewState { histogramView       = view,+                                 histogramExperiment = exp,+                                 histogramDir        = dir, +                                 histogramMap        = m }+       +-- | Plot the histogram during the simulation.+simulateHistogram :: HistogramViewState -> ExperimentData -> Dynamics (Dynamics ())+simulateHistogram st expdata =+  do let labels = histogramSeries $ histogramView st+         providers = experimentSeriesProviders expdata labels+         names = map providerName providers+         input =+           flip map providers $ \provider ->+           case providerToDouble provider of+             Nothing -> error $+                        "Cannot represent series " +++                        providerName provider ++ +                        " as double values: simulateHistogram"+             Just input -> input+         n = experimentRunCount $ histogramExperiment st+         width = histogramWidth $ histogramView st+         height = histogramHeight $ histogramView st+         predicate = histogramPredicate $ histogramView st+         bars = histogramPlotBars $ histogramView st+         layout = histogramLayout $ histogramView st+         build = histogramBuild $ histogramView st+     i <- liftSimulation simulationIndex+     let file = fromJust $ M.lookup (i - 1) (histogramMap st)+         title = histogramTitle $ histogramView st+         plotTitle = +           replace "$TITLE" title+           (histogramPlotTitle $ histogramView st)+         runPlotTitle =+           if n == 1+           then plotTitle+           else replace "$RUN_INDEX" (show i) $+                replace "$RUN_COUNT" (show n) $+                replace "$PLOT_TITLE" plotTitle+                (histogramRunPlotTitle $ histogramView st)+     hs <- forM (zip providers input) $ \(provider, input) ->+       newSignalHistoryThrough (experimentQueue expdata) $+       mapSignalM (const input) $+       filterSignalM (const predicate) $+       experimentSignalInIntegTimes expdata+     return $+       do xs <- forM hs readSignalHistory+          let zs = histogramToBars . filterHistogram . build $ +                   map (filterData . elems . snd) xs+              p  = plotBars $+                   bars $+                   plot_bars_values ^= zs $+                   plot_bars_titles ^= names $+                   defaultPlotBars+              chart = layout $+                      layout1_title ^= runPlotTitle $+                      layout1_plots ^= [Left p] $+                      defaultLayout1+          liftIO $ +            do renderableToPNGFile (toRenderable chart) width height file+               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 -> 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 -> 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 -> 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 -> 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 -> Int -> HtmlWriter ()+histogramTOCHtml st index =+  writeHtmlListItem $+  writeHtmlLink ("#id" ++ show index) $+  writeHtmlText (histogramTitle $ histogramView st)

@@ -47,20 +47,9 @@ -- in the PNG files. data TimeSeriesView =   TimeSeriesView { timeSeriesTitle       :: String,-                   -- ^ This is a title used in HTML and chart.-                   timeSeriesRunTitle    :: String,-                   -- ^ The run title for the view. It is used -                   -- when simulating multiple runs and it may -                   -- include special variables @$RUN_INDEX@, -                   -- @$RUN_COUNT@ and @$TITLE@.-                   ---                   -- An example is -                   ---                   -- @-                   --   timeSeriesRunTitle = \"$TITLE / Run $RUN_INDEX of $RUN_COUNT\"-                   -- @+                   -- ^ This is a title used in HTML.                    timeSeriesDescription :: String,-                   -- ^ This is a description in the HTML.+                   -- ^ This is a description used in HTML.                    timeSeriesWidth       :: Int,                    -- ^ The width of the chart.                    timeSeriesHeight      :: Int,@@ -80,7 +69,28 @@                    -- when we plot data in the chart.                    timeSeries      :: [Either String String],                    -- ^ It contains the labels of data plotted-                   -- in the chart.+                   -- on the chart.+                   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\"+                   -- @+                   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\"+                   -- @                    timeSeriesPlotLines :: [PlotLines Double Double ->                                            PlotLines Double Double],                    -- ^ Probably, an infinite sequence of plot @@ -91,7 +101,11 @@                    -- or an array of data providers.                    --                    -- Here you can define a colour or style of-                   -- of the plot lines.+                   -- the plot lines.+                   timeSeriesBottomAxis :: LayoutAxis Double ->+                                           LayoutAxis Double,+                   -- ^ A transformation of the bottom axis, +                   -- after title @time@ is added.                    timeSeriesLayout :: Layout1 Double Double ->                                        Layout1 Double Double                    -- ^ A transformation of the plot layout, @@ -102,14 +116,16 @@ defaultTimeSeriesView :: TimeSeriesView defaultTimeSeriesView =    TimeSeriesView { timeSeriesTitle       = "Time Series",-                   timeSeriesRunTitle    = "$TITLE / Run $RUN_INDEX of $RUN_COUNT",                    timeSeriesDescription = [],                    timeSeriesWidth       = 640,                    timeSeriesHeight      = 480,                    timeSeriesFileName    = UniqueFileName "$TITLE - $RUN_INDEX" ".png",                    timeSeriesPredicate   = return True,                    timeSeries            = [], +                   timeSeriesPlotTitle   = "$TITLE",+                   timeSeriesRunPlotTitle = "$PLOT_TITLE / Run $RUN_INDEX of $RUN_COUNT",                    timeSeriesPlotLines   = colourisePlotLines,+                   timeSeriesBottomAxis  = id,                    timeSeriesLayout      = id }  instance View TimeSeriesView where@@ -140,6 +156,7 @@        M.fromList [("$TITLE", timeSeriesTitle view),                    ("$RUN_INDEX", show $ i + 1),                    ("$RUN_COUNT", show n)]+     forM_ fs $ flip writeFile []  -- reserve the file names      let m = M.fromList $ zip [0..(n - 1)] fs      return TimeSeriesViewState { timeSeriesView       = view,                                   timeSeriesExperiment = exp,@@ -165,21 +182,28 @@          height = timeSeriesHeight $ timeSeriesView st          predicate = timeSeriesPredicate $ timeSeriesView st          plotLines = timeSeriesPlotLines $ timeSeriesView st+         plotBottomAxis = timeSeriesBottomAxis $ timeSeriesView st          plotLayout = timeSeriesLayout $ timeSeriesView st      i <- liftSimulation simulationIndex      let file = fromJust $ M.lookup (i - 1) (timeSeriesMap st)-         title =+         title = timeSeriesTitle $ timeSeriesView st+         plotTitle = +           replace "$TITLE" title+           (timeSeriesPlotTitle $ timeSeriesView st)+         runPlotTitle =            if n == 1-           then timeSeriesTitle $ timeSeriesView st+           then plotTitle            else replace "$RUN_INDEX" (show i) $                 replace "$RUN_COUNT" (show n) $-                replace "$TITLE" (timeSeriesTitle $ timeSeriesView st)-                (timeSeriesRunTitle $ timeSeriesView st)+                replace "$PLOT_TITLE" plotTitle+                (timeSeriesRunPlotTitle $ timeSeriesView st)      hs <- forM (zip providers input) $ \(provider, input) ->-       newSignalHistoryThrough (experimentQueue expdata) $-       mapSignalM (const input) $-       filterSignalM (const predicate) $-       experimentMixedSignal expdata [provider]+       let transform () =+             do x <- predicate+                if x then input else return (1/0)  -- the infinite values will be ignored then+       in newSignalHistoryThrough (experimentQueue expdata) $+          mapSignalM transform $+          experimentMixedSignal expdata [provider]      return $        do ps <- forM (zip3 hs providers plotLines) $ \(h, provider, plotLines) ->             do (ts, xs) <- readSignalHistory h @@ -193,8 +217,12 @@                 case label of                   Left _  -> Left p                   Right _ -> Right p-          let chart = plotLayout $-                      layout1_title ^= title $+              axis  = plotBottomAxis $+                      laxis_title ^= "time" $+                      defaultLayoutAxis+              chart = plotLayout $+                      layout1_bottom_axis ^= axis $+                      layout1_title ^= runPlotTitle $                       layout1_plots ^= ps' $                       defaultLayout1           liftIO $ 

@@ -0,0 +1,300 @@++-- |+-- Module     : Simulation.Aivika.Experiment.XYChartView+-- Copyright  : Copyright (c) 2012, David Sorokin <david.sorokin@gmail.com>+-- License    : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability  : experimental+-- Tested with: GHC 7.4.1+--+-- The module defines 'XYChartView' that saves the XY charts +-- in the PNG files.+--++module Simulation.Aivika.Experiment.XYChartView+       (XYChartView(..), +        defaultXYChartView) where++import Control.Monad+import Control.Monad.Trans++import qualified Data.Map as M+import Data.IORef+import Data.Maybe+import Data.Either+import Data.Array+import Data.Monoid++import Data.Accessor++import System.IO+import System.FilePath++import Data.String.Utils (replace)++import Graphics.Rendering.Chart++import Simulation.Aivika.Experiment+import Simulation.Aivika.Experiment.HtmlWriter+import Simulation.Aivika.Experiment.Utils (divideBy)+import Simulation.Aivika.Experiment.Chart (colourisePlotLines)++import Simulation.Aivika.Dynamics+import Simulation.Aivika.Dynamics.Simulation+import Simulation.Aivika.Dynamics.Signal+import Simulation.Aivika.Dynamics.EventQueue++-- | Defines the 'View' that saves the XY charts+-- in the PNG files.+data XYChartView =+  XYChartView { xyChartTitle       :: String,+                -- ^ This is a title used in HTML.+                xyChartDescription :: String,+                -- ^ This is a description used in HTML.+                xyChartWidth       :: Int,+                -- ^ The width of the chart.+                xyChartHeight      :: Int,+                -- ^ The height of the chart.+                xyChartFileName    :: FileName,+                -- ^ It defines the file name for each PNG file. +                -- It may include special variables @$TITLE@, +                -- @$RUN_INDEX@ and @$RUN_COUNT@.+                --+                -- An example is+                --+                -- @+                --   xyChartFileName = UniqueFileName \"$TITLE - $RUN_INDEX\", \".png\"+                -- @+                xyChartPredicate   :: Dynamics Bool,+                -- ^ It specifies the predicate that defines+                -- when we plot data in the chart.+                xyChartXSeries     :: Maybe String,+                -- ^ This is a label of the X series.+                --+                -- You must define it, because it is 'Nothing' +                -- by default.+                xyChartYSeries      :: [Either String String],+                -- ^ It contains the labels of Y series plotted+                -- on the XY chart.+                xyChartPlotTitle :: String,+                -- ^ This is a title used in the chart when+                -- simulating a single run. It may include +                -- special variable @$TITLE@.+                --+                -- An example is+                --+                -- @+                --   xyChartPlotTitle = \"$TITLE\"+                -- @+                xyChartRunPlotTitle :: 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 +                --+                -- @+                --   xyChartRunPlotTitle = \"$PLOT_TITLE / Run $RUN_INDEX of $RUN_COUNT\"+                -- @+                xyChartPlotLines :: [PlotLines Double Double ->+                                     PlotLines Double Double],+                -- ^ Probably, an infinite sequence of plot +                -- transformations based on which the plot+                -- is constructed for each Y series. Generally,+                -- it may not coincide with a sequence of +                -- Y 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.+                xyChartBottomAxis :: LayoutAxis Double ->+                                     LayoutAxis Double,+                -- ^ A transformation of the bottom axis, +                -- after the X title is added.+                xyChartLayout :: Layout1 Double Double ->+                                 Layout1 Double Double+                -- ^ A transformation of the plot layout, +                -- where you can redefine the axes, for example.+              }+  +-- | The default time series view.  +defaultXYChartView :: XYChartView+defaultXYChartView = +  XYChartView { xyChartTitle       = "XY Chart",+                xyChartDescription = [],+                xyChartWidth       = 640,+                xyChartHeight      = 480,+                xyChartFileName    = UniqueFileName "$TITLE - $RUN_INDEX" ".png",+                xyChartPredicate   = return True,+                xyChartXSeries     = Nothing, +                xyChartYSeries     = [],+                xyChartPlotTitle   = "$TITLE",+                xyChartRunPlotTitle  = "$PLOT_TITLE / Run $RUN_INDEX of $RUN_COUNT",+                xyChartPlotLines   = colourisePlotLines,+                xyChartBottomAxis  = id,+                xyChartLayout      = id }++instance View XYChartView where+  +  outputView v = +    let reporter exp dir =+          do st <- newXYChart v exp dir+             return Reporter { reporterInitialise = return (),+                               reporterFinalise   = return (),+                               reporterSimulate   = simulateXYChart st,+                               reporterTOCHtml    = xyChartTOCHtml st,+                               reporterHtml       = xyChartHtml st }+    in Generator { generateReporter = reporter }+  +-- | The state of the view.+data XYChartViewState =+  XYChartViewState { xyChartView       :: XYChartView,+                     xyChartExperiment :: Experiment,+                     xyChartDir        :: FilePath, +                     xyChartMap        :: M.Map Int FilePath }+  +-- | Create a new state of the view.+newXYChart :: XYChartView -> Experiment -> FilePath -> IO XYChartViewState+newXYChart view exp dir =+  do let n = experimentRunCount exp+     fs <- forM [0..(n - 1)] $ \i -> +       resolveFileName (Just dir) (xyChartFileName view) $+       M.fromList [("$TITLE", xyChartTitle view),+                   ("$RUN_INDEX", show $ i + 1),+                   ("$RUN_COUNT", show n)]+     forM_ fs $ flip writeFile []  -- reserve the file names+     let m = M.fromList $ zip [0..(n - 1)] fs+     return XYChartViewState { xyChartView       = view,+                               xyChartExperiment = exp,+                               xyChartDir        = dir, +                               xyChartMap        = m }+       +-- | Plot the XY chart during the simulation.+simulateXYChart :: XYChartViewState -> ExperimentData -> Dynamics (Dynamics ())+simulateXYChart st expdata =+  do let yprotolabels = xyChartYSeries $ xyChartView st+         xprotolabel  = xyChartXSeries $ xyChartView st+         ylabels = flip map yprotolabels $ either id id+         xlabel  = flip fromMaybe xprotolabel $+                   error "X series is not provided: simulateXYChart"+         yproviders = experimentSeriesProviders expdata ylabels+         xprovider  = +           case experimentSeriesProviders expdata [xlabel] of+             [provider] -> provider+             _ -> error $+                  "Only a single X series must be" +++                  " provided: simulateXYChart"+         ys  = input yproviders+         [x] = input [xprovider]+         input providers =+           flip map providers $ \provider ->+           case providerToDouble provider of+             Nothing -> error $+                        "Cannot represent series " +++                        providerName provider ++ +                        " as double values: simulateXYChart"+             Just input -> input+         n = experimentRunCount $ xyChartExperiment st+         width = xyChartWidth $ xyChartView st+         height = xyChartHeight $ xyChartView st+         predicate = xyChartPredicate $ xyChartView st+         plotLines = xyChartPlotLines $ xyChartView st+         plotBottomAxis = xyChartBottomAxis $ xyChartView st+         plotLayout = xyChartLayout $ xyChartView st+     i <- liftSimulation simulationIndex+     let file = fromJust $ M.lookup (i - 1) (xyChartMap st)+         title = xyChartTitle $ xyChartView st+         plotTitle = +           replace "$TITLE" title+           (xyChartPlotTitle $ xyChartView st)+         runPlotTitle =+           if n == 1+           then plotTitle+           else replace "$RUN_INDEX" (show i) $+                replace "$RUN_COUNT" (show n) $+                replace "$PLOT_TITLE" plotTitle+                (xyChartRunPlotTitle $ xyChartView st)+     hs <- forM (zip yproviders ys) $ \(provider, y) ->+       let transform () =+             do p <- predicate+                if p +                  then liftM2 (,) x y+                  else return (1/0, 1/0)  -- such values will be ignored then+       in newSignalHistoryThrough (experimentQueue expdata) $+          mapSignalM transform $+          experimentMixedSignal expdata [provider] <>+          experimentMixedSignal expdata [xprovider]+     return $+       do ps <- forM (zip3 hs yproviders plotLines) $ \(h, provider, plotLines) ->+            do (ts, zs) <- readSignalHistory h +               return $+                 toPlot $+                 plotLines $+                 plot_lines_values ^= filterPlotLinesValues (elems zs) $+                 plot_lines_title ^= providerName provider $+                 defaultPlotLines+          let ps' = flip map (zip ps yprotolabels) $ \(p, label) ->+                case label of+                  Left _  -> Left p+                  Right _ -> Right p+              axis  = plotBottomAxis $+                      laxis_title ^= providerName xprovider $+                      defaultLayoutAxis+              chart = plotLayout $+                      layout1_bottom_axis ^= axis $+                      layout1_title ^= runPlotTitle $+                      layout1_plots ^= ps' $+                      defaultLayout1+          liftIO $ +            do renderableToPNGFile (toRenderable chart) width height file+               when (experimentVerbose $ xyChartExperiment st) $+                 putStr "Generated file " >> putStrLn file+     +-- | Remove the NaN and inifity values.     +filterPlotLinesValues :: [(Double, Double)] -> [[(Double, Double)]]+filterPlotLinesValues = +  filter (not . null) .+  divideBy (\(x, y) -> isNaN x || isInfinite x || isNaN y || isInfinite y)++-- | Get the HTML code.     +xyChartHtml :: XYChartViewState -> Int -> HtmlWriter ()     +xyChartHtml st index =+  let n = experimentRunCount $ xyChartExperiment st+  in if n == 1+     then xyChartHtmlSingle st index+     else xyChartHtmlMultiple st index+     +-- | Get the HTML code for a single run.+xyChartHtmlSingle :: XYChartViewState -> Int -> HtmlWriter ()+xyChartHtmlSingle st index =+  do header st index+     let f = fromJust $ M.lookup 0 (xyChartMap st)+     writeHtmlParagraph $+       writeHtmlImage (makeRelative (xyChartDir st) f)++-- | Get the HTML code for multiple runs.+xyChartHtmlMultiple :: XYChartViewState -> Int -> HtmlWriter ()+xyChartHtmlMultiple st index =+  do header st index+     let n = experimentRunCount $ xyChartExperiment st+     forM_ [0..(n - 1)] $ \i ->+       let f = fromJust $ M.lookup i (xyChartMap st)+       in writeHtmlParagraph $+          writeHtmlImage (makeRelative (xyChartDir st) f)++header :: XYChartViewState -> Int -> HtmlWriter ()+header st index =+  do writeHtmlHeader3WithId ("id" ++ show index) $ +       writeHtmlText (xyChartTitle $ xyChartView st)+     let description = xyChartDescription $ xyChartView st+     unless (null description) $+       writeHtmlParagraph $ +       writeHtmlText description++-- | Get the TOC item.+xyChartTOCHtml :: XYChartViewState -> Int -> HtmlWriter ()+xyChartTOCHtml st index =+  writeHtmlListItem $+  writeHtmlLink ("#id" ++ show index) $+  writeHtmlText (xyChartTitle $ xyChartView st)

@@ -1,5 +1,5 @@ name:            aivika-experiment-chart-version:         0.1+version:         0.1.2 synopsis:        Simulation experiments with charting for the Aivika library description:     This package complements the Aivika and Aivika Experiment packages with@@ -27,7 +27,11 @@ library      exposed-modules: Simulation.Aivika.Experiment.TimeSeriesView+                     Simulation.Aivika.Experiment.XYChartView+                     Simulation.Aivika.Experiment.FinalXYChartView                      Simulation.Aivika.Experiment.DeviationChartView+                     Simulation.Aivika.Experiment.HistogramView+                     Simulation.Aivika.Experiment.FinalHistogramView                      Simulation.Aivika.Experiment.Chart      build-depends:   base >= 3 && < 6,@@ -40,6 +44,6 @@                      data-accessor >= 0.2.2.3,                      colour >= 2.3.3,                      aivika >= 0.4.3,-                     aivika-experiment >= 0.1+                     aivika-experiment >= 0.1.2      ghc-options:     -O2

@@ -12,6 +12,7 @@  import Simulation.Aivika.Experiment import Simulation.Aivika.Experiment.DeviationChartView+import Simulation.Aivika.Experiment.TimeSeriesView  n = 100    -- the number of agents @@ -33,7 +34,10 @@     experimentGenerators =       [outputView $ defaultDeviationChartView {          deviationChartSeries = [Left "potentialAdopters", -                                 Left "adopters"] } ] }+                                 Left "adopters"] },+       outputView $ defaultTimeSeriesView {+         timeSeries = [Left "potentialAdopters", +                       Left "adopters"] } ] }  exprnd :: Double -> IO Double exprnd lambda =@@ -111,7 +115,7 @@      definePersons ps potentialAdopters adopters      runDynamicsInStartTime $        activatePersons ps-     experimentDataInStartTime q $+     experimentDataInStartTime q        [("potentialAdopters",          seriesEntity "Potential Adopters"           potentialAdopters),

@@ -9,6 +9,7 @@ import Simulation.Aivika.Experiment.LastValueView import Simulation.Aivika.Experiment.TableView import Simulation.Aivika.Experiment.TimeSeriesView+import Simulation.Aivika.Experiment.XYChartView  specs = Specs { spcStartTime = 0,                  spcStopTime = 13, @@ -19,6 +20,7 @@ experiment =   defaultExperiment {     experimentSpecs = specs,+    experimentRunCount = 1,     experimentDescription = "Experiment Description",     experimentGenerators =       [outputView $ defaultLastValueView {@@ -28,7 +30,29 @@          tableDescription = "Table description",          tableSeries = ["t", "a", "b", "c"] },         outputView $ defaultTimeSeriesView {-         timeSeries = [Left "a", Left "b", Left "c"] } ] }+         timeSeries = [Left "a", Left "b", Left "c"] },+       -- outputView $ defaultTimeSeriesView {+       --   timeSeriesPlotTitle = "Variables a, b and c for t <= 5 or t >= 7",+       --   timeSeries = [Left "a", Left "b", Left "c"],+       --   timeSeriesPredicate =+       --     do t <- time+       --        return (t <= 5 || t >= 7) },+       outputView $ defaultXYChartView {+         xyChartXSeries = Just "a",+         xyChartYSeries = [Left "b", Right "c"] },+       outputView $ defaultXYChartView {+         xyChartXSeries = Just "b",+         xyChartYSeries = [Right "a", Right "c"] },+       outputView $ defaultXYChartView {+         xyChartXSeries = Just "c",+         xyChartYSeries = [Right "a", Left "b"] } ] }+       -- outputView $ defaultXYChartView {+       --   xyChartPlotTitle = "Functions a=a(c) and b=b(c) for t <= 2 or t >= 3",+       --   xyChartXSeries = Just "c",+       --   xyChartYSeries = [Right "a", Left "b"],+       --   xyChartPredicate = +       --     do t <- time+       --        return (t <= 2 || t >= 3) } ] }  model :: Simulation ExperimentData model =@@ -44,7 +68,7 @@      integDiff integA (- ka * a)      integDiff integB (ka * a - kb * b)      integDiff integC (kb * b)-     experimentDataInStartTime queue $+     experimentDataInStartTime queue        [("t", seriesEntity "time" time),         ("a", seriesEntity "a" a),         ("b", seriesEntity "b" b),

@@ -28,10 +28,13 @@ import Simulation.Aivika.Dynamics.Process  import Simulation.Aivika.Experiment+import Simulation.Aivika.Experiment.Histogram import Simulation.Aivika.Experiment.LastValueView import Simulation.Aivika.Experiment.TableView import Simulation.Aivika.Experiment.TimeSeriesView import Simulation.Aivika.Experiment.DeviationChartView+import Simulation.Aivika.Experiment.FinalHistogramView+import Simulation.Aivika.Experiment.FinalXYChartView  specs = Specs { spcStartTime = 0.0,                 spcStopTime = 1000.0,@@ -42,19 +45,51 @@ experiment =   defaultExperiment {     experimentSpecs = specs,-    experimentRunCount = 3,+    experimentRunCount = 200,     experimentDescription = "Experiment Description",     experimentGenerators =-      [outputView $ defaultLastValueView {-          lastValueDescription = "Last Value description",-          lastValueSeries = ["x"] },-       outputView $ defaultTableView {-         tableDescription = "Table description",-         tableSeries = ["x"] }, -       outputView $ defaultTimeSeriesView {-         timeSeries = [Left "t", Right "x"] }, -       outputView $ defaultDeviationChartView {-         deviationChartSeries = [Left "t", Right "x"] } ] }+      [outputView $ defaultDeviationChartView {+          deviationChartSeries = [Left "t", Right "x"] },+       outputView $ defaultFinalXYChartView {+         finalXYChartPlotTitle = "The proportion up time for simulation runs < 50 and > 100", +         finalXYChartXSeries = Just "n",+         finalXYChartYSeries = [Right "x"], +         finalXYChartPredicate =+           do i <- liftSimulation simulationIndex+              return $ (i < 50) || (i > 100) },+       outputView $ defaultFinalHistogramView {+         finalHistogramPlotTitle  = "Final Histogram (Default)",+         finalHistogramSeries = ["x", "x"] },+       outputView $ defaultFinalHistogramView {+         finalHistogramPlotTitle  = "Final Histogram (Default)",+         finalHistogramSeries = ["t", "t"] },+       outputView $ defaultFinalHistogramView {+         finalHistogramPlotTitle  = "Final Histogram (Default)",+         finalHistogramSeries = ["x"] },+       outputView $ defaultFinalHistogramView {+         finalHistogramPlotTitle  = "Final Histogram (Bin Size = 0.001)",+         finalHistogramBuild  = histogramBinSize 0.001,+         finalHistogramSeries = ["x"] },+       outputView $ defaultFinalHistogramView {+         finalHistogramPlotTitle  = "Final Histogram (Bin Num = 10)",+         finalHistogramBuild  = histogramNumBins 10,+         finalHistogramSeries = ["x"] },+       outputView $ defaultFinalHistogramView {+         finalHistogramPlotTitle  = "Final Histogram (Sturges)",+         finalHistogramBuild  = histogram binSturges,+         finalHistogramSeries = ["x"] },+       outputView $ defaultFinalHistogramView {+         finalHistogramPlotTitle  = "Final Histogram (Doane)",+         finalHistogramBuild  = histogram binDoane,+         finalHistogramSeries = ["x"] },+       outputView $ defaultFinalHistogramView {+         finalHistogramPlotTitle  = "Final Histogram (Sqrt)",+         finalHistogramBuild  = histogram binSqrt,+         finalHistogramSeries = ["x"] },+       outputView $ defaultFinalHistogramView {+         finalHistogramPlotTitle  = "Final Histogram (Scott)",+         finalHistogramBuild  = histogram binScott,+         finalHistogramSeries = ["x"] } ] }  upRate = 1.0 / 1.0       -- reciprocal of mean up time repairRate = 1.0 / 0.5   -- reciprocal of mean repair time@@ -115,8 +150,9 @@               y <- time               return $ x / (2 * y)                         -     experimentDataInStartTime queue $+     experimentDataInStartTime queue        [("x", seriesEntity "The proportion of up time" result),-        ("t", seriesEntity "Total up time" totalUpTime)]+        ("t", seriesEntity "Total up time" totalUpTime),+        ("n", seriesEntity "Simulation run" simulationIndex)]  main = runExperiment experiment model