aivika-experiment-chart 0.4 → 1.0
raw patch · 23 files changed
+2155/−2193 lines, 23 filesdep +Chart-cairodep +data-default-classdep +lensdep −data-accessordep ~Chartdep ~aivikadep ~aivika-experiment
Dependencies added: Chart-cairo, data-default-class, lens
Dependencies removed: data-accessor
Dependency ranges changed: Chart, aivika, aivika-experiment
Files
- LICENSE +1/−1
- Simulation/Aivika/Experiment/Chart.hs +18/−27
- Simulation/Aivika/Experiment/Chart/DeviationChartView.hs +338/−0
- Simulation/Aivika/Experiment/Chart/FinalHistogramView.hs +289/−0
- Simulation/Aivika/Experiment/Chart/FinalXYChartView.hs +328/−0
- Simulation/Aivika/Experiment/Chart/HistogramView.hs +284/−0
- Simulation/Aivika/Experiment/Chart/TimeSeriesView.hs +301/−0
- Simulation/Aivika/Experiment/Chart/Utils.hs +39/−0
- Simulation/Aivika/Experiment/Chart/XYChartView.hs +320/−0
- Simulation/Aivika/Experiment/DeviationChartView.hs +0/−327
- Simulation/Aivika/Experiment/FinalHistogramView.hs +0/−277
- Simulation/Aivika/Experiment/FinalXYChartView.hs +0/−317
- Simulation/Aivika/Experiment/HistogramView.hs +0/−272
- Simulation/Aivika/Experiment/TimeSeriesView.hs +0/−290
- Simulation/Aivika/Experiment/XYChartView.hs +0/−309
- aivika-experiment-chart.cabal +16/−13
- examples/BassDiffusion.hs +10/−16
- examples/ChemicalReaction.hs +4/−10
- examples/DifferenceEquations.hs +8/−14
- examples/Financial.hs +41/−57
- examples/Furnace.hs +131/−210
- examples/LinearArray.hs +4/−14
- examples/MachRep3.hs +23/−39
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2012-2013 David Sorokin <david.sorokin@gmail.com>+Copyright (c) 2012, 2013, 2014 David Sorokin <david.sorokin@gmail.com> All rights reserved.
Simulation/Aivika/Experiment/Chart.hs view
@@ -1,38 +1,29 @@ -- | -- Module : Simulation.Aivika.Experiment.Chart--- Copyright : Copyright (c) 2012, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2012-2014, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental--- Tested with: GHC 7.4.1+-- Tested with: GHC 7.6.3 ----- The module defines some utilities used in the charting.+-- This module re-exports the library functionality. -- module Simulation.Aivika.Experiment.Chart- (colourisePlotLines,- colourisePlotFillBetween,- colourisePlotBars) where--import Data.Colour-import Data.Colour.Names-import Data.Accessor--import Graphics.Rendering.Chart---- | Colourise the plot lines.-colourisePlotLines :: [PlotLines x y -> PlotLines x y]-colourisePlotLines = map mkstyle $ cycle defaultColorSeq- where mkstyle c = plot_lines_style .> line_color ^= c+ (-- * Modules+ module Simulation.Aivika.Experiment.Chart.TimeSeriesView,+ module Simulation.Aivika.Experiment.Chart.XYChartView,+ module Simulation.Aivika.Experiment.Chart.FinalXYChartView,+ module Simulation.Aivika.Experiment.Chart.DeviationChartView,+ module Simulation.Aivika.Experiment.Chart.HistogramView,+ module Simulation.Aivika.Experiment.Chart.FinalHistogramView,+ module Simulation.Aivika.Experiment.Chart.Utils) where --- | Colourise the filling areas.-colourisePlotFillBetween :: [PlotFillBetween x y -> PlotFillBetween x y]-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)- +import Simulation.Aivika.Experiment.Chart.TimeSeriesView+import Simulation.Aivika.Experiment.Chart.XYChartView+import Simulation.Aivika.Experiment.Chart.FinalXYChartView+import Simulation.Aivika.Experiment.Chart.DeviationChartView+import Simulation.Aivika.Experiment.Chart.HistogramView+import Simulation.Aivika.Experiment.Chart.FinalHistogramView+import Simulation.Aivika.Experiment.Chart.Utils
+ Simulation/Aivika/Experiment/Chart/DeviationChartView.hs view
@@ -0,0 +1,338 @@++-- |+-- Module : Simulation.Aivika.Experiment.Chart.DeviationChartView+-- Copyright : Copyright (c) 2012-2014, David Sorokin <david.sorokin@gmail.com>+-- License : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability : experimental+-- Tested with: GHC 7.6.3+--+-- The module defines 'DeviationChartView' that saves the deviation+-- chart in the PNG file.+--++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.Array+import Data.Array.IO.Safe+import Data.Default.Class++import System.IO+import System.FilePath++import Graphics.Rendering.Chart+import Graphics.Rendering.Chart.Backend.Cairo++import Simulation.Aivika.Experiment+import Simulation.Aivika.Experiment.HtmlWriter+import Simulation.Aivika.Experiment.Utils (divideBy, replace)+import Simulation.Aivika.Experiment.Chart.Utils (colourisePlotLines, colourisePlotFillBetween)+import Simulation.Aivika.Experiment.SamplingStatsSource++import Simulation.Aivika.Specs+import Simulation.Aivika.Parameter+import Simulation.Aivika.Simulation+import Simulation.Aivika.Dynamics+import Simulation.Aivika.Event+import Simulation.Aivika.Signal+import Simulation.Aivika.Statistics++-- | Defines the 'View' that saves the deviation chart+-- in the PNG file.+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 :: FileName,+ -- ^ It defines the file name for the PNG file. + -- It may include special variable @$TITLE@.+ --+ -- An example is+ --+ -- @+ -- deviationChartFileName = UniqueFileName \"$TITLE\" \".png\"+ -- @+ deviationChartSeries :: [Either String String],+ -- ^ It contains the labels of data plotted+ -- 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 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 = UniqueFileName "$TITLE" ".png",+ deviationChartSeries = [], + deviationChartPlotTitle = "$TITLE",+ deviationChartPlotLines = colourisePlotLines,+ deviationChartPlotFillBetween = colourisePlotFillBetween,+ deviationChartBottomAxis = id,+ deviationChartLayout = id }++instance ExperimentView DeviationChartView where+ + outputView v = + let reporter exp dir =+ do st <- newDeviationChart v exp dir+ return ExperimentReporter { reporterInitialise = return (),+ reporterFinalise = finaliseDeviationChart st,+ reporterSimulate = simulateDeviationChart st,+ reporterTOCHtml = deviationChartTOCHtml st,+ reporterHtml = deviationChartHtml st }+ in ExperimentGenerator { generateReporter = reporter }+ +-- | The state of the view.+data DeviationChartViewState =+ DeviationChartViewState { deviationChartView :: DeviationChartView,+ deviationChartExperiment :: Experiment,+ deviationChartDir :: FilePath, + deviationChartFile :: IORef (Maybe FilePath),+ deviationChartLock :: MVar (),+ deviationChartResults :: IORef (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 -> FilePath -> IO DeviationChartViewState+newDeviationChart view exp dir =+ do f <- newIORef Nothing+ l <- newMVar () + r <- newIORef Nothing+ return DeviationChartViewState { deviationChartView = view,+ deviationChartExperiment = exp,+ 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 }+ +-- | Simulate the specified series.+simulateDeviationChart :: DeviationChartViewState -> ExperimentData -> Event (Event ())+simulateDeviationChart st expdata =+ do let labels = deviationChartSeries $ deviationChartView st+ (leftLabels, rightLabels) = partitionEithers labels + (leftProviders, rightProviders) =+ (experimentSeriesProviders expdata leftLabels,+ experimentSeriesProviders expdata rightLabels)+ providerInput providers =+ flip map providers $ \provider ->+ case providerToDoubleStatsSource provider of+ Nothing -> error $+ "Cannot represent series " +++ providerName provider ++ + " as a source of double values: simulateDeviationChart"+ Just input -> (providerName provider,+ provider,+ samplingStatsSourceData input)+ leftInput = providerInput leftProviders+ rightInput = providerInput rightProviders+ leftNames = flip map leftInput $ \(x, _, _) -> Left x+ rightNames = flip map rightInput $ \(x, _, _) -> Right x+ input = leftInput ++ rightInput+ names = leftNames ++ rightNames+ source = flip map input $ \(_, _, x) -> x + exp = deviationChartExperiment st+ lock = deviationChartLock st+ results <- liftIO $ readIORef (deviationChartResults st)+ case results of+ Nothing ->+ liftIO $+ do results <- newDeviationChartResults names exp+ writeIORef (deviationChartResults st) $ Just results+ Just results ->+ when (names /= deviationChartNames results) $+ error "Series with different names are returned for different runs: simulateDeviationChart"+ results <- liftIO $ fmap fromJust $ readIORef (deviationChartResults st)+ let stats = deviationChartStats results+ h = experimentSignalInIntegTimes expdata+ handleSignal_ h $ \_ ->+ do xs <- sequence source+ i <- liftDynamics integIteration+ liftIO $ withMVar lock $ \() ->+ forM_ (zip xs stats) $ \(x, stats) ->+ do y <- readArray stats i+ let y' = addDataToSamplingStats x y+ y' `seq` writeArray stats i y'+ return $ return ()+ +-- | 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+ 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 <- resolveFileName + (Just $ deviationChartDir st)+ (deviationChartFileName $ deviationChartView st) $+ M.fromList [("$TITLE", title)]+ let opts = FileOptions (width, height) PNG+ renderableToFile opts (toRenderable chart) file+ 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 -> 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 -> 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 -> Int -> HtmlWriter ()+deviationChartTOCHtml st index =+ writeHtmlListItem $+ writeHtmlLink ("#id" ++ show index) $+ writeHtmlText (deviationChartTitle $ deviationChartView st)
+ Simulation/Aivika/Experiment/Chart/FinalHistogramView.hs view
@@ -0,0 +1,289 @@++-- |+-- Module : Simulation.Aivika.Experiment.Chart.FinalHistogramView+-- Copyright : Copyright (c) 2012-2014, David Sorokin <david.sorokin@gmail.com>+-- License : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability : experimental+-- Tested with: GHC 7.6.3+--+-- 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.Chart.FinalHistogramView+ (FinalHistogramView(..), + defaultFinalHistogramView) where++import Control.Monad+import Control.Monad.Trans+import Control.Concurrent.MVar+import Control.Lens++import qualified Data.Map as M+import Data.IORef+import Data.Maybe+import Data.Either+import Data.Array+import Data.Array.IO.Safe+import Data.Default.Class++import System.IO+import System.FilePath++import Graphics.Rendering.Chart+import Graphics.Rendering.Chart.Backend.Cairo++import Simulation.Aivika.Experiment+import Simulation.Aivika.Experiment.HtmlWriter+import Simulation.Aivika.Experiment.Utils (divideBy, replace)+import Simulation.Aivika.Experiment.Chart.Utils (colourisePlotBars)+import Simulation.Aivika.Experiment.Histogram+import Simulation.Aivika.Experiment.ListSource++import Simulation.Aivika.Specs+import Simulation.Aivika.Parameter+import Simulation.Aivika.Simulation+import Simulation.Aivika.Dynamics+import Simulation.Aivika.Event+import Simulation.Aivika.Signal++-- | 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 :: Event 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 :: Layout Double Double ->+ Layout Double Double+ -- ^ A transformation of the plot layout, + -- where you can redefine the axes, for example.+ }+ +-- | The default histogram view. +defaultFinalHistogramView :: FinalHistogramView+defaultFinalHistogramView = + FinalHistogramView { finalHistogramTitle = "Final Histogram",+ finalHistogramDescription = "It shows a histogram by data gathered in the final time points.",+ finalHistogramWidth = 640,+ finalHistogramHeight = 480,+ finalHistogramFileName = UniqueFileName "$TITLE" ".png",+ finalHistogramPredicate = return True,+ finalHistogramBuild = histogram binSturges,+ finalHistogramSeries = [], + finalHistogramPlotTitle = "$TITLE",+ finalHistogramPlotBars = colourisePlotBars,+ finalHistogramLayout = id }++instance ExperimentView FinalHistogramView where+ + outputView v = + let reporter exp dir =+ do st <- newFinalHistogram v exp dir+ return ExperimentReporter { reporterInitialise = return (),+ reporterFinalise = finaliseFinalHistogram st,+ reporterSimulate = simulateFinalHistogram st,+ reporterTOCHtml = finalHistogramTOCHtml st,+ reporterHtml = finalHistogramHtml st }+ in ExperimentGenerator { 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 :: [ListRef 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 newListRef+ return FinalHistogramResults { finalHistogramNames = names,+ finalHistogramValues = values }+ +-- | Simulation of the specified series.+simulateFinalHistogram :: FinalHistogramViewState -> ExperimentData -> Event (Event ())+simulateFinalHistogram st expdata =+ do let labels = finalHistogramSeries $ finalHistogramView st+ providers = experimentSeriesProviders expdata labels+ input =+ flip map providers $ \provider ->+ case providerToDoubleListSource provider of+ Nothing -> error $+ "Cannot represent series " +++ providerName provider ++ + " as a source of double values: simulateFinalHistogram"+ Just input -> listSourceData 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+ h = filterSignalM (const predicate) $+ experimentSignalInStopTime expdata+ handleSignal_ h $ \_ ->+ do xs <- sequence input+ liftIO $ withMVar lock $ \() ->+ forM_ (zip xs values) $ \(x, values) ->+ addDataToListRef 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 readListRef+ let zs = histogramToBars . filterHistogram . histogram $ + map filterData 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 .~ plotTitle $+ layout_plots .~ [p] $+ def+ file <- resolveFileName + (Just $ finalHistogramDir st)+ (finalHistogramFileName $ finalHistogramView st) $+ M.fromList [("$TITLE", title)]+ let opts = FileOptions (width, height) PNG+ renderableToFile opts (toRenderable chart) 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)
+ Simulation/Aivika/Experiment/Chart/FinalXYChartView.hs view
@@ -0,0 +1,328 @@++-- |+-- Module : Simulation.Aivika.Experiment.Chart.FinalXYChartView+-- Copyright : Copyright (c) 2012-2014, David Sorokin <david.sorokin@gmail.com>+-- License : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability : experimental+-- Tested with: GHC 7.6.3+--+-- The module defines 'FinalXYChartView' that saves the XY chart+-- by final time points for all simulation runs sequentially.+--++module Simulation.Aivika.Experiment.Chart.FinalXYChartView+ (FinalXYChartView(..), + defaultFinalXYChartView) 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.Array+import Data.Array.IO.Safe+import Data.Default.Class++import System.IO+import System.FilePath++import Graphics.Rendering.Chart+import Graphics.Rendering.Chart.Backend.Cairo++import Simulation.Aivika.Experiment+import Simulation.Aivika.Experiment.HtmlWriter+import Simulation.Aivika.Experiment.Utils (divideBy, replace)+import Simulation.Aivika.Experiment.Chart.Utils (colourisePlotLines)++import Simulation.Aivika.Specs+import Simulation.Aivika.Parameter+import Simulation.Aivika.Simulation+import Simulation.Aivika.Dynamics+import Simulation.Aivika.Event+import Simulation.Aivika.Signal++-- | 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 :: Event 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 :: LayoutLR Double Double Double ->+ LayoutLR Double 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 = "It shows the XY chart for the results in the final time points.",+ finalXYChartWidth = 640,+ finalXYChartHeight = 480,+ finalXYChartFileName = UniqueFileName "$TITLE" ".png",+ finalXYChartPredicate = return True,+ finalXYChartXSeries = Nothing,+ finalXYChartYSeries = [], + finalXYChartPlotTitle = "$TITLE",+ finalXYChartPlotLines = colourisePlotLines,+ finalXYChartBottomAxis = id,+ finalXYChartLayout = id }++instance ExperimentView FinalXYChartView where+ + outputView v = + let reporter exp dir =+ do st <- newFinalXYChart v exp dir+ return ExperimentReporter { reporterInitialise = return (),+ reporterFinalise = finaliseFinalXYChart st,+ reporterSimulate = simulateFinalXYChart st,+ reporterTOCHtml = finalXYChartTOCHtml st,+ reporterHtml = finalXYChartHtml st }+ in ExperimentGenerator { 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 -> Event (Event ())+simulateFinalXYChart st expdata =+ do let ylabels = finalXYChartYSeries $ finalXYChartView st+ xlabels = finalXYChartXSeries $ finalXYChartView st+ xlabel = flip fromMaybe xlabels $+ error "X series is not provided: simulateFinalXYChart"+ (leftYLabels, rightYLabels) = partitionEithers ylabels+ leftYProviders = experimentSeriesProviders expdata leftYLabels+ rightYProviders = experimentSeriesProviders expdata rightYLabels+ xprovider = + case experimentSeriesProviders expdata [xlabel] of+ [provider] -> provider+ _ -> error $+ "Only a single X series must be" +++ " provided: simulateFinalXYChart"+ providerInput providers =+ flip map providers $ \provider ->+ case providerToDouble provider of+ Nothing -> error $+ "Cannot represent series " +++ providerName provider ++ + " as double values: simulateFinalXYChart"+ Just input -> (providerName provider, input)+ leftYInput = providerInput leftYProviders+ rightYInput = providerInput rightYProviders+ yinput = leftYInput ++ rightYInput+ [xinput] = providerInput [xprovider]+ leftYNames = map (Left . fst) leftYInput+ rightYNames = map (Right . fst) rightYInput+ ynames = leftYNames ++ rightYNames+ xname = fst xinput+ ys = map snd yinput+ x = snd xinput+ 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+ h = filterSignalM (const predicate) $+ experimentSignalInStopTime expdata+ handleSignal_ h $ \_ ->+ do x' <- x+ ys' <- sequence ys+ i <- liftParameter simulationIndex+ liftIO $ withMVar lock $ \() ->+ forM_ (zip ys' xys) $ \(y', xy) ->+ x' `seq` y' `seq` 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 $+ def+ r = case name of+ Left _ -> Left p+ Right _ -> Right p+ return r+ let axis = plotBottomAxis $+ laxis_title .~ xname $+ 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 <- resolveFileName + (Just $ finalXYChartDir st)+ (finalXYChartFileName $ finalXYChartView st) $+ M.fromList [("$TITLE", title)]+ let opts = FileOptions (width, height) PNG+ renderableToFile opts (toRenderable chart) 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)
+ Simulation/Aivika/Experiment/Chart/HistogramView.hs view
@@ -0,0 +1,284 @@++-- |+-- Module : Simulation.Aivika.Experiment.Chart.HistogramView+-- Copyright : Copyright (c) 2012-2014, David Sorokin <david.sorokin@gmail.com>+-- License : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability : experimental+-- Tested with: GHC 7.6.3+--+-- 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.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.Array+import Data.Default.Class++import System.IO+import System.FilePath++import Graphics.Rendering.Chart+import Graphics.Rendering.Chart.Backend.Cairo++import Simulation.Aivika.Experiment+import Simulation.Aivika.Experiment.HtmlWriter+import Simulation.Aivika.Experiment.Utils (divideBy, replace)+import Simulation.Aivika.Experiment.Chart.Utils (colourisePlotBars)+import Simulation.Aivika.Experiment.Histogram+import Simulation.Aivika.Experiment.ListSource++import Simulation.Aivika.Specs+import Simulation.Aivika.Parameter+import Simulation.Aivika.Simulation+import Simulation.Aivika.Event+import Simulation.Aivika.Signal++-- | 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 :: 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.+ 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 :: 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 = 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 ExperimentView HistogramView where+ + outputView v = + let reporter exp dir =+ do st <- newHistogram v exp dir+ return ExperimentReporter { reporterInitialise = return (),+ reporterFinalise = return (),+ reporterSimulate = simulateHistogram st,+ reporterTOCHtml = histogramTOCHtml st,+ reporterHtml = histogramHtml st }+ in ExperimentGenerator { 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 -> Event (Event ())+simulateHistogram st expdata =+ do let labels = histogramSeries $ histogramView st+ providers = experimentSeriesProviders expdata labels+ names = map providerName providers+ input =+ flip map providers $ \provider ->+ case providerToDoubleListSource provider of+ Nothing -> error $+ "Cannot represent series " +++ providerName provider ++ + " as a source of double values: simulateHistogram"+ Just input -> fmap listDataList $ listSourceData 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 <- liftParameter 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) ->+ newSignalHistory $+ mapSignalM (const input) $+ filterSignalM (const predicate) $+ experimentSignalInIntegTimes expdata+ return $+ 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 let opts = FileOptions (width, height) PNG+ renderableToFile opts (toRenderable chart) 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)
+ Simulation/Aivika/Experiment/Chart/TimeSeriesView.hs view
@@ -0,0 +1,301 @@++-- |+-- Module : Simulation.Aivika.Experiment.Chart.TimeSeriesView+-- Copyright : Copyright (c) 2012-2014, David Sorokin <david.sorokin@gmail.com>+-- License : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability : experimental+-- Tested with: GHC 7.6.3+--+-- The module defines 'TimeSeriesView' that saves the time series+-- charts as the PNG files.+--++module Simulation.Aivika.Experiment.Chart.TimeSeriesView+ (TimeSeriesView(..), + defaultTimeSeriesView) 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.Array+import Data.List+import Data.Default.Class++import System.IO+import System.FilePath++import Graphics.Rendering.Chart+import Graphics.Rendering.Chart.Backend.Cairo++import Simulation.Aivika.Experiment+import Simulation.Aivika.Experiment.HtmlWriter+import Simulation.Aivika.Experiment.Utils (divideBy, replace)+import Simulation.Aivika.Experiment.Chart.Utils (colourisePlotLines)++import Simulation.Aivika.Specs+import Simulation.Aivika.Parameter+import Simulation.Aivika.Simulation+import Simulation.Aivika.Event+import Simulation.Aivika.Signal++-- | Defines the 'View' that saves the time series charts+-- in the PNG files.+data TimeSeriesView =+ TimeSeriesView { timeSeriesTitle :: String,+ -- ^ This is a title used in HTML.+ timeSeriesDescription :: String,+ -- ^ This is a description used in HTML.+ timeSeriesWidth :: Int,+ -- ^ The width of the chart.+ timeSeriesHeight :: Int,+ -- ^ The height of the chart.+ timeSeriesFileName :: FileName,+ -- ^ It defines the file name for each PNG file. + -- It may include special variables @$TITLE@, + -- @$RUN_INDEX@ and @$RUN_COUNT@.+ --+ -- An example is+ --+ -- @+ -- timeSeriesFileName = UniqueFileName \"$TITLE - $RUN_INDEX\" \".png\"+ -- @+ timeSeriesPredicate :: Event Bool,+ -- ^ It specifies the predicate that defines+ -- when we plot data in the chart.+ timeSeries :: [Either String String],+ -- ^ It contains the labels of data plotted+ -- 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 + -- transformations based on which the plot+ -- is constructed for each series. Generally,+ -- it must 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.+ timeSeriesBottomAxis :: LayoutAxis Double ->+ LayoutAxis Double,+ -- ^ A transformation of the bottom axis, + -- after title @time@ is added.+ timeSeriesLayout :: LayoutLR Double Double Double ->+ LayoutLR Double Double Double+ -- ^ A transformation of the plot layout, + -- where you can redefine the axes, for example.+ }+ +-- | The default time series view. +defaultTimeSeriesView :: TimeSeriesView+defaultTimeSeriesView = + TimeSeriesView { timeSeriesTitle = "Time Series",+ timeSeriesDescription = "It shows the Time Series chart(s).",+ 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 ExperimentView TimeSeriesView where+ + outputView v = + let reporter exp dir =+ do st <- newTimeSeries v exp dir+ return ExperimentReporter { reporterInitialise = return (),+ reporterFinalise = return (),+ reporterSimulate = simulateTimeSeries st,+ reporterTOCHtml = timeSeriesTOCHtml st,+ reporterHtml = timeSeriesHtml st }+ in ExperimentGenerator { generateReporter = reporter }+ +-- | The state of the view.+data TimeSeriesViewState =+ TimeSeriesViewState { timeSeriesView :: TimeSeriesView,+ timeSeriesExperiment :: Experiment,+ timeSeriesDir :: FilePath, + timeSeriesMap :: M.Map Int FilePath }+ +-- | Create a new state of the view.+newTimeSeries :: TimeSeriesView -> Experiment -> FilePath -> IO TimeSeriesViewState+newTimeSeries view exp dir =+ do let n = experimentRunCount exp+ fs <- forM [0..(n - 1)] $ \i -> + resolveFileName (Just dir) (timeSeriesFileName view) $+ 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,+ timeSeriesDir = dir, + timeSeriesMap = m }+ +-- | Plot the time series chart during the simulation.+simulateTimeSeries :: TimeSeriesViewState -> ExperimentData -> Event (Event ())+simulateTimeSeries st expdata =+ do let labels = timeSeries $ timeSeriesView st+ (leftLabels, rightLabels) = partitionEithers labels + (leftProviders, rightProviders) =+ (experimentSeriesProviders expdata leftLabels,+ experimentSeriesProviders expdata rightLabels)+ providerInput providers =+ flip map providers $ \provider ->+ case providerToDouble provider of+ Nothing -> error $+ "Cannot represent series " +++ providerName provider ++ + " as double values: simulateTimeSeries"+ Just input -> (providerName provider, provider, input)+ leftInput = providerInput leftProviders+ rightInput = providerInput rightProviders+ n = experimentRunCount $ timeSeriesExperiment st+ width = timeSeriesWidth $ timeSeriesView st+ height = timeSeriesHeight $ timeSeriesView st+ predicate = timeSeriesPredicate $ timeSeriesView st+ plotLines = timeSeriesPlotLines $ timeSeriesView st+ plotBottomAxis = timeSeriesBottomAxis $ timeSeriesView st+ plotLayout = timeSeriesLayout $ timeSeriesView st+ i <- liftParameter simulationIndex+ let file = fromJust $ M.lookup (i - 1) (timeSeriesMap st)+ title = timeSeriesTitle $ timeSeriesView st+ plotTitle = + replace "$TITLE" title+ (timeSeriesPlotTitle $ timeSeriesView st)+ runPlotTitle =+ if n == 1+ then plotTitle+ else replace "$RUN_INDEX" (show i) $+ replace "$RUN_COUNT" (show n) $+ replace "$PLOT_TITLE" plotTitle+ (timeSeriesRunPlotTitle $ timeSeriesView st)+ inputHistory input =+ forM input $ \(name, provider, input) ->+ let transform () =+ do x <- predicate+ if x then input else return (1/0) -- the infinite values will be ignored then+ in newSignalHistory $+ mapSignalM transform $+ experimentMixedSignal expdata [provider]+ leftHs <- inputHistory leftInput+ rightHs <- inputHistory rightInput+ return $+ do let plots hs input plotLineTails =+ do ps <-+ forM (zip3 hs input (head plotLineTails)) $+ \(h, (name, provider, input), plotLines) ->+ do (ts, xs) <- readSignalHistory h + return $+ toPlot $+ plotLines $+ plot_lines_values .~ filterPlotLinesValues (zip (elems ts) (elems xs)) $+ plot_lines_title .~ name $+ def+ return (ps, drop (length hs) plotLineTails)+ (leftPs, plotLineTails) <- plots leftHs leftInput (tails plotLines)+ (rightPs, plotLineTails) <- plots rightHs rightInput plotLineTails+ let leftPs' = map Left leftPs+ rightPs' = map Right rightPs+ ps' = leftPs' ++ rightPs'+ axis = plotBottomAxis $+ laxis_title .~ "time" $+ def+ updateLeftAxis =+ if null leftPs+ then layoutlr_left_axis_visibility .~ AxisVisibility False False False+ else id+ updateRightAxis =+ if null rightPs+ then layoutlr_right_axis_visibility .~ AxisVisibility False False False+ else id+ chart = plotLayout . updateLeftAxis . updateRightAxis $+ layoutlr_x_axis .~ axis $+ layoutlr_title .~ runPlotTitle $+ layoutlr_plots .~ ps' $+ def+ liftIO $ + do let opts = FileOptions (width, height) PNG+ renderableToFile opts (toRenderable chart) file+ when (experimentVerbose $ timeSeriesExperiment st) $+ putStr "Generated file " >> putStrLn file+ +-- | Remove the NaN and inifity values. +filterPlotLinesValues :: [(Double, Double)] -> [[(Double, Double)]]+filterPlotLinesValues = + filter (not . null) .+ divideBy (\(t, x) -> isNaN x || isInfinite x)++-- | Get the HTML code. +timeSeriesHtml :: TimeSeriesViewState -> Int -> HtmlWriter () +timeSeriesHtml st index =+ let n = experimentRunCount $ timeSeriesExperiment st+ in if n == 1+ then timeSeriesHtmlSingle st index+ else timeSeriesHtmlMultiple st index+ +-- | Get the HTML code for a single run.+timeSeriesHtmlSingle :: TimeSeriesViewState -> Int -> HtmlWriter ()+timeSeriesHtmlSingle st index =+ do header st index+ let f = fromJust $ M.lookup 0 (timeSeriesMap st)+ writeHtmlParagraph $+ writeHtmlImage (makeRelative (timeSeriesDir st) f)++-- | Get the HTML code for multiple runs.+timeSeriesHtmlMultiple :: TimeSeriesViewState -> Int -> HtmlWriter ()+timeSeriesHtmlMultiple st index =+ do header st index+ let n = experimentRunCount $ timeSeriesExperiment st+ forM_ [0..(n - 1)] $ \i ->+ let f = fromJust $ M.lookup i (timeSeriesMap st)+ in writeHtmlParagraph $+ writeHtmlImage (makeRelative (timeSeriesDir st) f)++header :: TimeSeriesViewState -> Int -> HtmlWriter ()+header st index =+ do writeHtmlHeader3WithId ("id" ++ show index) $ + writeHtmlText (timeSeriesTitle $ timeSeriesView st)+ let description = timeSeriesDescription $ timeSeriesView st+ unless (null description) $+ writeHtmlParagraph $ + writeHtmlText description++-- | Get the TOC item.+timeSeriesTOCHtml :: TimeSeriesViewState -> Int -> HtmlWriter ()+timeSeriesTOCHtml st index =+ writeHtmlListItem $+ writeHtmlLink ("#id" ++ show index) $+ writeHtmlText (timeSeriesTitle $ timeSeriesView st)
+ Simulation/Aivika/Experiment/Chart/Utils.hs view
@@ -0,0 +1,39 @@++-- |+-- Module : Simulation.Aivika.Experiment.Chart.Utils+-- Copyright : Copyright (c) 2012-2014, David Sorokin <david.sorokin@gmail.com>+-- License : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability : experimental+-- Tested with: GHC 7.6.3+--+-- The module defines some utilities used in the charting.+--++module Simulation.Aivika.Experiment.Chart.Utils+ (colourisePlotLines,+ colourisePlotFillBetween,+ colourisePlotBars) where++import Control.Lens++import Data.Colour+import Data.Colour.Names++import Graphics.Rendering.Chart++-- | Colourise the plot lines.+colourisePlotLines :: [PlotLines x y -> PlotLines x y]+colourisePlotLines = map mkstyle $ cycle defaultColorSeq+ where mkstyle c = plot_lines_style . line_color .~ c++-- | Colourise the filling areas.+colourisePlotFillBetween :: [PlotFillBetween x y -> PlotFillBetween x y]+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)+
+ Simulation/Aivika/Experiment/Chart/XYChartView.hs view
@@ -0,0 +1,320 @@++-- |+-- Module : Simulation.Aivika.Experiment.Chart.XYChartView+-- Copyright : Copyright (c) 2012-2014, David Sorokin <david.sorokin@gmail.com>+-- License : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability : experimental+-- Tested with: GHC 7.6.3+--+-- The module defines 'XYChartView' that saves the XY charts +-- in the PNG files.+--++module Simulation.Aivika.Experiment.Chart.XYChartView+ (XYChartView(..), + defaultXYChartView) 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.Array+import Data.Monoid+import Data.List+import Data.Default.Class++import System.IO+import System.FilePath++import Graphics.Rendering.Chart+import Graphics.Rendering.Chart.Backend.Cairo++import Simulation.Aivika.Experiment+import Simulation.Aivika.Experiment.HtmlWriter+import Simulation.Aivika.Experiment.Utils (divideBy, replace)+import Simulation.Aivika.Experiment.Chart.Utils (colourisePlotLines)++import Simulation.Aivika.Specs+import Simulation.Aivika.Parameter+import Simulation.Aivika.Simulation+import Simulation.Aivika.Event+import Simulation.Aivika.Signal++-- | 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 :: Event 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 :: LayoutLR Double Double Double ->+ LayoutLR Double 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 = "It shows the XY chart(s).",+ 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 ExperimentView XYChartView where+ + outputView v = + let reporter exp dir =+ do st <- newXYChart v exp dir+ return ExperimentReporter { reporterInitialise = return (),+ reporterFinalise = return (),+ reporterSimulate = simulateXYChart st,+ reporterTOCHtml = xyChartTOCHtml st,+ reporterHtml = xyChartHtml st }+ in ExperimentGenerator { 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 -> Event (Event ())+simulateXYChart st expdata =+ do let ylabels = xyChartYSeries $ xyChartView st+ xlabels = xyChartXSeries $ xyChartView st+ xlabel = flip fromMaybe xlabels $+ error "X series is not provided: simulateXYChart"+ (leftYLabels, rightYLabels) = partitionEithers ylabels+ leftYProviders = experimentSeriesProviders expdata leftYLabels+ rightYProviders = experimentSeriesProviders expdata rightYLabels+ xprovider = + case experimentSeriesProviders expdata [xlabel] of+ [provider] -> provider+ _ -> error $+ "Only a single X series must be" +++ " provided: simulateXYChart"+ providerInput providers =+ flip map providers $ \provider ->+ case providerToDouble provider of+ Nothing -> error $+ "Cannot represent series " +++ providerName provider ++ + " as double values: simulateXYChart"+ Just input -> (providerName provider, provider, input)+ leftYInput = providerInput leftYProviders+ rightYInput = providerInput rightYProviders+ [(xname, _, x)] = providerInput [xprovider]+ 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 <- liftParameter 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)+ inputHistory input = + forM input $ \(name, 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 newSignalHistory $+ mapSignalM transform $+ experimentMixedSignal expdata [provider] <>+ experimentMixedSignal expdata [xprovider]+ leftHs <- inputHistory leftYInput+ rightHs <- inputHistory rightYInput+ return $+ do let plots hs input plotLineTails =+ do ps <-+ forM (zip3 hs input (head plotLineTails)) $+ \(h, (name, provider, input), plotLines) ->+ do (ts, zs) <- readSignalHistory h + return $+ toPlot $+ plotLines $+ plot_lines_values .~ filterPlotLinesValues (elems zs) $+ plot_lines_title .~ name $+ def+ return (ps, drop (length hs) plotLineTails) + (leftPs, plotLineTails) <- plots leftHs leftYInput (tails plotLines)+ (rightPs, plotLineTails) <- plots rightHs rightYInput plotLineTails+ let leftPs' = map Left leftPs+ rightPs' = map Right rightPs+ ps' = leftPs' ++ rightPs'+ axis = plotBottomAxis $+ laxis_title .~ providerName xprovider $+ def+ updateLeftAxis =+ if null leftPs+ then layoutlr_left_axis_visibility .~ AxisVisibility False False False+ else id+ updateRightAxis =+ if null rightPs+ then layoutlr_right_axis_visibility .~ AxisVisibility False False False+ else id+ chart = plotLayout . updateLeftAxis . updateRightAxis $+ layoutlr_x_axis .~ axis $+ layoutlr_title .~ runPlotTitle $+ layoutlr_plots .~ ps' $+ def+ liftIO $ + do let opts = FileOptions (width, height) PNG+ renderableToFile opts (toRenderable chart) 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)
− Simulation/Aivika/Experiment/DeviationChartView.hs
@@ -1,327 +0,0 @@---- |--- Module : Simulation.Aivika.Experiment.DeviationChartView--- Copyright : Copyright (c) 2012-2013, David Sorokin <david.sorokin@gmail.com>--- License : BSD3--- Maintainer : David Sorokin <david.sorokin@gmail.com>--- Stability : experimental--- Tested with: GHC 7.6.3------ The module defines 'DeviationChartView' that saves the deviation--- chart in the PNG file.-----module Simulation.Aivika.Experiment.DeviationChartView- (DeviationChartView(..), - defaultDeviationChartView) 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.Safe--import Data.Accessor--import System.IO-import System.FilePath--import Graphics.Rendering.Chart--import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.HtmlWriter-import Simulation.Aivika.Experiment.Utils (divideBy, replace)-import Simulation.Aivika.Experiment.Chart (colourisePlotLines, colourisePlotFillBetween)-import Simulation.Aivika.Experiment.SamplingStatsSource--import Simulation.Aivika.Specs-import Simulation.Aivika.Simulation-import Simulation.Aivika.Dynamics-import Simulation.Aivika.Event-import Simulation.Aivika.Signal-import Simulation.Aivika.Statistics---- | Defines the 'View' that saves the deviation chart--- in the PNG file.-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 :: FileName,- -- ^ It defines the file name for the PNG file. - -- It may include special variable @$TITLE@.- --- -- An example is- --- -- @- -- deviationChartFileName = UniqueFileName \"$TITLE\" \".png\"- -- @- deviationChartSeries :: [Either String String],- -- ^ It contains the labels of data plotted- -- 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 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 :: Layout1 Double Double ->- Layout1 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 = UniqueFileName "$TITLE" ".png",- deviationChartSeries = [], - deviationChartPlotTitle = "$TITLE",- deviationChartPlotLines = colourisePlotLines,- deviationChartPlotFillBetween = colourisePlotFillBetween,- deviationChartBottomAxis = id,- deviationChartLayout = id }--instance View DeviationChartView where- - outputView v = - let reporter exp dir =- do st <- newDeviationChart v exp dir- return Reporter { reporterInitialise = return (),- reporterFinalise = finaliseDeviationChart st,- reporterSimulate = simulateDeviationChart st,- reporterTOCHtml = deviationChartTOCHtml st,- reporterHtml = deviationChartHtml st }- in Generator { generateReporter = reporter }- --- | The state of the view.-data DeviationChartViewState =- DeviationChartViewState { deviationChartView :: DeviationChartView,- deviationChartExperiment :: Experiment,- deviationChartDir :: FilePath, - deviationChartFile :: IORef (Maybe FilePath),- deviationChartLock :: MVar (),- deviationChartResults :: IORef (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 -> FilePath -> IO DeviationChartViewState-newDeviationChart view exp dir =- do f <- newIORef Nothing- l <- newMVar () - r <- newIORef Nothing- return DeviationChartViewState { deviationChartView = view,- deviationChartExperiment = exp,- 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 }- --- | Simulate the specified series.-simulateDeviationChart :: DeviationChartViewState -> ExperimentData -> Event (Event ())-simulateDeviationChart st expdata =- do let labels = deviationChartSeries $ deviationChartView st- (leftLabels, rightLabels) = partitionEithers labels - (leftProviders, rightProviders) =- (experimentSeriesProviders expdata leftLabels,- experimentSeriesProviders expdata rightLabels)- providerInput providers =- flip map providers $ \provider ->- case providerToDoubleStatsSource provider of- Nothing -> error $- "Cannot represent series " ++- providerName provider ++ - " as a source of double values: simulateDeviationChart"- Just input -> (providerName provider,- provider,- samplingStatsSourceData input)- leftInput = providerInput leftProviders- rightInput = providerInput rightProviders- leftNames = flip map leftInput $ \(x, _, _) -> Left x- rightNames = flip map rightInput $ \(x, _, _) -> Right x- input = leftInput ++ rightInput- names = leftNames ++ rightNames- source = flip map input $ \(_, _, x) -> x - exp = deviationChartExperiment st- lock = deviationChartLock st- results <- liftIO $ readIORef (deviationChartResults st)- case results of- Nothing ->- liftIO $- do results <- newDeviationChartResults names exp- writeIORef (deviationChartResults st) $ Just results- Just results ->- when (names /= deviationChartNames results) $- error "Series with different names are returned for different runs: simulateDeviationChart"- results <- liftIO $ fmap fromJust $ readIORef (deviationChartResults st)- let stats = deviationChartStats results- h = experimentSignalInIntegTimes expdata- handleSignal_ h $ \_ ->- do xs <- sequence source- i <- liftDynamics integIteration- liftIO $ withMVar lock $ \() ->- forM_ (zip xs stats) $ \(x, stats) ->- do y <- readArray stats i- let y' = addDataToSamplingStats x y- y' `seq` writeArray stats i y'- return $ return ()- --- | 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- 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 $- defaultPlotLines- 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 $- defaultPlotFillBetween- 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" $- defaultLayoutAxis- chart = plotLayout $- layout1_bottom_axis ^= axis $- layout1_title ^= plotTitle $- layout1_plots ^= ps $- defaultLayout1- file <- resolveFileName - (Just $ deviationChartDir st)- (deviationChartFileName $ deviationChartView st) $- M.fromList [("$TITLE", title)]- renderableToPNGFile (toRenderable chart) width height file- 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 -> 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 -> 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 -> Int -> HtmlWriter ()-deviationChartTOCHtml st index =- writeHtmlListItem $- writeHtmlLink ("#id" ++ show index) $- writeHtmlText (deviationChartTitle $ deviationChartView st)
− Simulation/Aivika/Experiment/FinalHistogramView.hs
@@ -1,277 +0,0 @@---- |--- 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.Safe--import Data.Accessor--import System.IO-import System.FilePath--import Graphics.Rendering.Chart--import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.HtmlWriter-import Simulation.Aivika.Experiment.Utils (divideBy, replace)-import Simulation.Aivika.Experiment.Chart (colourisePlotBars)-import Simulation.Aivika.Experiment.Histogram-import Simulation.Aivika.Experiment.ListSource--import Simulation.Aivika.Specs-import Simulation.Aivika.Simulation-import Simulation.Aivika.Dynamics-import Simulation.Aivika.Event-import Simulation.Aivika.Signal---- | 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 :: Event 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 = "It shows a histogram by data gathered in the final time points.",- 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 :: [ListRef 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 newListRef- return FinalHistogramResults { finalHistogramNames = names,- finalHistogramValues = values }- --- | Simulation of the specified series.-simulateFinalHistogram :: FinalHistogramViewState -> ExperimentData -> Event (Event ())-simulateFinalHistogram st expdata =- do let labels = finalHistogramSeries $ finalHistogramView st- providers = experimentSeriesProviders expdata labels- input =- flip map providers $ \provider ->- case providerToDoubleListSource provider of- Nothing -> error $- "Cannot represent series " ++- providerName provider ++ - " as a source of double values: simulateFinalHistogram"- Just input -> listSourceData 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- h = filterSignalM (const predicate) $- experimentSignalInStopTime expdata- handleSignal_ h $ \_ ->- do xs <- sequence input- liftIO $ withMVar lock $ \() ->- forM_ (zip xs values) $ \(x, values) ->- addDataToListRef 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 readListRef- 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)
− Simulation/Aivika/Experiment/FinalXYChartView.hs
@@ -1,317 +0,0 @@---- |--- 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.Safe--import Data.Accessor--import System.IO-import System.FilePath--import Graphics.Rendering.Chart--import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.HtmlWriter-import Simulation.Aivika.Experiment.Utils (divideBy, replace)-import Simulation.Aivika.Experiment.Chart (colourisePlotLines)--import Simulation.Aivika.Specs-import Simulation.Aivika.Simulation-import Simulation.Aivika.Dynamics-import Simulation.Aivika.Event-import Simulation.Aivika.Signal---- | 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 :: Event 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 = "It shows the XY chart for the results in the final time points.",- 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 -> Event (Event ())-simulateFinalXYChart st expdata =- do let ylabels = finalXYChartYSeries $ finalXYChartView st- xlabels = finalXYChartXSeries $ finalXYChartView st- xlabel = flip fromMaybe xlabels $- error "X series is not provided: simulateFinalXYChart"- (leftYLabels, rightYLabels) = partitionEithers ylabels- leftYProviders = experimentSeriesProviders expdata leftYLabels- rightYProviders = experimentSeriesProviders expdata rightYLabels- xprovider = - case experimentSeriesProviders expdata [xlabel] of- [provider] -> provider- _ -> error $- "Only a single X series must be" ++- " provided: simulateFinalXYChart"- providerInput providers =- flip map providers $ \provider ->- case providerToDouble provider of- Nothing -> error $- "Cannot represent series " ++- providerName provider ++ - " as double values: simulateFinalXYChart"- Just input -> (providerName provider, input)- leftYInput = providerInput leftYProviders- rightYInput = providerInput rightYProviders- yinput = leftYInput ++ rightYInput- [xinput] = providerInput [xprovider]- leftYNames = map (Left . fst) leftYInput- rightYNames = map (Right . fst) rightYInput- ynames = leftYNames ++ rightYNames- xname = fst xinput- ys = map snd yinput- x = snd xinput- 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- h = filterSignalM (const predicate) $- experimentSignalInStopTime expdata- handleSignal_ h $ \_ ->- do x' <- x- ys' <- sequence ys- i <- liftSimulation simulationIndex- liftIO $ withMVar lock $ \() ->- forM_ (zip ys' xys) $ \(y', xy) ->- x' `seq` y' `seq` 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)
− Simulation/Aivika/Experiment/HistogramView.hs
@@ -1,272 +0,0 @@---- |--- 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 Graphics.Rendering.Chart--import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.HtmlWriter-import Simulation.Aivika.Experiment.Utils (divideBy, replace)-import Simulation.Aivika.Experiment.Chart (colourisePlotBars)-import Simulation.Aivika.Experiment.Histogram-import Simulation.Aivika.Experiment.ListSource--import Simulation.Aivika.Specs-import Simulation.Aivika.Simulation-import Simulation.Aivika.Event-import Simulation.Aivika.Signal---- | 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 :: 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.- 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 = "It shows the histogram(s) by data gathered in the integration time points.",- 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 -> Event (Event ())-simulateHistogram st expdata =- do let labels = histogramSeries $ histogramView st- providers = experimentSeriesProviders expdata labels- names = map providerName providers- input =- flip map providers $ \provider ->- case providerToDoubleListSource provider of- Nothing -> error $- "Cannot represent series " ++- providerName provider ++ - " as a source of double values: simulateHistogram"- Just input -> fmap listDataList $ listSourceData 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) ->- newSignalHistory $- mapSignalM (const input) $- filterSignalM (const predicate) $- experimentSignalInIntegTimes expdata- return $- 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 $- 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)
− Simulation/Aivika/Experiment/TimeSeriesView.hs
@@ -1,290 +0,0 @@---- |--- Module : Simulation.Aivika.Experiment.TimeSeriesView--- 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 'TimeSeriesView' that saves the time series--- charts as the PNG files.-----module Simulation.Aivika.Experiment.TimeSeriesView- (TimeSeriesView(..), - defaultTimeSeriesView) 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.List--import Data.Accessor--import System.IO-import System.FilePath--import Graphics.Rendering.Chart--import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.HtmlWriter-import Simulation.Aivika.Experiment.Utils (divideBy, replace)-import Simulation.Aivika.Experiment.Chart (colourisePlotLines)--import Simulation.Aivika.Specs-import Simulation.Aivika.Simulation-import Simulation.Aivika.Event-import Simulation.Aivika.Signal---- | Defines the 'View' that saves the time series charts--- in the PNG files.-data TimeSeriesView =- TimeSeriesView { timeSeriesTitle :: String,- -- ^ This is a title used in HTML.- timeSeriesDescription :: String,- -- ^ This is a description used in HTML.- timeSeriesWidth :: Int,- -- ^ The width of the chart.- timeSeriesHeight :: Int,- -- ^ The height of the chart.- timeSeriesFileName :: FileName,- -- ^ It defines the file name for each PNG file. - -- It may include special variables @$TITLE@, - -- @$RUN_INDEX@ and @$RUN_COUNT@.- --- -- An example is- --- -- @- -- timeSeriesFileName = UniqueFileName \"$TITLE - $RUN_INDEX\" \".png\"- -- @- timeSeriesPredicate :: Event Bool,- -- ^ It specifies the predicate that defines- -- when we plot data in the chart.- timeSeries :: [Either String String],- -- ^ It contains the labels of data plotted- -- 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 - -- transformations based on which the plot- -- is constructed for each series. Generally,- -- it must 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.- 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, - -- where you can redefine the axes, for example.- }- --- | The default time series view. -defaultTimeSeriesView :: TimeSeriesView-defaultTimeSeriesView = - TimeSeriesView { timeSeriesTitle = "Time Series",- timeSeriesDescription = "It shows the Time Series chart(s).",- 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- - outputView v = - let reporter exp dir =- do st <- newTimeSeries v exp dir- return Reporter { reporterInitialise = return (),- reporterFinalise = return (),- reporterSimulate = simulateTimeSeries st,- reporterTOCHtml = timeSeriesTOCHtml st,- reporterHtml = timeSeriesHtml st }- in Generator { generateReporter = reporter }- --- | The state of the view.-data TimeSeriesViewState =- TimeSeriesViewState { timeSeriesView :: TimeSeriesView,- timeSeriesExperiment :: Experiment,- timeSeriesDir :: FilePath, - timeSeriesMap :: M.Map Int FilePath }- --- | Create a new state of the view.-newTimeSeries :: TimeSeriesView -> Experiment -> FilePath -> IO TimeSeriesViewState-newTimeSeries view exp dir =- do let n = experimentRunCount exp- fs <- forM [0..(n - 1)] $ \i -> - resolveFileName (Just dir) (timeSeriesFileName view) $- 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,- timeSeriesDir = dir, - timeSeriesMap = m }- --- | Plot the time series chart during the simulation.-simulateTimeSeries :: TimeSeriesViewState -> ExperimentData -> Event (Event ())-simulateTimeSeries st expdata =- do let labels = timeSeries $ timeSeriesView st- (leftLabels, rightLabels) = partitionEithers labels - (leftProviders, rightProviders) =- (experimentSeriesProviders expdata leftLabels,- experimentSeriesProviders expdata rightLabels)- providerInput providers =- flip map providers $ \provider ->- case providerToDouble provider of- Nothing -> error $- "Cannot represent series " ++- providerName provider ++ - " as double values: simulateTimeSeries"- Just input -> (providerName provider, provider, input)- leftInput = providerInput leftProviders- rightInput = providerInput rightProviders- n = experimentRunCount $ timeSeriesExperiment st- width = timeSeriesWidth $ timeSeriesView st- 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 = timeSeriesTitle $ timeSeriesView st- plotTitle = - replace "$TITLE" title- (timeSeriesPlotTitle $ timeSeriesView st)- runPlotTitle =- if n == 1- then plotTitle- else replace "$RUN_INDEX" (show i) $- replace "$RUN_COUNT" (show n) $- replace "$PLOT_TITLE" plotTitle- (timeSeriesRunPlotTitle $ timeSeriesView st)- inputHistory input =- forM input $ \(name, provider, input) ->- let transform () =- do x <- predicate- if x then input else return (1/0) -- the infinite values will be ignored then- in newSignalHistory $- mapSignalM transform $- experimentMixedSignal expdata [provider]- leftHs <- inputHistory leftInput- rightHs <- inputHistory rightInput- return $- do let plots hs input plotLineTails =- do ps <-- forM (zip3 hs input (head plotLineTails)) $- \(h, (name, provider, input), plotLines) ->- do (ts, xs) <- readSignalHistory h - return $- toPlot $- plotLines $- plot_lines_values ^= filterPlotLinesValues (zip (elems ts) (elems xs)) $- plot_lines_title ^= name $- defaultPlotLines- return (ps, drop (length hs) plotLineTails)- (leftPs, plotLineTails) <- plots leftHs leftInput (tails plotLines)- (rightPs, plotLineTails) <- plots rightHs rightInput plotLineTails- let leftPs' = map Left leftPs- rightPs' = map Right rightPs- ps' = leftPs' ++ rightPs'- axis = plotBottomAxis $- laxis_title ^= "time" $- defaultLayoutAxis- chart = plotLayout $- layout1_bottom_axis ^= axis $- layout1_title ^= runPlotTitle $- layout1_plots ^= ps' $- defaultLayout1- liftIO $ - do renderableToPNGFile (toRenderable chart) width height file- when (experimentVerbose $ timeSeriesExperiment st) $- putStr "Generated file " >> putStrLn file- --- | Remove the NaN and inifity values. -filterPlotLinesValues :: [(Double, Double)] -> [[(Double, Double)]]-filterPlotLinesValues = - filter (not . null) .- divideBy (\(t, x) -> isNaN x || isInfinite x)---- | Get the HTML code. -timeSeriesHtml :: TimeSeriesViewState -> Int -> HtmlWriter () -timeSeriesHtml st index =- let n = experimentRunCount $ timeSeriesExperiment st- in if n == 1- then timeSeriesHtmlSingle st index- else timeSeriesHtmlMultiple st index- --- | Get the HTML code for a single run.-timeSeriesHtmlSingle :: TimeSeriesViewState -> Int -> HtmlWriter ()-timeSeriesHtmlSingle st index =- do header st index- let f = fromJust $ M.lookup 0 (timeSeriesMap st)- writeHtmlParagraph $- writeHtmlImage (makeRelative (timeSeriesDir st) f)---- | Get the HTML code for multiple runs.-timeSeriesHtmlMultiple :: TimeSeriesViewState -> Int -> HtmlWriter ()-timeSeriesHtmlMultiple st index =- do header st index- let n = experimentRunCount $ timeSeriesExperiment st- forM_ [0..(n - 1)] $ \i ->- let f = fromJust $ M.lookup i (timeSeriesMap st)- in writeHtmlParagraph $- writeHtmlImage (makeRelative (timeSeriesDir st) f)--header :: TimeSeriesViewState -> Int -> HtmlWriter ()-header st index =- do writeHtmlHeader3WithId ("id" ++ show index) $ - writeHtmlText (timeSeriesTitle $ timeSeriesView st)- let description = timeSeriesDescription $ timeSeriesView st- unless (null description) $- writeHtmlParagraph $ - writeHtmlText description---- | Get the TOC item.-timeSeriesTOCHtml :: TimeSeriesViewState -> Int -> HtmlWriter ()-timeSeriesTOCHtml st index =- writeHtmlListItem $- writeHtmlLink ("#id" ++ show index) $- writeHtmlText (timeSeriesTitle $ timeSeriesView st)
− Simulation/Aivika/Experiment/XYChartView.hs
@@ -1,309 +0,0 @@---- |--- 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.List--import Data.Accessor--import System.IO-import System.FilePath--import Graphics.Rendering.Chart--import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.HtmlWriter-import Simulation.Aivika.Experiment.Utils (divideBy, replace)-import Simulation.Aivika.Experiment.Chart (colourisePlotLines)--import Simulation.Aivika.Specs-import Simulation.Aivika.Simulation-import Simulation.Aivika.Event-import Simulation.Aivika.Signal---- | 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 :: Event 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 = "It shows the XY chart(s).",- 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 -> Event (Event ())-simulateXYChart st expdata =- do let ylabels = xyChartYSeries $ xyChartView st- xlabels = xyChartXSeries $ xyChartView st- xlabel = flip fromMaybe xlabels $- error "X series is not provided: simulateXYChart"- (leftYLabels, rightYLabels) = partitionEithers ylabels- leftYProviders = experimentSeriesProviders expdata leftYLabels- rightYProviders = experimentSeriesProviders expdata rightYLabels- xprovider = - case experimentSeriesProviders expdata [xlabel] of- [provider] -> provider- _ -> error $- "Only a single X series must be" ++- " provided: simulateXYChart"- providerInput providers =- flip map providers $ \provider ->- case providerToDouble provider of- Nothing -> error $- "Cannot represent series " ++- providerName provider ++ - " as double values: simulateXYChart"- Just input -> (providerName provider, provider, input)- leftYInput = providerInput leftYProviders- rightYInput = providerInput rightYProviders- [(xname, _, x)] = providerInput [xprovider]- 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)- inputHistory input = - forM input $ \(name, 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 newSignalHistory $- mapSignalM transform $- experimentMixedSignal expdata [provider] <>- experimentMixedSignal expdata [xprovider]- leftHs <- inputHistory leftYInput- rightHs <- inputHistory rightYInput- return $- do let plots hs input plotLineTails =- do ps <-- forM (zip3 hs input (head plotLineTails)) $- \(h, (name, provider, input), plotLines) ->- do (ts, zs) <- readSignalHistory h - return $- toPlot $- plotLines $- plot_lines_values ^= filterPlotLinesValues (elems zs) $- plot_lines_title ^= name $- defaultPlotLines- return (ps, drop (length hs) plotLineTails) - (leftPs, plotLineTails) <- plots leftHs leftYInput (tails plotLines)- (rightPs, plotLineTails) <- plots rightHs rightYInput plotLineTails- let leftPs' = map Left leftPs- rightPs' = map Right rightPs- ps' = leftPs' ++ rightPs'- 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)
aivika-experiment-chart.cabal view
@@ -1,5 +1,5 @@ name: aivika-experiment-chart-version: 0.4+version: 1.0 synopsis: Simulation experiments with charting for the Aivika library description: This package complements the Aivika and Aivika Experiment packages with@@ -12,7 +12,7 @@ category: Simulation license: BSD3 license-file: LICENSE-copyright: (c) 2012-2013. David Sorokin <david.sorokin@gmail.com>+copyright: (c) 2012-2014. David Sorokin <david.sorokin@gmail.com> author: David Sorokin maintainer: David Sorokin <david.sorokin@gmail.com> homepage: http://github.com/dsorokin/aivika-experiment-chart@@ -31,24 +31,27 @@ 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+ exposed-modules: Simulation.Aivika.Experiment.Chart+ Simulation.Aivika.Experiment.Chart.TimeSeriesView+ Simulation.Aivika.Experiment.Chart.XYChartView+ Simulation.Aivika.Experiment.Chart.FinalXYChartView+ Simulation.Aivika.Experiment.Chart.DeviationChartView+ Simulation.Aivika.Experiment.Chart.HistogramView+ Simulation.Aivika.Experiment.Chart.FinalHistogramView+ Simulation.Aivika.Experiment.Chart.Utils build-depends: base >= 3 && < 6, mtl >= 1.1.0.2, array >= 0.3.0.0, containers >= 0.4.0.0, filepath >= 1.3.0.0,- Chart >= 0.16,+ Chart >= 1.2,+ Chart-cairo >= 1.2, split >= 0.2.2,- data-accessor >= 0.2.2.3,+ lens >= 3.9,+ data-default-class < 0.1, colour >= 2.3.3,- aivika >= 0.7,- aivika-experiment >= 0.4+ aivika >= 1.0,+ aivika-experiment >= 1.0 ghc-options: -O2
examples/BassDiffusion.hs view
@@ -4,17 +4,9 @@ import Control.Monad import Control.Monad.Trans -import Simulation.Aivika.Specs-import Simulation.Aivika.Simulation-import Simulation.Aivika.Event-import Simulation.Aivika.Dynamics-import Simulation.Aivika.Agent-import Simulation.Aivika.Ref-+import Simulation.Aivika import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.DeviationChartView-import Simulation.Aivika.Experiment.TimeSeriesView-import Simulation.Aivika.Experiment.ExperimentSpecsView+import Simulation.Aivika.Experiment.Chart n = 100 -- the number of agents @@ -25,7 +17,8 @@ specs = Specs { spcStartTime = 0.0, spcStopTime = 8.0, spcDT = 0.1,- spcMethod = RungeKutta4 }+ spcMethod = RungeKutta4,+ spcGeneratorType = SimpleGenerator } experiment :: Experiment experiment =@@ -40,7 +33,8 @@ Left "adopters"] }, outputView $ defaultTimeSeriesView { timeSeries = [Left "potentialAdopters", - Left "adopters"] } ] }+ Left "adopters"] } ]+ } exprnd :: Double -> IO Double exprnd lambda =@@ -80,7 +74,7 @@ t <- liftIO $ exprnd advertisingEffectiveness let st = personPotentialAdopter p st' = personAdopter p- addTimeout st t $ activateState st'+ addTimeout st t $ selectState st' setStateActivation (personAdopter p) $ do modifyRef adopters $ \a -> a + 1 -- add a timer that works while the state is active@@ -88,10 +82,10 @@ addTimer (personAdopter p) t $ do i <- liftIO $ getStdRandom $ randomR (1, n) let p' = ps ! i- st <- agentState (personAgent p')+ st <- selectedState (personAgent p') when (st == Just (personPotentialAdopter p')) $ do b <- liftIO $ boolrnd adoptionFraction- when b $ activateState (personAdopter p')+ when b $ selectState (personAdopter p') setStateDeactivation (personPotentialAdopter p) $ modifyRef potentialAdopters $ \a -> a - 1 setStateDeactivation (personAdopter p) $@@ -103,7 +97,7 @@ definePerson p ps potentialAdopters adopters activatePerson :: Person -> Event ()-activatePerson p = activateState (personPotentialAdopter p)+activatePerson p = selectState (personPotentialAdopter p) activatePersons :: Array Int Person -> Event () activatePersons ps =
examples/ChemicalReaction.hs view
@@ -1,22 +1,16 @@ {-# LANGUAGE RecursiveDo #-} -import Simulation.Aivika.Specs-import Simulation.Aivika.Simulation-import Simulation.Aivika.Dynamics+import Simulation.Aivika import Simulation.Aivika.SystemDynamics- import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.LastValueView-import Simulation.Aivika.Experiment.TableView-import Simulation.Aivika.Experiment.TimeSeriesView-import Simulation.Aivika.Experiment.XYChartView-import Simulation.Aivika.Experiment.ExperimentSpecsView+import Simulation.Aivika.Experiment.Chart specs = Specs { spcStartTime = 0, spcStopTime = 13, spcDT = 0.01,- spcMethod = RungeKutta4 }+ spcMethod = RungeKutta4,+ spcGeneratorType = SimpleGenerator } experiment :: Experiment experiment =
examples/DifferenceEquations.hs view
@@ -1,22 +1,16 @@ {-# LANGUAGE RecursiveDo #-} -import Simulation.Aivika.Specs-import Simulation.Aivika.Simulation-import Simulation.Aivika.Dynamics-import Simulation.Aivika.Dynamics.Random+import Simulation.Aivika import Simulation.Aivika.SystemDynamics- import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.TableView-import Simulation.Aivika.Experiment.TimeSeriesView-import Simulation.Aivika.Experiment.ExperimentSpecsView-import Simulation.Aivika.Experiment.TimingStatsView+import Simulation.Aivika.Experiment.Chart specs = Specs { spcStartTime = 0, spcStopTime = 10000, spcDT = 1,- spcMethod = RungeKutta4 }+ spcMethod = RungeKutta4,+ spcGeneratorType = SimpleGenerator } experiment :: Experiment experiment =@@ -45,13 +39,13 @@ model :: Simulation ExperimentData model =- mdo x <- newNormalDynamics 3 0.8- sumX <- sumDynamics x 0- sumX2 <- sumDynamics (x * x) 0+ mdo x <- memoRandomNormalDynamics 3 0.8+ sumX <- diffsum x 0+ sumX2 <- diffsum (x * x) 0 -- it would be much more efficient to say: -- let n = fmap fromIntegral integIteration- n <- sumDynamics 1 0+ n <- diffsum 1 0 let avg = ifDynamics (n .>. 0) (sumX / n) 0 let std = ifDynamics (n .>. 1) (sqrt ((sumX2 - sumX * avg) / (n - 1))) 0
examples/Financial.hs view
@@ -19,40 +19,27 @@ import Control.Monad --- from package aivika-import Simulation.Aivika.Specs-import Simulation.Aivika.Simulation-import Simulation.Aivika.Dynamics+import Simulation.Aivika import Simulation.Aivika.SystemDynamics-import Simulation.Aivika.Parameter.Random---- from package aivika-experiment import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.ExperimentSpecsView-import Simulation.Aivika.Experiment.TableView-import Simulation.Aivika.Experiment.FinalStatsView---- from package aivika-experiment-chart-import Simulation.Aivika.Experiment.DeviationChartView-import Simulation.Aivika.Experiment.FinalHistogramView-import Simulation.Aivika.Experiment.TimeSeriesView+import Simulation.Aivika.Experiment.Chart -- | The model parameters. data Parameters =- Parameters { paramsTaxDepreciationTime :: Simulation Double,- paramsTaxRate :: Simulation Double,- paramsAveragePayableDelay :: Simulation Double,- paramsBillingProcessingTime :: Simulation Double,- paramsBuildingTime :: Simulation Double,- paramsDebtFinancingFraction :: Simulation Double,- paramsDebtRetirementTime :: Simulation Double,- paramsDiscountRate :: Simulation Double,- paramsFractionalLossRate :: Simulation Double,- paramsInterestRate :: Simulation Double,- paramsPrice :: Simulation Double,- paramsProductionCapacity :: Simulation Double,- paramsRequiredInvestment :: Simulation Double,- paramsVariableProductionCost :: Simulation Double }+ Parameters { paramsTaxDepreciationTime :: Parameter Double,+ paramsTaxRate :: Parameter Double,+ paramsAveragePayableDelay :: Parameter Double,+ paramsBillingProcessingTime :: Parameter Double,+ paramsBuildingTime :: Parameter Double,+ paramsDebtFinancingFraction :: Parameter Double,+ paramsDebtRetirementTime :: Parameter Double,+ paramsDiscountRate :: Parameter Double,+ paramsFractionalLossRate :: Parameter Double,+ paramsInterestRate :: Parameter Double,+ paramsPrice :: Parameter Double,+ paramsProductionCapacity :: Parameter Double,+ paramsRequiredInvestment :: Parameter Double,+ paramsVariableProductionCost :: Parameter Double } -- | The default model parameters. defaultParams :: Parameters@@ -75,15 +62,15 @@ -- | Random parameters for the Monte-Carlo simulation. randomParams :: IO Parameters randomParams =- do averagePayableDelay <- newRandomParameter 0.07 0.11- billingProcessingTime <- newRandomParameter 0.03 0.05- buildingTime <- newRandomParameter 0.8 1.2- fractionalLossRate <- newRandomParameter 0.05 0.08- interestRate <- newRandomParameter 0.09 0.15- price <- newRandomParameter 0.9 1.2- productionCapacity <- newRandomParameter 2200 2600- requiredInvestment <- newRandomParameter 1800 2200- variableProductionCost <- newRandomParameter 0.5 0.7+ do averagePayableDelay <- memoParameter $ randomUniform 0.07 0.11+ billingProcessingTime <- memoParameter $ randomUniform 0.03 0.05+ buildingTime <- memoParameter $ randomUniform 0.8 1.2+ fractionalLossRate <- memoParameter $ randomUniform 0.05 0.08+ interestRate <- memoParameter $ randomUniform 0.09 0.15+ price <- memoParameter $ randomUniform 0.9 1.2+ productionCapacity <- memoParameter $ randomUniform 2200 2600+ requiredInvestment <- memoParameter $ randomUniform 1800 2200+ variableProductionCost <- memoParameter $ randomUniform 0.5 0.7 return defaultParams { paramsAveragePayableDelay = averagePayableDelay, paramsBillingProcessingTime = billingProcessingTime, paramsBuildingTime = buildingTime,@@ -97,8 +84,7 @@ -- | This is the model itself that returns experimental data. model :: Parameters -> Simulation ExperimentData model params =- mdo let liftParam :: (Parameters -> Simulation a) -> Dynamics a- liftParam f = liftSimulation $ f params+ mdo let getParameter f = liftParameter $ f params -- the equations below are given in an arbitrary order! @@ -109,30 +95,28 @@ production = availableCapacity availableCapacity = ifDynamics (time .>=. buildingTime) productionCapacity 0- taxDepreciationTime = liftParam paramsTaxDepreciationTime- taxRate = liftParam paramsTaxRate+ taxDepreciationTime = getParameter paramsTaxDepreciationTime+ taxRate = getParameter paramsTaxRate accountsReceivable <- integ (billings - cashReceipts - losses) (billings / (1 / averagePayableDelay + fractionalLossRate))- let averagePayableDelay =- liftParam paramsAveragePayableDelay+ let averagePayableDelay = getParameter paramsAveragePayableDelay awaitingBilling <- integ (price * production - billings) (price * production * billingProcessingTime)- let billingProcessingTime =- liftParam paramsBillingProcessingTime+ let billingProcessingTime = getParameter paramsBillingProcessingTime billings = awaitingBilling / billingProcessingTime borrowing = newInvestment * debtFinancingFraction- buildingTime = liftParam paramsBuildingTime+ buildingTime = getParameter paramsBuildingTime cashReceipts = accountsReceivable / averagePayableDelay debt <- integ (borrowing - principalRepayment) 0- let debtFinancingFraction = liftParam paramsDebtFinancingFraction- debtRetirementTime = liftParam paramsDebtRetirementTime+ let debtFinancingFraction = getParameter paramsDebtFinancingFraction+ debtRetirementTime = getParameter paramsDebtRetirementTime directCosts = production * variableProductionCost- discountRate = liftParam paramsDiscountRate- fractionalLossRate = liftParam paramsFractionalLossRate+ discountRate = getParameter paramsDiscountRate+ fractionalLossRate = getParameter paramsFractionalLossRate grossIncome = billings interestPayments = debt * interestRate- interestRate = liftParam paramsInterestRate+ interestRate = getParameter paramsInterestRate losses = accountsReceivable * fractionalLossRate netCashFlow = cashReceipts + borrowing - newInvestment - directCosts - interestPayments@@ -142,12 +126,12 @@ 0 (requiredInvestment / buildingTime) npvCashFlow <- npv netCashFlow discountRate 0 1 npvIncome <- npv netIncome discountRate 0 1- let price = liftParam paramsPrice+ let price = getParameter paramsPrice principalRepayment = debt / debtRetirementTime- productionCapacity = liftParam paramsProductionCapacity- requiredInvestment = liftParam paramsRequiredInvestment+ productionCapacity = getParameter paramsProductionCapacity+ requiredInvestment = getParameter paramsRequiredInvestment taxes = taxableIncome * taxRate- variableProductionCost = liftParam paramsVariableProductionCost+ variableProductionCost = getParameter paramsVariableProductionCost experimentDataInStartTime [(netIncomeName, seriesEntity "Net income" netIncome),@@ -162,7 +146,7 @@ npvCashFlowName = "npvCashFlow" -- the simulation specs-specs = Specs 0 5 0.015625 RungeKutta4+specs = Specs 0 5 0.015625 RungeKutta4 SimpleGenerator -- | The experiment for the Monte-Carlo simulation. monteCarloExperiment :: Experiment
examples/Furnace.hs view
@@ -37,72 +37,51 @@ import Control.Monad import Control.Monad.Trans -import Simulation.Aivika.Specs-import Simulation.Aivika.Simulation-import Simulation.Aivika.Dynamics-import Simulation.Aivika.Event-import Simulation.Aivika.Ref-import Simulation.Aivika.Process-import Simulation.Aivika.Random+import Simulation.Aivika+import Simulation.Aivika.Queue.Infinite import qualified Simulation.Aivika.DoubleLinkedList as DLL import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.ExperimentSpecsView-import Simulation.Aivika.Experiment.FinalStatsView-import Simulation.Aivika.Experiment.DeviationChartView-import Simulation.Aivika.Experiment.FinalHistogramView+import Simulation.Aivika.Experiment.Chart -- | The simulation specs. specs = Specs { spcStartTime = 0.0, spcStopTime = 1000.0, -- spcStopTime = 300.0, spcDT = 0.1,- spcMethod = RungeKutta4 }+ spcMethod = RungeKutta4,+ spcGeneratorType = SimpleGenerator } --- | Return an exponentially distributed random value with mean --- 1 / @lambda@, where @lambda@ is a parameter of the function.-exprnd :: Double -> IO Double-exprnd lambda =- do x <- getStdRandom random- return (- log x / lambda)- -- | Return a random initial temperature of the item. -temprnd :: IO Double-temprnd =- do x <- getStdRandom random- return (400.0 + (600.0 - 400.0) * x)+randomTemp :: Parameter Double+randomTemp = randomUniform 400 600 -- | Represents the furnace. data Furnace = - Furnace { furnaceNormalGen :: IO Double,- -- ^ The normal random number generator.- furnacePits :: [Pit],+ Furnace { furnacePits :: [Pit], -- ^ The pits for ingots. furnacePitCount :: Ref Int, -- ^ The count of active pits with ingots.- furnaceAwaitingIngots :: DLL.DoubleLinkedList Ingot,- -- ^ The awaiting ingots in the queue.- furnaceQueueCount :: Ref Int,- -- ^ The queue count.- furnaceWaitCount :: Ref Int,- -- ^ The count of awaiting ingots.- furnaceWaitTime :: Ref Double,- -- ^ The wait time for all loaded ingots.- furnaceHeatingTime :: Ref Double,- -- ^ The heating time for all unloaded ingots.+ furnaceQueue :: FCFSQueue Ingot,+ -- ^ The furnace queue.+ furnaceUnloadedSource :: SignalSource (),+ -- ^ Notifies when the ingots have been+ -- unloaded from the furnace.+ furnaceHeatingTime :: Ref (SamplingStats Double),+ -- ^ The heating time for the ready ingots. furnaceTemp :: Ref Double, -- ^ The furnace temperature.- furnaceTotalCount :: Ref Int,- -- ^ The total count of ingots.- furnaceLoadCount :: Ref Int,- -- ^ The count of loaded ingots.- furnaceUnloadCount :: Ref Int,- -- ^ The count of unloaded ingots.- furnaceUnloadTemps :: Ref [Double]- -- ^ The temperatures of all unloaded ingots.+ furnaceReadyCount :: Ref Int,+ -- ^ The count of ready ingots.+ furnaceReadyTemps :: Ref [Double]+ -- ^ The temperatures of all ready ingots. } +-- | Notifies when the ingots have been unloaded from the furnace.+furnaceUnloaded :: Furnace -> Signal ()+furnaceUnloaded = publishSignal . furnaceUnloadedSource+ -- | A pit in the furnace to place the ingots. data Pit = Pit { pitIngot :: Ref (Maybe Ingot),@@ -129,32 +108,22 @@ -- | Create a furnace. newFurnace :: Simulation Furnace newFurnace =- do normalGen <- liftIO newNormalGen- pits <- sequence [newPit | i <- [1..10]]+ do pits <- sequence [newPit | i <- [1..10]] pitCount <- newRef 0- awaitingIngots <- liftIO DLL.newList- queueCount <- newRef 0- waitCount <- newRef 0- waitTime <- newRef 0.0- heatingTime <- newRef 0.0+ queue <- newFCFSQueue+ heatingTime <- newRef emptySamplingStats h <- newRef 1650.0- totalCount <- newRef 0- loadCount <- newRef 0- unloadCount <- newRef 0- unloadTemps <- newRef []- return Furnace { furnaceNormalGen = normalGen,- furnacePits = pits,+ readyCount <- newRef 0+ readyTemps <- newRef []+ s <- newSignalSource+ return Furnace { furnacePits = pits, furnacePitCount = pitCount,- furnaceAwaitingIngots = awaitingIngots,- furnaceQueueCount = queueCount,- furnaceWaitCount = waitCount,- furnaceWaitTime = waitTime,+ furnaceQueue = queue,+ furnaceUnloadedSource = s, furnaceHeatingTime = heatingTime, furnaceTemp = h,- furnaceTotalCount = totalCount,- furnaceLoadCount = loadCount, - furnaceUnloadCount = unloadCount, - furnaceUnloadTemps = unloadTemps }+ furnaceReadyCount = readyCount, + furnaceReadyTemps = readyTemps } -- | Create a new pit. newPit :: Simulation Pit@@ -168,9 +137,9 @@ newIngot :: Furnace -> Event Ingot newIngot furnace = do t <- liftDynamics time- xi <- liftIO $ furnaceNormalGen furnace- h' <- liftIO temprnd- let c = 0.1 + (0.05 + xi * 0.01)+ xi <- liftParameter $ randomNormal 0.05 0.01+ h' <- liftParameter randomTemp+ let c = 0.1 + xi return Ingot { ingotFurnace = furnace, ingotReceiveTime = t, ingotReceiveTemp = h',@@ -189,7 +158,7 @@ -- update the temperature of the ingot. let furnace = ingotFurnace ingot- dt' <- liftDynamics dt+ dt' <- liftParameter dt h' <- readRef (pitTemp pit) h <- readRef (furnaceTemp furnace) writeRef (pitTemp pit) $ @@ -208,84 +177,73 @@ do h' <- readRef (pitTemp pit) when (h' >= 2000.0) $ do Just ingot <- readRef (pitIngot pit) - unloadIngot ingot pit+ unloadIngot furnace ingot pit -- | Try to load an awaiting ingot in the specified empty pit. tryLoadPit :: Furnace -> Pit -> Event () tryLoadPit furnace pit =- do let ingots = furnaceAwaitingIngots furnace- flag <- liftIO $ DLL.listNull ingots- unless flag $- do ingot <- liftIO $ DLL.listFirst ingots- liftIO $ DLL.listRemoveFirst ingots- t' <- liftDynamics time- modifyRef (furnaceQueueCount furnace) (+ (-1))- loadIngot (ingot { ingotLoadTime = t',- ingotLoadTemp = 400.0 }) pit+ do ingot <- tryDequeue (furnaceQueue furnace)+ case ingot of+ Nothing ->+ return ()+ Just ingot ->+ do t' <- liftDynamics time+ loadIngot furnace (ingot { ingotLoadTime = t',+ ingotLoadTemp = 400.0 }) pit -- | Unload the ingot from the specified pit. -unloadIngot :: Ingot -> Pit -> Event ()-unloadIngot ingot pit = +unloadIngot :: Furnace -> Ingot -> Pit -> Event ()+unloadIngot furnace ingot pit = do h' <- readRef (pitTemp pit) writeRef (pitIngot pit) Nothing writeRef (pitTemp pit) 0.0- + -- count the active pits- let furnace = ingotFurnace ingot- count <- readRef (furnacePitCount furnace)- writeRef (furnacePitCount furnace) (count - 1)+ modifyRef (furnacePitCount furnace) (+ (- 1)) -- how long did we heat the ingot up? t' <- liftDynamics time- modifyRef (furnaceHeatingTime furnace)- (+ (t' - ingotLoadTime ingot))+ modifyRef (furnaceHeatingTime furnace) $+ addSamplingStats (t' - ingotLoadTime ingot) -- what is the temperature of the unloaded ingot?- modifyRef (furnaceUnloadTemps furnace) (h' :)+ modifyRef (furnaceReadyTemps furnace) (h' :) - -- count the unloaded ingots- modifyRef (furnaceUnloadCount furnace) (+ 1)+ -- count the ready ingots+ modifyRef (furnaceReadyCount furnace) (+ 1) -- | Load the ingot in the specified pit-loadIngot :: Ingot -> Pit -> Event ()-loadIngot ingot pit =+loadIngot :: Furnace -> Ingot -> Pit -> Event ()+loadIngot furnace ingot pit = do writeRef (pitIngot pit) $ Just ingot writeRef (pitTemp pit) $ ingotLoadTemp ingot- + -- count the active pits- let furnace = ingotFurnace ingot+ modifyRef (furnacePitCount furnace) (+ 1) count <- readRef (furnacePitCount furnace)- writeRef (furnacePitCount furnace) (count + 1) -- decrease the furnace temperature h <- readRef (furnaceTemp furnace) let h' = ingotLoadTemp ingot- dh = - (h - h') / fromInteger (toInteger (count + 1))+ dh = - (h - h') / fromIntegral count writeRef (furnaceTemp furnace) $ h + dh-- -- how long did we keep the ingot in the queue?- t' <- liftDynamics time- modifyRef (furnaceWaitCount furnace) (+ 1) - modifyRef (furnaceWaitTime furnace)- (+ (t' - ingotReceiveTime ingot))-- -- count the loaded ingots- modifyRef (furnaceLoadCount furnace) (+ 1)- + -- | Start iterating the furnace processing through the event queue. startIteratingFurnace :: Furnace -> Event () startIteratingFurnace furnace = let pits = furnacePits furnace in enqueueEventWithIntegTimes $- do ready <- ingotsReady furnace+ do -- try to unload ready ingots+ ready <- ingotsReady furnace when ready $ do mapM_ (tryUnloadPit furnace) pits- pits' <- emptyPits furnace- mapM_ (tryLoadPit furnace) pits'+ triggerSignal (furnaceUnloadedSource furnace) ()++ -- heat up mapM_ heatPitUp pits -- update the temperature of the furnace- dt' <- liftDynamics dt+ dt' <- liftParameter dt h <- readRef (furnaceTemp furnace) writeRef (furnaceTemp furnace) $ h + dt' * (2600.0 - h) * 0.2@@ -296,32 +254,37 @@ filterM (fmap isNothing . readRef . pitIngot) $ furnacePits furnace --- | Accept a new ingot.-acceptIngot :: Furnace -> Event ()-acceptIngot furnace =- do ingot <- newIngot furnace- - -- counting- modifyRef (furnaceTotalCount furnace) (+ 1)- - -- check what to do with the new ingot- count <- readRef (furnacePitCount furnace)- if count >= 10- then do let ingots = furnaceAwaitingIngots furnace- liftIO $ DLL.listAddLast ingots ingot- modifyRef (furnaceQueueCount furnace) (+ 1)- else do pit:_ <- emptyPits furnace- loadIngot ingot pit- --- | Process the furnace.-processFurnace :: Furnace -> Process ()-processFurnace furnace =- do delay <- liftIO $ exprnd (1.0 / 2.5)+-- | This process takes ingots from the queue and then+-- loads them in the furnace.+loadingProcess :: Furnace -> Process ()+loadingProcess furnace =+ do ingot <- dequeue (furnaceQueue furnace)+ let wait :: Process ()+ wait =+ do count <- liftEvent $ readRef (furnacePitCount furnace)+ when (count >= 10) $+ do processAwait (furnaceUnloaded furnace)+ wait+ wait+ -- take any empty pit and load it+ liftEvent $+ do pit: _ <- emptyPits furnace+ loadIngot furnace ingot pit+ -- repeat it again+ loadingProcess furnace+ +-- | The input process that adds new ingots to the queue.+inputProcess :: Furnace -> Process ()+inputProcess furnace =+ do delay <- liftParameter $+ randomExponential 2.5 holdProcess delay -- we have got a new ingot- liftEvent $ acceptIngot furnace+ liftEvent $+ do ingot <- newIngot furnace+ enqueue (furnaceQueue furnace) ingot -- repeat it again- processFurnace furnace+ inputProcess furnace -- | Initialize the furnace. initializeFurnace :: Furnace -> Event ()@@ -334,64 +297,48 @@ x6 <- newIngot furnace let p1 : p2 : p3 : p4 : p5 : p6 : ps = furnacePits furnace- loadIngot (x1 { ingotLoadTemp = 550.0 }) p1- loadIngot (x2 { ingotLoadTemp = 600.0 }) p2- loadIngot (x3 { ingotLoadTemp = 650.0 }) p3- loadIngot (x4 { ingotLoadTemp = 700.0 }) p4- loadIngot (x5 { ingotLoadTemp = 750.0 }) p5- loadIngot (x6 { ingotLoadTemp = 800.0 }) p6- writeRef (furnaceTotalCount furnace) 6+ loadIngot furnace (x1 { ingotLoadTemp = 550.0 }) p1+ loadIngot furnace (x2 { ingotLoadTemp = 600.0 }) p2+ loadIngot furnace (x3 { ingotLoadTemp = 650.0 }) p3+ loadIngot furnace (x4 { ingotLoadTemp = 700.0 }) p4+ loadIngot furnace (x5 { ingotLoadTemp = 750.0 }) p5+ loadIngot furnace (x6 { ingotLoadTemp = 800.0 }) p6 writeRef (furnaceTemp furnace) 1650.0 -- | The simulation model that returns experimental data. model :: Simulation ExperimentData model = do furnace <- newFurnace- pid <- newProcessId-+ -- initialize the furnace and start its iterating in start time runEventInStartTime IncludingCurrentEvents $ do initializeFurnace furnace startIteratingFurnace furnace - -- accept input ingots- runProcessInStartTime IncludingCurrentEvents- pid (processFurnace furnace)+ -- generate randomly new input ingots+ runProcessInStartTime IncludingCurrentEvents $+ inputProcess furnace - -- the mean wait time in the queue- let meanWaitTime :: Event Double- meanWaitTime =- do waitTime <- readRef (furnaceWaitTime furnace)- waitCount <- readRef (furnaceWaitCount furnace)- return $ waitTime / fromIntegral waitCount- - -- the mean heating time- let meanHeatingTime :: Event Double- meanHeatingTime =- do heatingTime <- readRef (furnaceHeatingTime furnace)- unloadCount <- readRef (furnaceUnloadCount furnace)- return $ heatingTime / fromIntegral unloadCount+ -- load permanently the input ingots in the furnace+ runProcessInStartTime IncludingCurrentEvents $+ loadingProcess furnace experimentDataInStartTime [(totalIngotCountName, seriesEntity "total ingot count" $- furnaceTotalCount furnace),+ queueStoreCount (furnaceQueue furnace)), (loadedIngotCountName,- seriesEntity "loaded ingot count" $- furnaceLoadCount furnace),+ seriesEntity "loaded ingot count" $ -- actually, +/- 1+ queueOutputCount (furnaceQueue furnace)), (readyIngotCountName, seriesEntity "ready ingot count" $- furnaceUnloadCount furnace),-- (awaitedIngotCountName,- seriesEntity "awaited in the queue ingot count" $- furnaceWaitCount furnace),+ furnaceReadyCount furnace), (readyIngotTempsName, seriesEntity "the temperature of ready ingot" $- furnaceUnloadTemps furnace),+ furnaceReadyTemps furnace), (pitCountName, seriesEntity "the used pit count" $@@ -399,15 +346,15 @@ (queueCountName, seriesEntity "the queue size" $- furnaceQueueCount furnace),+ queueCount (furnaceQueue furnace)), (meanWaitTimeName,- seriesEntity "the mean wait time"- meanWaitTime),+ seriesEntity "the mean wait time" $+ queueWaitTime (furnaceQueue furnace)), (meanHeatingTimeName,- seriesEntity "the mean heating time"- meanHeatingTime) ]+ seriesEntity "the mean heating time" $+ furnaceHeatingTime furnace) ] totalIngotCountName = "totalIngotCount" loadedIngotCountName = "loadedIngotCount"@@ -431,39 +378,27 @@ [outputView defaultExperimentSpecsView, outputView $ defaultDeviationChartView {- deviationChartTitle = "Deviation Chart - 1.1",+ deviationChartTitle = "Deviation Chart - 1", deviationChartPlotTitle = "The total, loaded and ready ingot counts", deviationChartSeries = [Right totalIngotCountName, Right loadedIngotCountName, Right readyIngotCountName] }, - outputView $ defaultDeviationChartView {- deviationChartTitle = "Deviation Chart - 1.2",- deviationChartPlotTitle = "The awaited in the queue ingot count",- deviationChartSeries = [Right awaitedIngotCountName] },- outputView $ defaultFinalHistogramView {- finalHistogramTitle = "Final Histogram - 1.1",+ finalHistogramTitle = "Final Histogram - 1", finalHistogramPlotTitle = "The distribution of total, loaded and ready " ++ "ingot counts in the final time point.", finalHistogramSeries = [totalIngotCountName, loadedIngotCountName, readyIngotCountName] }, - outputView $ defaultFinalHistogramView {- finalHistogramTitle = "Final Histogram - 1.2",- finalHistogramPlotTitle = "The distribution of the awaited in the queue " ++- "ingot count in the final time point.",- finalHistogramSeries = [awaitedIngotCountName] },- outputView $ defaultFinalStatsView { finalStatsTitle = "Final Statistics - 1",- finalStatsDescription = "The summary of total, loaded, ready and awaited in " ++- "the queue ingot counts in the final time point.",+ finalStatsDescription = "The summary of total, loaded and ready " +++ "ingot counts in the final time point.", finalStatsSeries = [totalIngotCountName, loadedIngotCountName,- readyIngotCountName,- awaitedIngotCountName] },+ readyIngotCountName] }, outputView $ defaultDeviationChartView { deviationChartTitle = "Deviation Chart - 2",@@ -472,8 +407,7 @@ outputView $ defaultFinalHistogramView { finalHistogramTitle = "Final Histogram - 2",- finalHistogramPlotTitle = "The distribution of the used pit count " ++- "in the final simulation time point.",+ finalHistogramPlotTitle = "The used pit count in the final time point.", finalHistogramSeries = [pitCountName] }, outputView $ defaultFinalStatsView {@@ -488,8 +422,7 @@ outputView $ defaultFinalHistogramView { finalHistogramTitle = "Final Histogram - 3",- finalHistogramPlotTitle = "The distribution of the queue size " ++- "in the final simulation time point.",+ finalHistogramPlotTitle = "The queue size in the final time point.", finalHistogramSeries = [queueCountName] }, outputView $ defaultFinalStatsView {@@ -502,16 +435,10 @@ deviationChartPlotTitle = "The mean wait time", deviationChartSeries = [Right meanWaitTimeName] }, - outputView $ defaultFinalHistogramView {- finalHistogramTitle = "Final Histogram - 4",- finalHistogramPlotTitle = "The distribution of the mean wait time " ++- "in the final simulation time point.",- finalHistogramSeries = [meanWaitTimeName] },- outputView $ defaultFinalStatsView { finalStatsTitle = "Final Statistics - 4", finalStatsDescription = "The summary of the mean wait time in " ++- "the final simulation time point.",+ "the final time point.", finalStatsSeries = [meanWaitTimeName] }, outputView $ defaultDeviationChartView {@@ -519,16 +446,10 @@ deviationChartPlotTitle = "The mean heating time", deviationChartSeries = [Right meanHeatingTimeName] }, - outputView $ defaultFinalHistogramView {- finalHistogramTitle = "Final Histogram - 5",- finalHistogramPlotTitle = "The distribution of the mean heating time " ++- "in the final simulation time point.",- finalHistogramSeries = [meanHeatingTimeName] },- outputView $ defaultFinalStatsView { finalStatsTitle = "Final Statistics - 5", finalStatsDescription = "The summary of the mean heating time in " ++- "the final simulation time point.",+ "the final time point.", finalStatsSeries = [meanHeatingTimeName] }, outputView $ defaultDeviationChartView {@@ -538,14 +459,14 @@ outputView $ defaultFinalHistogramView { finalHistogramTitle = "Final Histogram - 6",- finalHistogramPlotTitle = "The distribution of the ready ingot temperature " ++- "in the final simulation time point.",+ finalHistogramPlotTitle = "The ready ingot temperature in " +++ "the final time point.", finalHistogramSeries = [readyIngotTempsName] }, outputView $ defaultFinalStatsView { finalStatsTitle = "Final Statistics - 6", finalStatsDescription = "The summary of the ready ingot temperature in " ++- "the final simulation time point.",+ "the final time point.", finalStatsSeries = [readyIngotTempsName] } ] }
examples/LinearArray.hs view
@@ -14,26 +14,16 @@ import qualified Data.Vector as V -import Simulation.Aivika.Specs-import Simulation.Aivika.Simulation-import Simulation.Aivika.Dynamics+import Simulation.Aivika import Simulation.Aivika.SystemDynamics- import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.TableView-import Simulation.Aivika.Experiment.ExperimentSpecsView--import Simulation.Aivika.Experiment.TimeSeriesView-import Simulation.Aivika.Experiment.DeviationChartView-import Simulation.Aivika.Experiment.FinalHistogramView-import Simulation.Aivika.Experiment.FinalXYChartView-import Simulation.Aivika.Experiment.HistogramView-import Simulation.Aivika.Experiment.XYChartView+import Simulation.Aivika.Experiment.Chart specs = Specs { spcStartTime = 0, spcStopTime = 500, spcDT = 0.1,- spcMethod = RungeKutta4 }+ spcMethod = RungeKutta4,+ spcGeneratorType = SimpleGenerator } -- | This is an analog of 'V.generateM' included in the Haskell platform. generateArray :: (Ix i, Monad m) => (i, i) -> (i -> m a) -> m (Array i a)
examples/MachRep3.hs view
@@ -17,30 +17,18 @@ import Control.Monad import Control.Monad.Trans -import Simulation.Aivika.Specs-import Simulation.Aivika.Simulation-import Simulation.Aivika.Dynamics-import Simulation.Aivika.Event-import Simulation.Aivika.Ref-import Simulation.Aivika.QueueStrategy-import Simulation.Aivika.Resource-import Simulation.Aivika.Process-+import Simulation.Aivika 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-import Simulation.Aivika.Experiment.ExperimentSpecsView-import Simulation.Aivika.Experiment.FinalStatsView+import Simulation.Aivika.Experiment.Chart +meanUpTime = 1.0+meanRepairTime = 0.5+ specs = Specs { spcStartTime = 0.0, spcStopTime = 1000.0, spcDT = 1.0,- spcMethod = RungeKutta4 }+ spcMethod = RungeKutta4,+ spcGeneratorType = SimpleGenerator } experiment :: Experiment experiment =@@ -57,7 +45,7 @@ finalXYChartXSeries = Just "n", finalXYChartYSeries = [Right "x"], finalXYChartPredicate =- do i <- liftSimulation simulationIndex+ do i <- liftParameter simulationIndex return $ (i < 50) || (i > 100) }, outputView $ defaultFinalHistogramView { finalHistogramPlotTitle = "Final Histogram (Default)",@@ -95,14 +83,6 @@ 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--exprnd :: Double -> IO Double-exprnd lambda =- do x <- getStdRandom random- return (- log x / lambda)- model :: Simulation ExperimentData model = do -- number of machines currently up@@ -118,14 +98,15 @@ let machine :: ProcessId -> Process () machine pid =- do startUpTime <- liftDynamics time- upTime <- liftIO $ exprnd upRate+ do upTime <-+ liftParameter $+ randomExponential meanUpTime holdProcess upTime- finishUpTime <- liftDynamics time- liftEvent $ modifyRef totalUpTime - (+ (finishUpTime - startUpTime))- - liftEvent $ modifyRef nUp $ \a -> a - 1+ liftEvent $+ modifyRef totalUpTime (+ upTime) + + liftEvent $+ modifyRef nUp (+ (-1)) nUp' <- liftEvent $ readRef nUp if nUp' == 1 then passivateProcess@@ -135,17 +116,20 @@ reactivateProcess pid requestResource repairPerson- repairTime <- liftIO $ exprnd repairRate+ repairTime <-+ liftParameter $+ randomExponential meanRepairTime holdProcess repairTime- liftEvent $ modifyRef nUp $ \a -> a + 1+ liftEvent $+ modifyRef nUp (+ 1) releaseResource repairPerson machine pid - runProcessInStartTime IncludingCurrentEvents+ runProcessInStartTimeUsingId IncludingCurrentEvents pid1 (machine pid2) - runProcessInStartTime IncludingCurrentEvents+ runProcessInStartTimeUsingId IncludingCurrentEvents pid2 (machine pid1) let result =