aivika-experiment-chart 1.3 → 1.4
raw patch · 42 files changed
+1145/−1097 lines, 42 filesdep ~Chartdep ~aivikadep ~aivika-experiment
Dependency ranges changed: Chart, aivika, aivika-experiment
Files
- Simulation/Aivika/Experiment/Chart.hs +2/−2
- Simulation/Aivika/Experiment/Chart/ChartRenderer.hs +0/−28
- Simulation/Aivika/Experiment/Chart/DeviationChartView.hs +76/−84
- Simulation/Aivika/Experiment/Chart/FinalHistogramView.hs +67/−79
- Simulation/Aivika/Experiment/Chart/FinalXYChartView.hs +99/−104
- Simulation/Aivika/Experiment/Chart/HistogramView.hs +53/−58
- Simulation/Aivika/Experiment/Chart/TimeSeriesView.hs +79/−78
- Simulation/Aivika/Experiment/Chart/Types.hs +28/−0
- Simulation/Aivika/Experiment/Chart/XYChartView.hs +93/−91
- aivika-experiment-chart.cabal +6/−6
- examples/BassDiffusion/Experiment.hs +17/−12
- examples/BassDiffusion/MainUsingCairo.hs +2/−2
- examples/BassDiffusion/MainUsingDiagrams.hs +2/−2
- examples/BassDiffusion/Model.hs +9/−8
- examples/ChemicalReaction/Experiment.hs +53/−27
- examples/ChemicalReaction/MainUsingCairo.hs +2/−2
- examples/ChemicalReaction/MainUsingDiagrams.hs +2/−2
- examples/ChemicalReaction/Model.hs +7/−6
- examples/DifferenceEquations/Experiment.hs +30/−19
- examples/DifferenceEquations/MainUsingCairo.hs +2/−2
- examples/DifferenceEquations/MainUsingDiagrams.hs +2/−2
- examples/DifferenceEquations/Model.hs +11/−10
- examples/Financial/Experiment.hs +61/−51
- examples/Financial/MainUsingCairo.hs +7/−3
- examples/Financial/MainUsingDiagrams.hs +7/−3
- examples/Financial/Model.hs +7/−6
- examples/Furnace/Experiment.hs +112/−97
- examples/Furnace/MainUsingCairo.hs +2/−2
- examples/Furnace/MainUsingDiagrams.hs +2/−2
- examples/Furnace/Model.hs +47/−71
- examples/InspectionAdjustmentStations/Experiment.hs +73/−54
- examples/InspectionAdjustmentStations/MainUsingCairo.hs +2/−2
- examples/InspectionAdjustmentStations/MainUsingDiagrams.hs +2/−2
- examples/InspectionAdjustmentStations/Model.hs +38/−72
- examples/LinearArray/Experiment.hs +54/−35
- examples/LinearArray/MainUsingCairo.hs +2/−2
- examples/LinearArray/MainUsingDiagrams.hs +2/−2
- examples/LinearArray/Model.hs +5/−5
- examples/MachRep3/Experiment.hs +62/−53
- examples/MachRep3/MainUsingCairo.hs +2/−2
- examples/MachRep3/MainUsingDiagrams.hs +2/−2
- examples/MachRep3/Model.hs +14/−7
Simulation/Aivika/Experiment/Chart.hs view
@@ -12,7 +12,7 @@ module Simulation.Aivika.Experiment.Chart (-- * Modules- module Simulation.Aivika.Experiment.Chart.ChartRenderer, + module Simulation.Aivika.Experiment.Chart.Types, module Simulation.Aivika.Experiment.Chart.TimeSeriesView, module Simulation.Aivika.Experiment.Chart.XYChartView, module Simulation.Aivika.Experiment.Chart.FinalXYChartView,@@ -21,7 +21,7 @@ module Simulation.Aivika.Experiment.Chart.FinalHistogramView, module Simulation.Aivika.Experiment.Chart.Utils) where -import Simulation.Aivika.Experiment.Chart.ChartRenderer+import Simulation.Aivika.Experiment.Chart.Types import Simulation.Aivika.Experiment.Chart.TimeSeriesView import Simulation.Aivika.Experiment.Chart.XYChartView import Simulation.Aivika.Experiment.Chart.FinalXYChartView
− Simulation/Aivika/Experiment/Chart/ChartRenderer.hs
@@ -1,28 +0,0 @@---- |--- Module : Simulation.Aivika.Experiment.Chart.ChartRenderer--- 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 a type class for rendering charts.-----module Simulation.Aivika.Experiment.Chart.ChartRenderer- (ChartRenderer(..)) where--import Graphics.Rendering.Chart--import Simulation.Aivika.Experiment---- | A type class of chart renderers.-class FileRenderer r => ChartRenderer r where-- -- | The file extension used when rendering.- renderableFileExtension :: r -> String-- -- | Generate an image file for the given chart, at the specified path.- -- The width and height are passed in the second argument to the function.- renderChart :: r -> (Int, Int) -> Renderable a -> FilePath -> IO (PickFn a)
Simulation/Aivika/Experiment/Chart/DeviationChartView.hs view
@@ -7,9 +7,9 @@ -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 ----- The module defines 'DeviationChartView' that creates the deviation chart.+-- The module defines 'DeviationChartView' that plots the deviation chart using rule of 3-sigma. -- module Simulation.Aivika.Experiment.Chart.DeviationChartView@@ -25,6 +25,7 @@ import Data.IORef import Data.Maybe import Data.Either+import Data.Monoid import Data.Array import Data.Array.IO.Safe import Data.Default.Class@@ -34,22 +35,13 @@ import Graphics.Rendering.Chart +import Simulation.Aivika import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.HtmlWriter-import Simulation.Aivika.Experiment.Utils (divideBy, replace)-import Simulation.Aivika.Experiment.Chart.ChartRenderer+import Simulation.Aivika.Experiment.MRef+import Simulation.Aivika.Experiment.Chart.Types 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 creates the deviation chart.+-- | Defines the 'View' that plots the deviation chart. data DeviationChartView = DeviationChartView { deviationChartTitle :: String, -- ^ This is a title used in HTML.@@ -68,9 +60,12 @@ -- @ -- deviationChartFileName = UniqueFilePath \"$TITLE\" -- @- deviationChartSeries :: [Either String String],- -- ^ It contains the labels of data plotted- -- on the chart.+ deviationChartTransform :: ResultTransform,+ -- ^ The transform applied to the results before receiving series.+ deviationChartLeftYSeries :: ResultTransform, + -- ^ It defines the series to be plotted basing on the left Y axis.+ deviationChartRightYSeries :: ResultTransform, + -- ^ It defines the series to be plotted basing on the right Y axis. deviationChartPlotTitle :: String, -- ^ This is a title used in the chart. -- It may include special variable @$TITLE@.@@ -116,34 +111,38 @@ deviationChartWidth = 640, deviationChartHeight = 480, deviationChartFileName = UniqueFilePath "$TITLE",- deviationChartSeries = [], + deviationChartTransform = id,+ deviationChartLeftYSeries = mempty, + deviationChartRightYSeries = mempty, deviationChartPlotTitle = "$TITLE", deviationChartPlotLines = colourisePlotLines, deviationChartPlotFillBetween = colourisePlotFillBetween, deviationChartBottomAxis = id, deviationChartLayout = id } -instance ChartRenderer r => ExperimentView DeviationChartView r where+instance WebPageCharting r => ExperimentView DeviationChartView r WebPageWriter where outputView v = let reporter exp renderer dir = do st <- newDeviationChart v exp renderer dir+ let writer =+ WebPageWriter { reporterWriteTOCHtml = deviationChartTOCHtml st,+ reporterWriteHtml = deviationChartHtml st } return ExperimentReporter { reporterInitialise = return (), reporterFinalise = finaliseDeviationChart st, reporterSimulate = simulateDeviationChart st,- reporterTOCHtml = deviationChartTOCHtml st,- reporterHtml = deviationChartHtml st }+ reporterRequest = writer } in ExperimentGenerator { generateReporter = reporter } -- | The state of the view. data DeviationChartViewState r = DeviationChartViewState { deviationChartView :: DeviationChartView,- deviationChartExperiment :: Experiment r,+ deviationChartExperiment :: Experiment, deviationChartRenderer :: r, deviationChartDir :: FilePath, deviationChartFile :: IORef (Maybe FilePath), deviationChartLock :: MVar (),- deviationChartResults :: IORef (Maybe DeviationChartResults) }+ deviationChartResults :: MRef (Maybe DeviationChartResults) } -- | The deviation chart item. data DeviationChartResults =@@ -152,11 +151,11 @@ deviationChartStats :: [IOArray Int (SamplingStats Double)] } -- | Create a new state of the view.-newDeviationChart :: DeviationChartView -> Experiment r -> r -> FilePath -> IO (DeviationChartViewState r)+newDeviationChart :: DeviationChartView -> Experiment -> r -> FilePath -> IO (DeviationChartViewState r) newDeviationChart view exp renderer dir = do f <- newIORef Nothing l <- newMVar () - r <- newIORef Nothing+ r <- newMRef Nothing return DeviationChartViewState { deviationChartView = view, deviationChartExperiment = exp, deviationChartRenderer = renderer,@@ -166,7 +165,7 @@ deviationChartResults = r } -- | Create new chart results.-newDeviationChartResults :: [Either String String] -> Experiment r -> IO DeviationChartResults+newDeviationChartResults :: [Either String String] -> Experiment -> IO DeviationChartResults newDeviationChartResults names exp = do let specs = experimentSpecs exp bnds = integIterationBnds specs@@ -176,71 +175,64 @@ return DeviationChartResults { deviationChartTimes = times, deviationChartNames = names, deviationChartStats = stats }++-- | Require to return unique chart results associated with the specified state. +requireDeviationChartResults :: DeviationChartViewState r -> [Either String String] -> IO DeviationChartResults+requireDeviationChartResults st names =+ maybeWriteMRef (deviationChartResults st)+ (newDeviationChartResults names (deviationChartExperiment st)) $ \results ->+ if (names /= deviationChartNames results)+ then error "Series with different names are returned for different runs: requireDeviationChartResults"+ else results -- | Simulate the specified series.-simulateDeviationChart :: DeviationChartViewState r -> ExperimentData -> Event (Event ())+simulateDeviationChart :: DeviationChartViewState r -> ExperimentData -> Event DisposableEvent 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+ do let view = deviationChartView st+ rs1 = deviationChartLeftYSeries view $+ deviationChartTransform view $+ experimentResults expdata+ rs2 = deviationChartRightYSeries view $+ deviationChartTransform view $+ experimentResults expdata+ exts1 = extractDoubleStatsEitherResults rs1+ exts2 = extractDoubleStatsEitherResults rs2+ exts = exts1 ++ exts2+ names1 = map resultExtractName exts1+ names2 = map resultExtractName exts2+ names = map Left names1 ++ map Right names2+ signals = experimentPredefinedSignals expdata+ signal = resultSignalInIntegTimes signals+ lock = deviationChartLock st+ results <- liftIO $ requireDeviationChartResults st names+ let stats = deviationChartStats results+ handleSignal signal $ \_ ->+ do xs <- forM exts resultExtractData i <- liftDynamics integIteration- liftIO $ withMVar lock $ \() ->+ liftIO $ forM_ (zip xs stats) $ \(x, stats) ->+ withMVar lock $ \() -> do y <- readArray stats i- let y' = addDataToSamplingStats x y+ let y' = combineSamplingStatsEither x y y' `seq` writeArray stats i y'- return $ return () -- | Plot the deviation chart after the simulation is complete.-finaliseDeviationChart :: ChartRenderer r => DeviationChartViewState r -> IO ()+finaliseDeviationChart :: WebPageCharting r => DeviationChartViewState r -> IO () finaliseDeviationChart st =- do let title = deviationChartTitle $ deviationChartView st- plotTitle = + do let view = deviationChartView st+ title = deviationChartTitle view+ plotTitle = deviationChartPlotTitle view+ 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+ plotTitle+ width = deviationChartWidth view+ height = deviationChartHeight view+ plotLines = deviationChartPlotLines view+ plotFillBetween = deviationChartPlotFillBetween view+ plotBottomAxis = deviationChartBottomAxis view+ plotLayout = deviationChartLayout view renderer = deviationChartRenderer st- results <- readIORef $ deviationChartResults st+ results <- readMRef $ deviationChartResults st case results of Nothing -> return () Just results ->@@ -289,14 +281,14 @@ else id chart = plotLayout . updateLeftAxis . updateRightAxis $ layoutlr_x_axis .~ axis $- layoutlr_title .~ plotTitle $+ layoutlr_title .~ plotTitle' $ layoutlr_plots .~ ps $ def file <- resolveFilePath (deviationChartDir st) $- mapFilePath (flip replaceExtension $ renderableFileExtension renderer) $- expandFilePath (deviationChartFileName $ deviationChartView st) $+ mapFilePath (flip replaceExtension $ renderableChartExtension renderer) $+ expandFilePath (deviationChartFileName view) $ M.fromList [("$TITLE", title)]- renderChart renderer (width, height) (toRenderable chart) file+ renderChart renderer (width, height) file (toRenderable chart) when (experimentVerbose $ deviationChartExperiment st) $ putStr "Generated file " >> putStrLn file writeIORef (deviationChartFile st) $ Just file
Simulation/Aivika/Experiment/Chart/FinalHistogramView.hs view
@@ -7,9 +7,9 @@ -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 ----- The module defines 'FinalHistogramView' that draws a histogram+-- The module defines 'FinalHistogramView' that plots a histogram -- by the specified series in final time points collected from different -- simulation runs. --@@ -27,6 +27,7 @@ import Data.IORef import Data.Maybe import Data.Either+import Data.Monoid import Data.Array import Data.Array.IO.Safe import Data.Default.Class@@ -36,22 +37,13 @@ import Graphics.Rendering.Chart +import Simulation.Aivika import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.HtmlWriter-import Simulation.Aivika.Experiment.Utils (divideBy, replace)-import Simulation.Aivika.Experiment.Chart.ChartRenderer+import Simulation.Aivika.Experiment.MRef+import Simulation.Aivika.Experiment.Chart.Types 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+-- | Defines the 'View' that plots the histogram -- for the specified series in final time points -- collected from different simulation runs. data FinalHistogramView =@@ -78,9 +70,10 @@ 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.+ finalHistogramTransform :: ResultTransform,+ -- ^ The transform applied to the results before receiving series.+ finalHistogramSeries :: ResultTransform, + -- ^ It defines the series to be plotted on the histogram. finalHistogramPlotTitle :: String, -- ^ This is a title used in the histogram. -- It may include special variable @$TITLE@.@@ -113,116 +106,111 @@ finalHistogramFileName = UniqueFilePath "$TITLE", finalHistogramPredicate = return True, finalHistogramBuild = histogram binSturges,- finalHistogramSeries = [], + finalHistogramTransform = id,+ finalHistogramSeries = mempty, finalHistogramPlotTitle = "$TITLE", finalHistogramPlotBars = colourisePlotBars, finalHistogramLayout = id } -instance ChartRenderer r => ExperimentView FinalHistogramView r where+instance WebPageCharting r => ExperimentView FinalHistogramView r WebPageWriter where outputView v = let reporter exp renderer dir = do st <- newFinalHistogram v exp renderer dir+ let writer =+ WebPageWriter { reporterWriteTOCHtml = finalHistogramTOCHtml st,+ reporterWriteHtml = finalHistogramHtml st } return ExperimentReporter { reporterInitialise = return (), reporterFinalise = finaliseFinalHistogram st, reporterSimulate = simulateFinalHistogram st,- reporterTOCHtml = finalHistogramTOCHtml st,- reporterHtml = finalHistogramHtml st }+ reporterRequest = writer } in ExperimentGenerator { generateReporter = reporter } -- | The state of the view. data FinalHistogramViewState r = FinalHistogramViewState { finalHistogramView :: FinalHistogramView,- finalHistogramExperiment :: Experiment r,+ finalHistogramExperiment :: Experiment, finalHistogramRenderer :: r, finalHistogramDir :: FilePath, finalHistogramFile :: IORef (Maybe FilePath),- finalHistogramLock :: MVar (),- finalHistogramResults :: IORef (Maybe FinalHistogramResults) }+ finalHistogramResults :: MRef (Maybe FinalHistogramResults) } -- | The histogram item. data FinalHistogramResults = FinalHistogramResults { finalHistogramNames :: [String],- finalHistogramValues :: [ListRef Double] }+ finalHistogramValues :: [MRef [Double]] } -- | Create a new state of the view.-newFinalHistogram :: FinalHistogramView -> Experiment r -> r -> FilePath -> IO (FinalHistogramViewState r)+newFinalHistogram :: FinalHistogramView -> Experiment -> r -> FilePath -> IO (FinalHistogramViewState r) newFinalHistogram view exp renderer dir = do f <- newIORef Nothing- l <- newMVar () - r <- newIORef Nothing+ r <- newMRef Nothing return FinalHistogramViewState { finalHistogramView = view, finalHistogramExperiment = exp, finalHistogramRenderer = renderer, finalHistogramDir = dir, finalHistogramFile = f,- finalHistogramLock = l, finalHistogramResults = r } -- | Create new histogram results.-newFinalHistogramResults :: [String] -> Experiment r -> IO FinalHistogramResults+newFinalHistogramResults :: [String] -> Experiment -> IO FinalHistogramResults newFinalHistogramResults names exp =- do values <- forM names $ \_ -> liftIO newListRef+ do values <- forM names $ \_ -> liftIO $ newMRef [] return FinalHistogramResults { finalHistogramNames = names, finalHistogramValues = values } +-- | Require to return unique results associated with the specified state. +requireFinalHistogramResults :: FinalHistogramViewState r -> [String] -> IO FinalHistogramResults+requireFinalHistogramResults st names =+ maybeWriteMRef (finalHistogramResults st)+ (newFinalHistogramResults names (finalHistogramExperiment st)) $ \results ->+ if (names /= finalHistogramNames results)+ then error "Series with different names are returned for different runs: requireFinalHistogramResults"+ else results+ -- | Simulation of the specified series.-simulateFinalHistogram :: FinalHistogramViewState r -> ExperimentData -> Event (Event ())+simulateFinalHistogram :: FinalHistogramViewState r -> ExperimentData -> Event DisposableEvent 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)+ do let view = finalHistogramView st+ rs = finalHistogramSeries view $+ finalHistogramTransform view $+ experimentResults expdata+ exts = extractDoubleListResults rs+ names = map resultExtractName exts+ signals = experimentPredefinedSignals expdata+ signal = filterSignalM (const predicate) $+ resultSignalInStopTime signals+ predicate = finalHistogramPredicate view+ results <- liftIO $ requireFinalHistogramResults st names let values = finalHistogramValues results- h = filterSignalM (const predicate) $- experimentSignalInStopTime expdata- handleSignal_ h $ \_ ->- do xs <- sequence input- liftIO $ withMVar lock $ \() ->+ handleSignal signal $ \_ ->+ do xs <- forM exts resultExtractData+ liftIO $ forM_ (zip xs values) $ \(x, values) ->- addDataToListRef values x- return $ return ()+ modifyMRef values $ (++) x -- | Plot the histogram after the simulation is complete.-finaliseFinalHistogram :: ChartRenderer r => FinalHistogramViewState r -> IO ()+finaliseFinalHistogram :: WebPageCharting r => FinalHistogramViewState r -> IO () finaliseFinalHistogram st =- do let title = finalHistogramTitle $ finalHistogramView st- plotTitle = + do let view = finalHistogramView st+ title = finalHistogramTitle view+ plotTitle = finalHistogramPlotTitle view+ 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+ plotTitle+ width = finalHistogramWidth view+ height = finalHistogramHeight view+ histogram = finalHistogramBuild view+ bars = finalHistogramPlotBars view+ layout = finalHistogramLayout view renderer = finalHistogramRenderer st- results <- readIORef $ finalHistogramResults st+ results <- readMRef $ finalHistogramResults st case results of Nothing -> return () Just results -> do let names = finalHistogramNames results values = finalHistogramValues results- xs <- forM values readListRef+ xs <- forM values readMRef let zs = histogramToBars . filterHistogram . histogram $ map filterData xs p = plotBars $@@ -240,14 +228,14 @@ l else id chart = layout . updateAxes $- layout_title .~ plotTitle $+ layout_title .~ plotTitle' $ layout_plots .~ [p] $ def file <- resolveFilePath (finalHistogramDir st) $- mapFilePath (flip replaceExtension $ renderableFileExtension renderer) $- expandFilePath (finalHistogramFileName $ finalHistogramView st) $+ mapFilePath (flip replaceExtension $ renderableChartExtension renderer) $+ expandFilePath (finalHistogramFileName view) $ M.fromList [("$TITLE", title)]- renderChart renderer (width, height) (toRenderable chart) file+ renderChart renderer (width, height) file (toRenderable chart) when (experimentVerbose $ finalHistogramExperiment st) $ putStr "Generated file " >> putStrLn file writeIORef (finalHistogramFile st) $ Just file
Simulation/Aivika/Experiment/Chart/FinalXYChartView.hs view
@@ -7,10 +7,11 @@ -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 ----- The module defines 'FinalXYChartView' that saves the XY chart--- in final time points for all simulation runs sequentially.+-- The module defines 'FinalXYChartView' that plots a single XY chart+-- in final time points for different simulation runs sequentially+-- by the run index. -- module Simulation.Aivika.Experiment.Chart.FinalXYChartView@@ -26,6 +27,7 @@ import Data.IORef import Data.Maybe import Data.Either+import Data.Monoid import Data.Array import Data.Array.IO.Safe import Data.Default.Class@@ -35,22 +37,15 @@ import Graphics.Rendering.Chart +import Simulation.Aivika import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.HtmlWriter-import Simulation.Aivika.Experiment.Utils (divideBy, replace)-import Simulation.Aivika.Experiment.Chart.ChartRenderer+import Simulation.Aivika.Experiment.MRef+import Simulation.Aivika.Experiment.Chart.Types 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 final time points for all simulation runs--- sequentially.+-- | Defines the 'View' that plots the XY chart+-- in final time points for different simulation runs+-- sequentially by the run index. data FinalXYChartView = FinalXYChartView { finalXYChartTitle :: String, -- ^ This is a title used HTML.@@ -72,14 +67,20 @@ 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.+ finalXYChartTransform :: ResultTransform,+ -- ^ The transform applied to the results before receiving series.+ finalXYChartXSeries :: ResultTransform,+ -- ^ This is the 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.+ -- You must define it, because it is 'mempty' + -- by default. Also it must return exactly+ -- one 'ResultExtract' item when calling+ -- function 'extractDoubleResults' by the specified+ -- result set.+ finalXYChartLeftYSeries :: ResultTransform, + -- ^ It defines the series to be plotted basing on the left Y axis.+ finalXYChartRightYSeries :: ResultTransform, + -- ^ It defines the series to be plotted basing on the right Y axis. finalXYChartPlotTitle :: String, -- ^ This is a title used in the chart. -- It may include special variable @$TITLE@.@@ -119,34 +120,38 @@ finalXYChartHeight = 480, finalXYChartFileName = UniqueFilePath "$TITLE", finalXYChartPredicate = return True,- finalXYChartXSeries = Nothing,- finalXYChartYSeries = [], + finalXYChartTransform = id,+ finalXYChartXSeries = mempty,+ finalXYChartLeftYSeries = mempty,+ finalXYChartRightYSeries = mempty, finalXYChartPlotTitle = "$TITLE", finalXYChartPlotLines = colourisePlotLines, finalXYChartBottomAxis = id, finalXYChartLayout = id } -instance ChartRenderer r => ExperimentView FinalXYChartView r where+instance WebPageCharting r => ExperimentView FinalXYChartView r WebPageWriter where outputView v = let reporter exp renderer dir = do st <- newFinalXYChart v exp renderer dir+ let writer =+ WebPageWriter { reporterWriteTOCHtml = finalXYChartTOCHtml st,+ reporterWriteHtml = finalXYChartHtml st } return ExperimentReporter { reporterInitialise = return (), reporterFinalise = finaliseFinalXYChart st, reporterSimulate = simulateFinalXYChart st,- reporterTOCHtml = finalXYChartTOCHtml st,- reporterHtml = finalXYChartHtml st }+ reporterRequest = writer } in ExperimentGenerator { generateReporter = reporter } -- | The state of the view. data FinalXYChartViewState r = FinalXYChartViewState { finalXYChartView :: FinalXYChartView,- finalXYChartExperiment :: Experiment r,+ finalXYChartExperiment :: Experiment, finalXYChartRenderer :: r, finalXYChartDir :: FilePath, finalXYChartFile :: IORef (Maybe FilePath), finalXYChartLock :: MVar (),- finalXYChartResults :: IORef (Maybe FinalXYChartResults) }+ finalXYChartResults :: MRef (Maybe FinalXYChartResults) } -- | The XY chart results. data FinalXYChartResults =@@ -155,11 +160,11 @@ finalXYChartXY :: [IOArray Int (Maybe (Double, Double))] } -- | Create a new state of the view.-newFinalXYChart :: FinalXYChartView -> Experiment r -> r -> FilePath -> IO (FinalXYChartViewState r)+newFinalXYChart :: FinalXYChartView -> Experiment -> r -> FilePath -> IO (FinalXYChartViewState r) newFinalXYChart view exp renderer dir = do f <- newIORef Nothing l <- newMVar () - r <- newIORef Nothing+ r <- newMRef Nothing return FinalXYChartViewState { finalXYChartView = view, finalXYChartExperiment = exp, finalXYChartRenderer = renderer,@@ -169,7 +174,7 @@ finalXYChartResults = r } -- | Create new chart results.-newFinalXYChartResults :: String -> [Either String String] -> Experiment r -> IO FinalXYChartResults+newFinalXYChartResults :: String -> [Either String String] -> Experiment -> IO FinalXYChartResults newFinalXYChartResults xname ynames exp = do let n = experimentRunCount exp xy <- forM ynames $ \_ -> @@ -178,82 +183,72 @@ finalXYChartYNames = ynames, finalXYChartXY = xy } +-- | Require to return unique results associated with the specified state. +requireFinalXYChartResults :: FinalXYChartViewState r -> String -> [Either String String] -> IO FinalXYChartResults+requireFinalXYChartResults st xname ynames =+ maybeWriteMRef (finalXYChartResults st)+ (newFinalXYChartResults xname ynames (finalXYChartExperiment st)) $ \results ->+ if (xname /= finalXYChartXName results) || (ynames /= finalXYChartYNames results)+ then error "Series with different names are returned for different runs: requireFinalXYChartResults"+ else results+ -- | Simulation.-simulateFinalXYChart :: FinalXYChartViewState r -> ExperimentData -> Event (Event ())+simulateFinalXYChart :: FinalXYChartViewState r -> ExperimentData -> Event DisposableEvent 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+ do let view = finalXYChartView st+ rs0 = finalXYChartXSeries view $+ finalXYChartTransform view $+ experimentResults expdata+ rs1 = finalXYChartLeftYSeries view $+ finalXYChartTransform view $+ experimentResults expdata+ rs2 = finalXYChartRightYSeries view $+ finalXYChartTransform view $+ experimentResults expdata+ ext0 =+ case extractDoubleResults rs0 of+ [x] -> x+ _ -> error "Expected to see a single X series: simulateFinalXYChart"+ exts1 = extractDoubleResults rs1+ exts2 = extractDoubleResults rs2+ exts = exts1 ++ exts2+ name0 = resultExtractName ext0+ names1 = map resultExtractName exts1+ names2 = map resultExtractName exts2+ names = map Left names1 ++ map Right names2+ signals = experimentPredefinedSignals expdata+ signal = filterSignalM (const predicate) $+ resultSignalInStopTime signals+ n = experimentRunCount $ finalXYChartExperiment st+ predicate = finalXYChartPredicate view 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)+ results <- liftIO $ requireFinalXYChartResults st name0 names 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 ()+ handleSignal signal $ \_ ->+ do x <- resultExtractData ext0+ ys <- forM exts resultExtractData+ i <- liftParameter simulationIndex+ liftIO $+ forM_ (zip ys xys) $ \(y, xy) ->+ withMVar lock $ \() ->+ x `seq` y `seq` writeArray xy i $ Just (x, y) -- | Plot the XY chart after the simulation is complete.-finaliseFinalXYChart :: ChartRenderer r => FinalXYChartViewState r -> IO ()+finaliseFinalXYChart :: WebPageCharting r => FinalXYChartViewState r -> IO () finaliseFinalXYChart st =- do let title = finalXYChartTitle $ finalXYChartView st- plotTitle = + do let view = finalXYChartView st + title = finalXYChartTitle view+ plotTitle = finalXYChartPlotTitle view+ 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+ plotTitle+ width = finalXYChartWidth view+ height = finalXYChartHeight view+ plotLines = finalXYChartPlotLines view+ plotBottomAxis = finalXYChartBottomAxis view+ plotLayout = finalXYChartLayout view renderer = finalXYChartRenderer st- results <- readIORef $ finalXYChartResults st+ results <- readMRef $ finalXYChartResults st case results of Nothing -> return () Just results ->@@ -284,14 +279,14 @@ else id chart = plotLayout . updateLeftAxis . updateRightAxis $ layoutlr_x_axis .~ axis $- layoutlr_title .~ plotTitle $+ layoutlr_title .~ plotTitle' $ layoutlr_plots .~ ps $ def file <- resolveFilePath (finalXYChartDir st) $- mapFilePath (flip replaceExtension $ renderableFileExtension renderer) $- expandFilePath (finalXYChartFileName $ finalXYChartView st) $+ mapFilePath (flip replaceExtension $ renderableChartExtension renderer) $+ expandFilePath (finalXYChartFileName view) $ M.fromList [("$TITLE", title)]- renderChart renderer (width, height) (toRenderable chart) file+ renderChart renderer (width, height) file (toRenderable chart) when (experimentVerbose $ finalXYChartExperiment st) $ putStr "Generated file " >> putStrLn file writeIORef (finalXYChartFile st) $ Just file
Simulation/Aivika/Experiment/Chart/HistogramView.hs view
@@ -7,11 +7,11 @@ -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 ----- The module defines 'HistogramView' that saves the histogram--- collecting statistics for all integration time points for each --- simulation run separately.+-- The module defines 'HistogramView' that plots the histogram+-- collecting statistics in all integration time points and does+-- it for every simulation run separately. -- module Simulation.Aivika.Experiment.Chart.HistogramView@@ -26,6 +26,7 @@ import Data.IORef import Data.Maybe import Data.Either+import Data.Monoid import Data.Array import Data.Default.Class @@ -34,22 +35,14 @@ import Graphics.Rendering.Chart +import Simulation.Aivika import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.HtmlWriter-import Simulation.Aivika.Experiment.Utils (divideBy, replace)-import Simulation.Aivika.Experiment.Chart.ChartRenderer+import Simulation.Aivika.Experiment.Chart.Types 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 collecting statistics--- for all integration time points for each simulation run separately.+-- | Defines the 'View' that plots the histogram collecting statistics+-- for all integration time points but for each simulation run separately. data HistogramView = HistogramView { histogramTitle :: String, -- ^ This is a title used in HTML.@@ -74,9 +67,10 @@ 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.+ histogramTransform :: ResultTransform,+ -- ^ The transform applied to the results before receiving series.+ histogramSeries :: ResultTransform, + -- ^ It defines the series to be plotted on the histogram. histogramPlotTitle :: String, -- ^ This is a title used in the histogram when -- simulating a single run. It may include @@ -121,40 +115,42 @@ histogramFileName = UniqueFilePath "$TITLE - $RUN_INDEX", histogramPredicate = return True, histogramBuild = histogram binSturges,- histogramSeries = [], + histogramTransform = id,+ histogramSeries = mempty, histogramPlotTitle = "$TITLE", histogramRunPlotTitle = "$PLOT_TITLE / Run $RUN_INDEX of $RUN_COUNT", histogramPlotBars = colourisePlotBars, histogramLayout = id } -instance ChartRenderer r => ExperimentView HistogramView r where+instance WebPageCharting r => ExperimentView HistogramView r WebPageWriter where outputView v = let reporter exp renderer dir = do st <- newHistogram v exp renderer dir+ let writer =+ WebPageWriter { reporterWriteTOCHtml = histogramTOCHtml st,+ reporterWriteHtml = histogramHtml st } return ExperimentReporter { reporterInitialise = return (), reporterFinalise = return (), reporterSimulate = simulateHistogram st,- reporterTOCHtml = histogramTOCHtml st,- reporterHtml = histogramHtml st }+ reporterRequest = writer } in ExperimentGenerator { generateReporter = reporter } -- | The state of the view. data HistogramViewState r = HistogramViewState { histogramView :: HistogramView,- histogramExperiment :: Experiment r,+ histogramExperiment :: Experiment, histogramRenderer :: r, histogramDir :: FilePath, histogramMap :: M.Map Int FilePath } -- | Create a new state of the view.-newHistogram :: ChartRenderer r =>- HistogramView -> Experiment r -> r -> FilePath -> IO (HistogramViewState r)+newHistogram :: WebPageCharting r => HistogramView -> Experiment -> r -> FilePath -> IO (HistogramViewState r) newHistogram view exp renderer dir = do let n = experimentRunCount exp fs <- forM [0..(n - 1)] $ \i -> resolveFilePath dir $- mapFilePath (flip replaceExtension $ renderableFileExtension renderer) $+ mapFilePath (flip replaceExtension $ renderableChartExtension renderer) $ expandFilePath (histogramFileName view) $ M.fromList [("$TITLE", histogramTitle view), ("$RUN_INDEX", show $ i + 1),@@ -168,46 +164,45 @@ histogramMap = m } -- | Plot the histogram during the simulation.-simulateHistogram :: ChartRenderer r => HistogramViewState r -> ExperimentData -> Event (Event ())+simulateHistogram :: WebPageCharting r => HistogramViewState r -> ExperimentData -> Event DisposableEvent 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+ do let view = histogramView st+ rs = histogramSeries view $+ histogramTransform view $+ experimentResults expdata+ exts = extractDoubleListResults rs+ names = map resultExtractName exts+ signals = experimentPredefinedSignals expdata 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- renderer = histogramRenderer st+ build = histogramBuild view+ width = histogramWidth view+ height = histogramHeight view+ predicate = histogramPredicate view+ title = histogramTitle view+ plotTitle = histogramPlotTitle view+ runPlotTitle = histogramRunPlotTitle view+ bars = histogramPlotBars view+ layout = histogramLayout view+ renderer = histogramRenderer st i <- liftParameter simulationIndex let file = fromJust $ M.lookup (i - 1) (histogramMap st)- title = histogramTitle $ histogramView st- plotTitle = + plotTitle' = replace "$TITLE" title- (histogramPlotTitle $ histogramView st)- runPlotTitle =+ plotTitle+ runPlotTitle' = if n == 1- then plotTitle+ 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) ->+ replace "$PLOT_TITLE" plotTitle'+ runPlotTitle+ hs <- forM exts $ \ext -> newSignalHistory $- mapSignalM (const input) $+ mapSignalM (const $ resultExtractData ext) $ filterSignalM (const predicate) $- experimentSignalInIntegTimes expdata+ resultSignalInIntegTimes signals return $+ DisposableEvent $ do xs <- forM hs readSignalHistory let zs = histogramToBars . filterHistogram . build $ map (filterData . concat . elems . snd) xs@@ -226,11 +221,11 @@ l else id chart = layout . updateAxes $- layout_title .~ runPlotTitle $+ layout_title .~ runPlotTitle' $ layout_plots .~ [p] $ def liftIO $- do renderChart renderer (width, height) (toRenderable chart) file+ do renderChart renderer (width, height) file (toRenderable chart) when (experimentVerbose $ histogramExperiment st) $ putStr "Generated file " >> putStrLn file
Simulation/Aivika/Experiment/Chart/TimeSeriesView.hs view
@@ -9,7 +9,7 @@ -- Stability : experimental -- Tested with: GHC 7.6.3 ----- The module defines 'TimeSeriesView' that saves the time series charts.+-- The module defines 'TimeSeriesView' that plots the time series charts. -- module Simulation.Aivika.Experiment.Chart.TimeSeriesView@@ -26,6 +26,7 @@ import Data.Either import Data.Array import Data.List+import Data.Monoid import Data.Default.Class import System.IO@@ -33,19 +34,12 @@ import Graphics.Rendering.Chart +import Simulation.Aivika import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.HtmlWriter-import Simulation.Aivika.Experiment.Utils (divideBy, replace)-import Simulation.Aivika.Experiment.Chart.ChartRenderer+import Simulation.Aivika.Experiment.Chart.Types 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.+-- | Defines the 'View' that plots the time series charts. data TimeSeriesView = TimeSeriesView { timeSeriesTitle :: String, -- ^ This is a title used in HTML.@@ -67,10 +61,13 @@ 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,+ timeSeriesTransform :: ResultTransform,+ -- ^ The transform applied to the results before receiving series.+ timeSeriesLeftYSeries :: ResultTransform, + -- ^ It defines the series plotted basing on the left Y axis.+ timeSeriesRightYSeries :: ResultTransform, + -- ^ It defines the series plotted basing on the right Y axis.+ timeSeriesPlotTitle :: String, -- ^ This is a title used in the chart when -- simulating a single run. It may include -- special variable @$TITLE@.@@ -121,41 +118,44 @@ timeSeriesHeight = 480, timeSeriesFileName = UniqueFilePath "$TITLE - $RUN_INDEX", timeSeriesPredicate = return True,- timeSeries = [], - timeSeriesPlotTitle = "$TITLE",+ timeSeriesTransform = id,+ timeSeriesLeftYSeries = const mempty,+ timeSeriesRightYSeries = const mempty,+ timeSeriesPlotTitle = "$TITLE", timeSeriesRunPlotTitle = "$PLOT_TITLE / Run $RUN_INDEX of $RUN_COUNT", timeSeriesPlotLines = colourisePlotLines, timeSeriesBottomAxis = id, timeSeriesLayout = id } -instance ChartRenderer r => ExperimentView TimeSeriesView r where+instance WebPageCharting r => ExperimentView TimeSeriesView r WebPageWriter where outputView v = let reporter exp renderer dir = do st <- newTimeSeries v exp renderer dir+ let writer =+ WebPageWriter { reporterWriteTOCHtml = timeSeriesTOCHtml st,+ reporterWriteHtml = timeSeriesHtml st } return ExperimentReporter { reporterInitialise = return (), reporterFinalise = return (), reporterSimulate = simulateTimeSeries st,- reporterTOCHtml = timeSeriesTOCHtml st,- reporterHtml = timeSeriesHtml st }+ reporterRequest = writer } in ExperimentGenerator { generateReporter = reporter } -- | The state of the view. data TimeSeriesViewState r = TimeSeriesViewState { timeSeriesView :: TimeSeriesView,- timeSeriesExperiment :: Experiment r,+ timeSeriesExperiment :: Experiment, timeSeriesRenderer :: r, timeSeriesDir :: FilePath, timeSeriesMap :: M.Map Int FilePath } -- | Create a new state of the view.-newTimeSeries :: ChartRenderer r =>- TimeSeriesView -> Experiment r -> r -> FilePath -> IO (TimeSeriesViewState r)+newTimeSeries :: WebPageCharting r => TimeSeriesView -> Experiment -> r -> FilePath -> IO (TimeSeriesViewState r) newTimeSeries view exp renderer dir = do let n = experimentRunCount exp fs <- forM [0..(n - 1)] $ \i -> resolveFilePath dir $- mapFilePath (flip replaceExtension $ renderableFileExtension renderer) $+ mapFilePath (flip replaceExtension $ renderableChartExtension renderer) $ expandFilePath (timeSeriesFileName view) $ M.fromList [("$TITLE", timeSeriesTitle view), ("$RUN_INDEX", show $ i + 1),@@ -168,91 +168,92 @@ timeSeriesDir = dir, timeSeriesMap = m } --- | Plot the time series chart during the simulation.-simulateTimeSeries :: ChartRenderer r => TimeSeriesViewState r -> ExperimentData -> Event (Event ())+-- | Plot the time series chart within simulation.+simulateTimeSeries :: WebPageCharting r => TimeSeriesViewState r -> ExperimentData -> Event DisposableEvent 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+ do let view = timeSeriesView st+ rs1 = timeSeriesLeftYSeries view $+ timeSeriesTransform view $+ experimentResults expdata+ rs2 = timeSeriesRightYSeries view $+ timeSeriesTransform view $+ experimentResults expdata+ exts1 = extractDoubleResults rs1+ exts2 = extractDoubleResults rs2+ signals = experimentPredefinedSignals expdata 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- renderer = timeSeriesRenderer st+ width = timeSeriesWidth view+ height = timeSeriesHeight view+ predicate = timeSeriesPredicate view+ title = timeSeriesTitle view+ plotTitle = timeSeriesPlotTitle view+ runPlotTitle = timeSeriesRunPlotTitle view+ plotLines = timeSeriesPlotLines view+ plotBottomAxis = timeSeriesBottomAxis view+ plotLayout = timeSeriesLayout view+ renderer = timeSeriesRenderer st i <- liftParameter simulationIndex- let file = fromJust $ M.lookup (i - 1) (timeSeriesMap st)- title = timeSeriesTitle $ timeSeriesView st- plotTitle = + let file = fromJust $ M.lookup (i - 1) (timeSeriesMap st)+ plotTitle' = replace "$TITLE" title- (timeSeriesPlotTitle $ timeSeriesView st)- runPlotTitle =+ plotTitle+ runPlotTitle' = if n == 1- then plotTitle+ 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) ->+ replace "$PLOT_TITLE" plotTitle'+ runPlotTitle+ inputHistory exts =+ forM exts $ \ext -> let transform () = do x <- predicate- if x then input else return (1/0) -- the infinite values will be ignored then+ if x+ then resultExtractData ext+ else return (1/0) -- the infinite values will be ignored then in newSignalHistory $ mapSignalM transform $- experimentMixedSignal expdata [provider]- leftHs <- inputHistory leftInput- rightHs <- inputHistory rightInput+ pureResultSignal signals $+ resultExtractSignal ext+ hs1 <- inputHistory exts1+ hs2 <- inputHistory exts2 return $- do let plots hs input plotLineTails =+ DisposableEvent $+ do let plots hs exts plotLineTails = do ps <-- forM (zip3 hs input (head plotLineTails)) $- \(h, (name, provider, input), plotLines) ->+ forM (zip3 hs exts (head plotLineTails)) $+ \(h, ext, plotLines) -> do (ts, xs) <- readSignalHistory h return $ toPlot $ plotLines $ plot_lines_values .~ filterPlotLinesValues (zip (elems ts) (elems xs)) $- plot_lines_title .~ name $+ plot_lines_title .~ resultExtractName ext $ 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+ (ps1, plotLineTails) <- plots hs1 exts1 (tails plotLines)+ (ps2, plotLineTails) <- plots hs2 exts2 plotLineTails+ let ps1' = map Left ps1+ ps2' = map Right ps2+ ps' = ps1' ++ ps2'+ axis = plotBottomAxis $+ laxis_title .~ "time" $+ def updateLeftAxis =- if null leftPs+ if null ps1 then layoutlr_left_axis_visibility .~ AxisVisibility False False False else id updateRightAxis =- if null rightPs+ if null ps2 then layoutlr_right_axis_visibility .~ AxisVisibility False False False else id chart = plotLayout . updateLeftAxis . updateRightAxis $ layoutlr_x_axis .~ axis $- layoutlr_title .~ runPlotTitle $+ layoutlr_title .~ runPlotTitle' $ layoutlr_plots .~ ps' $ def liftIO $- do renderChart renderer (width, height) (toRenderable chart) file+ do renderChart renderer (width, height) file (toRenderable chart) when (experimentVerbose $ timeSeriesExperiment st) $ putStr "Generated file " >> putStrLn file
+ Simulation/Aivika/Experiment/Chart/Types.hs view
@@ -0,0 +1,28 @@++-- |+-- Module : Simulation.Aivika.Experiment.Chart.Types+-- 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.8.3+--+-- The module defines a type class for rendering charts.+--++module Simulation.Aivika.Experiment.Chart.Types+ (WebPageCharting(..)) where++import Graphics.Rendering.Chart++import Simulation.Aivika.Experiment++-- | A type class of chart renderers.+class WebPageRendering r => WebPageCharting r where++ -- | The file extension used when rendering.+ renderableChartExtension :: r -> String++ -- | Generate an image file with the specified path for the given chart.+ -- The width and height are passed in the second argument to the function.+ renderChart :: r -> (Int, Int) -> FilePath -> Renderable c -> IO (PickFn c)
Simulation/Aivika/Experiment/Chart/XYChartView.hs view
@@ -7,9 +7,9 @@ -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 ----- The module defines 'XYChartView' that saves the XY charts.+-- The module defines 'XYChartView' that plots the XY charts. -- module Simulation.Aivika.Experiment.Chart.XYChartView@@ -34,19 +34,12 @@ import Graphics.Rendering.Chart +import Simulation.Aivika import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.HtmlWriter-import Simulation.Aivika.Experiment.Utils (divideBy, replace)-import Simulation.Aivika.Experiment.Chart.ChartRenderer+import Simulation.Aivika.Experiment.Chart.Types 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.+-- | Defines the 'View' that plots the XY charts. data XYChartView = XYChartView { xyChartTitle :: String, -- ^ This is a title used in HTML.@@ -68,15 +61,21 @@ 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.+ xyChartTransform :: ResultTransform,+ -- ^ The transform applied to the results before receiving series.+ xyChartXSeries :: ResultTransform,+ -- ^ This is 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,+ -- You must define it, because it is 'mempty' + -- by default. Also it must return exactly+ -- one 'ResultExtract' item when calling+ -- function 'extractDoubleResults' by the specified+ -- result set.+ xyChartLeftYSeries :: ResultTransform, + -- ^ It defines the series plotted basing on the left Y axis.+ xyChartRightYSeries :: ResultTransform, + -- ^ It defines the series plotted basing on the right Y axis.+ xyChartPlotTitle :: String, -- ^ This is a title used in the chart when -- simulating a single run. It may include -- special variable @$TITLE@.@@ -127,42 +126,45 @@ xyChartHeight = 480, xyChartFileName = UniqueFilePath "$TITLE - $RUN_INDEX", xyChartPredicate = return True,- xyChartXSeries = Nothing, - xyChartYSeries = [],+ xyChartTransform = id,+ xyChartXSeries = mempty, + xyChartLeftYSeries = mempty,+ xyChartRightYSeries = mempty, xyChartPlotTitle = "$TITLE", xyChartRunPlotTitle = "$PLOT_TITLE / Run $RUN_INDEX of $RUN_COUNT", xyChartPlotLines = colourisePlotLines, xyChartBottomAxis = id, xyChartLayout = id } -instance ChartRenderer r => ExperimentView XYChartView r where+instance WebPageCharting r => ExperimentView XYChartView r WebPageWriter where outputView v = let reporter exp renderer dir = do st <- newXYChart v exp renderer dir+ let writer =+ WebPageWriter { reporterWriteTOCHtml = xyChartTOCHtml st,+ reporterWriteHtml = xyChartHtml st } return ExperimentReporter { reporterInitialise = return (), reporterFinalise = return (), reporterSimulate = simulateXYChart st,- reporterTOCHtml = xyChartTOCHtml st,- reporterHtml = xyChartHtml st }+ reporterRequest = writer } in ExperimentGenerator { generateReporter = reporter } -- | The state of the view. data XYChartViewState r = XYChartViewState { xyChartView :: XYChartView,- xyChartExperiment :: Experiment r,+ xyChartExperiment :: Experiment, xyChartRenderer :: r, xyChartDir :: FilePath, xyChartMap :: M.Map Int FilePath } -- | Create a new state of the view.-newXYChart :: ChartRenderer r =>- XYChartView -> Experiment r -> r -> FilePath -> IO (XYChartViewState r)+newXYChart :: WebPageCharting r => XYChartView -> Experiment -> r -> FilePath -> IO (XYChartViewState r) newXYChart view exp renderer dir = do let n = experimentRunCount exp fs <- forM [0..(n - 1)] $ \i -> resolveFilePath dir $- mapFilePath (flip replaceExtension $ renderableFileExtension renderer) $+ mapFilePath (flip replaceExtension $ renderableChartExtension renderer) $ expandFilePath (xyChartFileName view) $ M.fromList [("$TITLE", xyChartTitle view), ("$RUN_INDEX", show $ i + 1),@@ -176,102 +178,102 @@ xyChartMap = m } -- | Plot the XY chart during the simulation.-simulateXYChart :: ChartRenderer r => XYChartViewState r -> ExperimentData -> Event (Event ())+simulateXYChart :: WebPageCharting r => XYChartViewState r -> ExperimentData -> Event DisposableEvent 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]+ do let view = xyChartView st+ rs0 = xyChartXSeries view $+ xyChartTransform view $+ experimentResults expdata+ rs1 = xyChartLeftYSeries view $+ xyChartTransform view $+ experimentResults expdata+ rs2 = xyChartRightYSeries view $+ xyChartTransform view $+ experimentResults expdata+ ext0 =+ case extractDoubleResults rs0 of+ [x] -> x+ _ -> error "Expected to see a single X series: simulateXYChart"+ exts1 = extractDoubleResults rs1+ exts2 = extractDoubleResults rs2+ signals = experimentPredefinedSignals expdata 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- renderer = xyChartRenderer st+ width = xyChartWidth view+ height = xyChartHeight view+ predicate = xyChartPredicate view+ title = xyChartTitle view+ plotTitle = xyChartPlotTitle view+ runPlotTitle = xyChartRunPlotTitle view+ plotLines = xyChartPlotLines view+ plotBottomAxis = xyChartBottomAxis view+ plotLayout = xyChartLayout view+ renderer = xyChartRenderer st i <- liftParameter simulationIndex- let file = fromJust $ M.lookup (i - 1) (xyChartMap st)- title = xyChartTitle $ xyChartView st- plotTitle = + let file = fromJust $ M.lookup (i - 1) (xyChartMap st)+ plotTitle' = replace "$TITLE" title- (xyChartPlotTitle $ xyChartView st)- runPlotTitle =+ plotTitle+ runPlotTitle' = if n == 1- then plotTitle+ 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 () =+ replace "$PLOT_TITLE" plotTitle'+ runPlotTitle+ inputHistory exts = + forM exts $ \ext ->+ let x = resultExtractData ext0+ y = resultExtractData ext+ transform () = do p <- predicate if p then liftM2 (,) x y else return (1/0, 1/0) -- such values will be ignored then+ signalx = resultExtractSignal ext0+ signaly = resultExtractSignal ext in newSignalHistory $ mapSignalM transform $- experimentMixedSignal expdata [provider] <>- experimentMixedSignal expdata [xprovider]- leftHs <- inputHistory leftYInput- rightHs <- inputHistory rightYInput+ pureResultSignal signals $+ signalx <> signaly+ hs1 <- inputHistory exts1+ hs2 <- inputHistory exts2 return $- do let plots hs input plotLineTails =+ DisposableEvent $+ do let plots hs exts plotLineTails = do ps <-- forM (zip3 hs input (head plotLineTails)) $- \(h, (name, provider, input), plotLines) ->+ forM (zip3 hs exts (head plotLineTails)) $+ \(h, ext, plotLines) -> do (ts, zs) <- readSignalHistory h return $ toPlot $ plotLines $ plot_lines_values .~ filterPlotLinesValues (elems zs) $- plot_lines_title .~ name $+ plot_lines_title .~ resultExtractName ext $ 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 $+ (ps1, plotLineTails) <- plots hs1 exts1 (tails plotLines)+ (ps2, plotLineTails) <- plots hs2 exts2 plotLineTails+ let ps1' = map Left ps1+ ps2' = map Right ps2+ ps' = ps1' ++ ps2'+ axis = plotBottomAxis $+ laxis_title .~ resultExtractName ext0 $ def updateLeftAxis =- if null leftPs+ if null ps1 then layoutlr_left_axis_visibility .~ AxisVisibility False False False else id updateRightAxis =- if null rightPs+ if null ps2 then layoutlr_right_axis_visibility .~ AxisVisibility False False False else id chart = plotLayout . updateLeftAxis . updateRightAxis $ layoutlr_x_axis .~ axis $- layoutlr_title .~ runPlotTitle $+ layoutlr_title .~ runPlotTitle' $ layoutlr_plots .~ ps' $ def liftIO $- do renderChart renderer (width, height) (toRenderable chart) file+ do renderChart renderer (width, height) file (toRenderable chart) when (experimentVerbose $ xyChartExperiment st) $ putStr "Generated file " >> putStrLn file
aivika-experiment-chart.cabal view
@@ -1,5 +1,5 @@ name: aivika-experiment-chart-version: 1.3+version: 1.4 synopsis: Simulation experiments with charting for the Aivika library description: This package complements the Aivika and Aivika Experiment packages with@@ -21,7 +21,7 @@ homepage: http://github.com/dsorokin/aivika-experiment-chart cabal-version: >= 1.6 build-type: Simple-tested-with: GHC == 7.6.3+tested-with: GHC == 7.8.3 extra-source-files: examples/BassDiffusion/Model.hs examples/BassDiffusion/Experiment.hs@@ -67,7 +67,7 @@ library exposed-modules: Simulation.Aivika.Experiment.Chart- Simulation.Aivika.Experiment.Chart.ChartRenderer+ Simulation.Aivika.Experiment.Chart.Types Simulation.Aivika.Experiment.Chart.TimeSeriesView Simulation.Aivika.Experiment.Chart.XYChartView Simulation.Aivika.Experiment.Chart.FinalXYChartView@@ -81,13 +81,13 @@ array >= 0.3.0.0, containers >= 0.4.0.0, filepath >= 1.3.0.0,- Chart >= 1.2,+ Chart >= 1.3.1, split >= 0.2.2, lens >= 3.9, data-default-class < 0.1, colour >= 2.3.3,- aivika >= 1.3,- aivika-experiment >= 1.3+ aivika >= 1.4,+ aivika-experiment >= 1.4 extensions: FlexibleInstances, MultiParamTypeClasses
examples/BassDiffusion/Experiment.hs view
@@ -1,6 +1,8 @@ -module Experiment (experiment) where+module Experiment (experiment, generators) where +import Data.Monoid+ import Simulation.Aivika import Simulation.Aivika.Experiment import Simulation.Aivika.Experiment.Chart@@ -11,18 +13,21 @@ spcMethod = RungeKutta4, spcGeneratorType = SimpleGenerator } -experiment :: ChartRenderer r => Experiment r+experiment :: Experiment experiment = defaultExperiment { experimentSpecs = specs, experimentRunCount = 20,- experimentDescription = "This is the famous Bass Diffusion model solved with help of the agent-based modelling.",- experimentGenerators =- [outputView defaultExperimentSpecsView,- outputView $ defaultDeviationChartView {- deviationChartSeries = [Left "potentialAdopters", - Left "adopters"] },- outputView $ defaultTimeSeriesView {- timeSeries = [Left "potentialAdopters", - Left "adopters"] } ]- }+ experimentDescription = "This is the famous Bass Diffusion model solved with help of the agent-based modelling." }++generators :: WebPageCharting r => [WebPageGenerator r]+generators =+ [outputView defaultExperimentSpecsView,+ outputView $ defaultDeviationChartView {+ deviationChartLeftYSeries = + resultByName "potentialAdopters" <>+ resultByName "adopters" },+ outputView $ defaultTimeSeriesView {+ timeSeriesLeftYSeries =+ resultByName "potentialAdopters" <>+ resultByName "adopters" } ]
examples/BassDiffusion/MainUsingCairo.hs view
@@ -2,11 +2,11 @@ -- To run, package aivika-experiment-cairo must be installed. import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.CairoRenderer+import Simulation.Aivika.Experiment.Chart.Backend.Cairo import Graphics.Rendering.Chart.Backend.Cairo import Model import Experiment -main = runExperiment experiment (CairoRenderer PNG) model+main = runExperiment experiment generators (CairoRenderer PNG) model
examples/BassDiffusion/MainUsingDiagrams.hs view
@@ -2,7 +2,7 @@ -- To run, package aivika-experiment-diagrams must be installed. import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.DiagramsRenderer+import Simulation.Aivika.Experiment.Chart.Backend.Diagrams import Graphics.Rendering.Chart.Backend.Diagrams @@ -11,4 +11,4 @@ import Model import Experiment -main = runExperiment experiment (DiagramsRenderer SVG M.empty) model+main = runExperiment experiment generators (DiagramsRenderer SVG M.empty) model
examples/BassDiffusion/Model.hs view
@@ -76,7 +76,7 @@ activatePersons ps = forM_ (elems ps) $ \p -> activatePerson p -model :: Simulation ExperimentData+model :: Simulation Results model = do potentialAdopters <- newRef 0 adopters <- newRef 0@@ -84,10 +84,11 @@ definePersons ps potentialAdopters adopters runEventInStartTime $ activatePersons ps- experimentDataInStartTime- [("potentialAdopters",- seriesEntity "Potential Adopters" - potentialAdopters),- ("adopters",- seriesEntity "Adopters"- adopters)]+ return $+ results+ [resultSource+ "potentialAdopters" "Potential Adopters"+ potentialAdopters,+ resultSource+ "adopters" "Adopters"+ adopters]
examples/ChemicalReaction/Experiment.hs view
@@ -1,6 +1,8 @@ -module Experiment (experiment) where+module Experiment (experiment, generators) where +import Data.Monoid+ import Simulation.Aivika import Simulation.Aivika.Experiment import Simulation.Aivika.Experiment.Chart@@ -11,35 +13,59 @@ spcMethod = RungeKutta4, spcGeneratorType = SimpleGenerator } -experiment :: ChartRenderer r => Experiment r+experiment :: Experiment experiment = defaultExperiment { experimentSpecs = specs, experimentRunCount = 1, experimentTitle = "Chemical Reaction", experimentDescription = "Chemical Reaction as described in " ++- "the 5-minute tutorial of Berkeley-Madonna",- experimentGenerators = - [outputView defaultExperimentSpecsView,- outputView $ defaultLastValueView {- lastValueSeries = ["t", "a", "b", "c"] },- outputView $ defaultTableView {- tableSeries = ["t", "a", "b", "c"] }, - outputView $ defaultTimeSeriesView {- timeSeriesTitle = "Time Series",- timeSeries = [Left "a", Left "b", Left "c"] },- outputView $ defaultXYChartView {- xyChartTitle = "XYChart - 1",- xyChartPlotTitle = "b=b(a), c=c(a)",- xyChartXSeries = Just "a",- xyChartYSeries = [Left "b", Right "c"] },- outputView $ defaultXYChartView {- xyChartTitle = "XYChart - 2",- xyChartPlotTitle = "a=a(b), c=c(b)",- xyChartXSeries = Just "b",- xyChartYSeries = [Right "a", Right "c"] },- outputView $ defaultXYChartView {- xyChartTitle = "XYChart - 3",- xyChartPlotTitle = "a=a(c), b=b(c)",- xyChartXSeries = Just "c",- xyChartYSeries = [Right "a", Left "b"] } ] }+ "the 5-minute tutorial of Berkeley-Madonna" }++generators :: WebPageCharting r => [WebPageGenerator r]+generators =+ [outputView defaultExperimentSpecsView,+ outputView $ defaultLastValueView {+ lastValueSeries =+ resultByName "t" <>+ resultByName "a" <>+ resultByName "b" <>+ resultByName "c" },+ outputView $ defaultTableView {+ tableSeries =+ resultByName "t" <>+ resultByName "a" <>+ resultByName "b" <>+ resultByName "c" },+ outputView $ defaultTimeSeriesView {+ timeSeriesTitle = "Time Series",+ timeSeriesLeftYSeries =+ resultByName "a" <>+ resultByName "b" <>+ resultByName "c" },+ outputView $ defaultXYChartView {+ xyChartTitle = "XYChart - 1",+ xyChartPlotTitle = "b=b(a), c=c(a)",+ xyChartXSeries =+ resultByName "a",+ xyChartLeftYSeries =+ resultByName "b",+ xyChartRightYSeries =+ resultByName "c" },+ outputView $ defaultXYChartView {+ xyChartTitle = "XYChart - 2",+ xyChartPlotTitle = "a=a(b), c=c(b)",+ xyChartXSeries =+ resultByName "b",+ xyChartRightYSeries =+ resultByName "a" <>+ resultByName "c" },+ outputView $ defaultXYChartView {+ xyChartTitle = "XYChart - 3",+ xyChartPlotTitle = "a=a(c), b=b(c)",+ xyChartXSeries =+ resultByName "c",+ xyChartLeftYSeries =+ resultByName "b",+ xyChartRightYSeries =+ resultByName "a" } ]
examples/ChemicalReaction/MainUsingCairo.hs view
@@ -2,11 +2,11 @@ -- To run, package aivika-experiment-cairo must be installed. import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.CairoRenderer+import Simulation.Aivika.Experiment.Chart.Backend.Cairo import Graphics.Rendering.Chart.Backend.Cairo import Model import Experiment -main = runExperiment experiment (CairoRenderer PNG) model+main = runExperiment experiment generators (CairoRenderer PNG) model
examples/ChemicalReaction/MainUsingDiagrams.hs view
@@ -2,7 +2,7 @@ -- To run, package aivika-experiment-diagrams must be installed. import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.DiagramsRenderer+import Simulation.Aivika.Experiment.Chart.Backend.Diagrams import Graphics.Rendering.Chart.Backend.Diagrams @@ -11,4 +11,4 @@ import Model import Experiment -main = runExperiment experiment (DiagramsRenderer SVG M.empty) model+main = runExperiment experiment generators (DiagramsRenderer SVG M.empty) model
examples/ChemicalReaction/Model.hs view
@@ -7,15 +7,16 @@ import Simulation.Aivika.SystemDynamics import Simulation.Aivika.Experiment -model :: Simulation ExperimentData+model :: Simulation Results model = mdo a <- integ (- ka * a) 100 b <- integ (ka * a - kb * b) 0 c <- integ (kb * b) 0 let ka = 1 kb = 1- experimentDataInStartTime- [("t", seriesEntity "time" time),- ("a", seriesEntity "a" a),- ("b", seriesEntity "b" b),- ("c", seriesEntity "c" c)]+ return $+ results+ [resultSource "t" "time" time,+ resultSource "a" "A" a,+ resultSource "b" "B" b,+ resultSource "c" "C" c]
examples/DifferenceEquations/Experiment.hs view
@@ -1,7 +1,7 @@ -{-# LANGUAGE RecursiveDo #-}+module Experiment (experiment, generators) where -module Experiment (experiment) where+import Data.Monoid import Simulation.Aivika import Simulation.Aivika.Experiment@@ -13,7 +13,7 @@ spcMethod = RungeKutta4, spcGeneratorType = SimpleGenerator } -experiment :: ChartRenderer r => Experiment r+experiment :: Experiment experiment = defaultExperiment { experimentSpecs = specs,@@ -21,19 +21,30 @@ experimentTitle = "Difference Equations", experimentDescription = "Difference Equations as described in " ++ "the corresponded tutorial of Berkeley-Madonna " ++- "with small modification for calculating std.",- experimentGenerators = - [outputView defaultExperimentSpecsView,- outputView $ defaultTableView {- tableSeries = ["t", "x", "sumX", "sumX2", "avg", "std"] }, - outputView $ defaultTimeSeriesView {- timeSeriesTitle = "Time Series",- timeSeries = [Left "x", Left "avg"] },- outputView $ defaultTimingStatsView {- timingStatsSeries = ["x"] },- outputView $ defaultTimeSeriesView {- timeSeriesTitle = "Sums",- timeSeries = [Left "sumX", Right "sumX2"] },- outputView $ defaultTimeSeriesView {- timeSeriesTitle = "Standard Deviation",- timeSeries = [Left "std"] } ] }+ "with small modification for calculating std." }++generators :: WebPageCharting r => [WebPageGenerator r]+generators =+ [outputView defaultExperimentSpecsView,+ outputView $ defaultTableView {+ tableSeries =+ mconcat $ map resultByName $+ ["t", "x", "sumX", "sumX2", "avg", "std"] }, + outputView $ defaultTimeSeriesView {+ timeSeriesTitle = "Time Series",+ timeSeriesLeftYSeries =+ resultByName "x" <>+ resultByName "avg" },+ outputView $ defaultTimingStatsView {+ timingStatsSeries =+ resultByName "x" },+ outputView $ defaultTimeSeriesView {+ timeSeriesTitle = "Sums",+ timeSeriesLeftYSeries =+ resultByName "sumX",+ timeSeriesRightYSeries =+ resultByName "sumX2" },+ outputView $ defaultTimeSeriesView {+ timeSeriesTitle = "Standard Deviation",+ timeSeriesLeftYSeries =+ resultByName "std" } ]
examples/DifferenceEquations/MainUsingCairo.hs view
@@ -2,11 +2,11 @@ -- To run, package aivika-experiment-cairo must be installed. import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.CairoRenderer+import Simulation.Aivika.Experiment.Chart.Backend.Cairo import Graphics.Rendering.Chart.Backend.Cairo import Model import Experiment -main = runExperiment experiment (CairoRenderer PNG) model+main = runExperiment experiment generators (CairoRenderer PNG) model
examples/DifferenceEquations/MainUsingDiagrams.hs view
@@ -2,7 +2,7 @@ -- To run, package aivika-experiment-diagrams must be installed. import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.DiagramsRenderer+import Simulation.Aivika.Experiment.Chart.Backend.Diagrams import Graphics.Rendering.Chart.Backend.Diagrams @@ -11,4 +11,4 @@ import Model import Experiment -main = runExperiment experiment (DiagramsRenderer SVG M.empty) model+main = runExperiment experiment generators (DiagramsRenderer SVG M.empty) model
examples/DifferenceEquations/Model.hs view
@@ -7,7 +7,7 @@ import Simulation.Aivika.SystemDynamics import Simulation.Aivika.Experiment -model :: Simulation ExperimentData+model :: Simulation Results model = mdo x <- memoRandomNormalDynamics 3 0.8 sumX <- diffsum x 0@@ -19,12 +19,13 @@ let avg = ifDynamics (n .>. 0) (sumX / n) 0 let std = ifDynamics (n .>. 1) (sqrt ((sumX2 - sumX * avg) / (n - 1))) 0- - experimentDataInStartTime- [("t", seriesEntity "time" time),- ("n", seriesEntity "n" n),- ("x", seriesEntity "x" x),- ("sumX", seriesEntity "sumX" sumX),- ("sumX2", seriesEntity "sumX2" sumX2),- ("avg", seriesEntity "avg" avg),- ("std", seriesEntity "std" std)]++ return $+ results+ [resultSource "t" "time" time,+ resultSource "n" "n" n,+ resultSource "x" "x" x,+ resultSource "sumX" "sum x" sumX,+ resultSource "sumX2" "sum x^2" sumX2,+ resultSource "avg" "Ex" avg,+ resultSource "std" "sqrt(Dx)" std]
examples/Financial/Experiment.hs view
@@ -1,10 +1,11 @@ -{-# LANGUAGE RecursiveDo #-}--module Experiment (monteCarloExperiment, singleExperiment) where+module Experiment (monteCarloExperiment, singleExperiment,+ monteCarloGenerators, singleGenerators) where import Control.Monad +import Data.Monoid+ import Simulation.Aivika import Simulation.Aivika.Experiment import Simulation.Aivika.Experiment.Chart@@ -15,65 +16,74 @@ specs = Specs 0 5 0.015625 RungeKutta4 SimpleGenerator -- | The experiment for the Monte-Carlo simulation.-monteCarloExperiment :: ChartRenderer r => Experiment r+monteCarloExperiment :: Experiment monteCarloExperiment = defaultExperiment { experimentSpecs = specs, experimentRunCount = 1000, experimentTitle = "Financial Model (the Monte-Carlo simulation)", experimentDescription = "Financial Model (the Monte-Carlo simulation) as described in " ++- "Vensim 5 Modeling Guide, Chapter Financial Modeling and Risk.",- experimentGenerators =- [outputView defaultExperimentSpecsView,- - outputView $ defaultDeviationChartView {- deviationChartTitle = "The deviation chart for Net Income and Cash Flow",- deviationChartSeries = [Left netIncomeName, - Left netCashFlowName] },-- outputView $ defaultDeviationChartView {- deviationChartTitle = "The deviation chart for Net Present Value of Income and Cash Flow",- deviationChartSeries = [Left npvIncomeName, - Left npvCashFlowName] },-- outputView $ defaultFinalHistogramView {- finalHistogramTitle = "Histogram for Net Income and Cash Flow",- finalHistogramSeries = [netIncomeName, netCashFlowName] },-- outputView $ defaultFinalHistogramView {- finalHistogramTitle = "Histogram for Net Present Value of Income and Cash Flow",- finalHistogramSeries = [npvIncomeName, npvCashFlowName] },-- outputView $ defaultFinalStatsView {- finalStatsTitle = "Summary for Net Income and Cash Flow",- finalStatsSeries = [netIncomeName, netCashFlowName] },-- outputView $ defaultFinalStatsView {- finalStatsTitle = "Summary for Net Present Value of Income and Cash Flow",- finalStatsSeries = [npvIncomeName, npvCashFlowName] } ] }+ "Vensim 5 Modeling Guide, Chapter Financial Modeling and Risk." } +monteCarloGenerators :: WebPageCharting r => [WebPageGenerator r]+monteCarloGenerators =+ [outputView defaultExperimentSpecsView,+ outputView $ defaultDeviationChartView {+ deviationChartTitle = "The deviation chart for Net Income and Cash Flow",+ deviationChartLeftYSeries =+ resultByName netIncomeName <>+ resultByName netCashFlowName },+ outputView $ defaultDeviationChartView {+ deviationChartTitle = "The deviation chart for Net Present Value of Income and Cash Flow",+ deviationChartLeftYSeries =+ resultByName npvIncomeName <>+ resultByName npvCashFlowName },+ outputView $ defaultFinalHistogramView {+ finalHistogramTitle = "Histogram for Net Income and Cash Flow",+ finalHistogramSeries =+ resultByName netIncomeName <>+ resultByName netCashFlowName },+ outputView $ defaultFinalHistogramView {+ finalHistogramTitle = "Histogram for Net Present Value of Income and Cash Flow",+ finalHistogramSeries =+ resultByName npvIncomeName <>+ resultByName npvCashFlowName },+ outputView $ defaultFinalStatsView {+ finalStatsTitle = "Summary for Net Income and Cash Flow",+ finalStatsSeries =+ resultByName netIncomeName <>+ resultByName netCashFlowName },+ outputView $ defaultFinalStatsView {+ finalStatsTitle = "Summary for Net Present Value of Income and Cash Flow",+ finalStatsSeries =+ resultByName npvIncomeName <>+ resultByName npvCashFlowName } ]+ -- | The experiment with single simulation run.-singleExperiment :: ChartRenderer r => Experiment r+singleExperiment :: Experiment singleExperiment = defaultExperiment { experimentSpecs = specs, experimentTitle = "Financial Model", experimentDescription = "Financial Model as described in " ++- "Vensim 5 Modeling Guide, Chapter Financial Modeling and Risk.",- experimentGenerators =- [outputView defaultExperimentSpecsView,- - outputView $ defaultTimeSeriesView {- timeSeriesTitle = "Time series of Net Income and Cash Flow",- timeSeries = [Left netIncomeName, - Left netCashFlowName] },- - outputView $ defaultTimeSeriesView {- timeSeriesTitle = "Time series of Net Present Value for Income and Cash Flow",- timeSeries = [Left npvIncomeName, - Left npvCashFlowName] },+ "Vensim 5 Modeling Guide, Chapter Financial Modeling and Risk." } - outputView $ defaultTableView {- tableTitle = "Table",- tableSeries = [netIncomeName, netCashFlowName,- npvIncomeName, npvCashFlowName] } ] }+singleGenerators :: WebPageCharting r => [WebPageGenerator r]+singleGenerators =+ [outputView defaultExperimentSpecsView,+ outputView $ defaultTimeSeriesView {+ timeSeriesTitle = "Time series of Net Income and Cash Flow",+ timeSeriesLeftYSeries =+ resultByName netIncomeName <>+ resultByName netCashFlowName },+ outputView $ defaultTimeSeriesView {+ timeSeriesTitle = "Time series of Net Present Value for Income and Cash Flow",+ timeSeriesLeftYSeries =+ resultByName npvIncomeName <>+ resultByName npvCashFlowName },+ outputView $ defaultTableView {+ tableTitle = "Table",+ tableSeries =+ mconcat $ map resultByName $ + [netIncomeName, netCashFlowName,+ npvIncomeName, npvCashFlowName] } ]
examples/Financial/MainUsingCairo.hs view
@@ -2,7 +2,7 @@ -- To run, package aivika-experiment-cairo must be installed. import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.CairoRenderer+import Simulation.Aivika.Experiment.Chart.Backend.Cairo import Graphics.Rendering.Chart.Backend.Cairo @@ -13,9 +13,13 @@ -- run the ordinary simulation putStrLn "*** The simulation with default parameters..."- runExperiment singleExperiment (CairoRenderer PNG) (model defaultParams)+ runExperiment+ singleExperiment singleGenerators+ (CairoRenderer PNG) (model defaultParams) putStrLn "" -- run the Monte-Carlo simulation putStrLn "*** The Monte-Carlo simulation..."- randomParams >>= runExperimentParallel monteCarloExperiment (CairoRenderer PNG) . model+ randomParams >>= runExperimentParallel+ monteCarloExperiment monteCarloGenerators+ (CairoRenderer PNG) . model
examples/Financial/MainUsingDiagrams.hs view
@@ -2,7 +2,7 @@ -- To run, package aivika-experiment-diagrams must be installed. import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.DiagramsRenderer+import Simulation.Aivika.Experiment.Chart.Backend.Diagrams import Graphics.Rendering.Chart.Backend.Diagrams @@ -15,9 +15,13 @@ -- run the ordinary simulation putStrLn "*** The simulation with default parameters..."- runExperiment singleExperiment (DiagramsRenderer SVG M.empty) (model defaultParams)+ runExperiment+ singleExperiment singleGenerators+ (DiagramsRenderer SVG M.empty) (model defaultParams) putStrLn "" -- run the Monte-Carlo simulation putStrLn "*** The Monte-Carlo simulation..."- randomParams >>= runExperimentParallel monteCarloExperiment (DiagramsRenderer SVG M.empty) . model+ randomParams >>= runExperimentParallel+ monteCarloExperiment monteCarloGenerators+ (DiagramsRenderer SVG M.empty) . model
examples/Financial/Model.hs view
@@ -93,7 +93,7 @@ paramsVariableProductionCost = variableProductionCost } -- | This is the model itself that returns experimental data.-model :: Parameters -> Simulation ExperimentData+model :: Parameters -> Simulation Results model params = mdo let getParameter f = liftParameter $ f params @@ -144,11 +144,12 @@ taxes = taxableIncome * taxRate variableProductionCost = getParameter paramsVariableProductionCost - experimentDataInStartTime- [(netIncomeName, seriesEntity "Net income" netIncome),- (netCashFlowName, seriesEntity "Net cash flow" netCashFlow),- (npvIncomeName, seriesEntity "NPV income" npvIncome),- (npvCashFlowName, seriesEntity "NPV cash flow" npvCashFlow)]+ return $+ results + [resultSource netIncomeName "Net income" netIncome,+ resultSource netCashFlowName "Net cash flow" netCashFlow,+ resultSource npvIncomeName "NPV income" npvIncome,+ resultSource npvCashFlowName "NPV cash flow" npvCashFlow] -- the names of the variables we are interested in netIncomeName = "netIncome"
examples/Furnace/Experiment.hs view
@@ -1,6 +1,9 @@ -module Experiment (experiment) where+module Experiment (experiment, generators) where +import Data.Monoid+import Control.Category+ import Simulation.Aivika import Simulation.Aivika.Experiment import Simulation.Aivika.Experiment.Chart@@ -16,105 +19,117 @@ spcGeneratorType = SimpleGenerator } -- | The experiment.-experiment :: ChartRenderer r => Experiment r+experiment :: Experiment experiment = defaultExperiment { experimentSpecs = specs, -- experimentRunCount = 1000, experimentRunCount = 100,- experimentTitle = "The Furnace model (the Monte-Carlo simulation)",- experimentGenerators =- [outputView defaultExperimentSpecsView,- - outputView $ defaultDeviationChartView {- deviationChartTitle = "Deviation Chart - 1",- deviationChartPlotTitle = "The total, loaded and ready ingot counts",- deviationChartSeries = [Right totalIngotCountName,- Right loadedIngotCountName,- Right readyIngotCountName] },-- outputView $ defaultFinalHistogramView {- finalHistogramTitle = "Final Histogram - 1",- finalHistogramPlotTitle = "The distribution of total, loaded and ready " ++- "ingot counts in the final time point.",- finalHistogramSeries = [totalIngotCountName,- loadedIngotCountName,- readyIngotCountName] },- - outputView $ defaultFinalStatsView {- finalStatsTitle = "Final Statistics - 1",- finalStatsDescription = "The summary of total, loaded and ready " ++- "ingot counts in the final time point.",- finalStatsSeries = [totalIngotCountName,- loadedIngotCountName,- readyIngotCountName] },-- outputView $ defaultDeviationChartView {- deviationChartTitle = "Deviation Chart - 2",- deviationChartPlotTitle = "The used pit count",- deviationChartSeries = [Right pitCountName] },- - outputView $ defaultFinalHistogramView {- finalHistogramTitle = "Final Histogram - 2",- finalHistogramPlotTitle = "The used pit count in the final time point.",- finalHistogramSeries = [pitCountName] },-- outputView $ defaultFinalStatsView {- finalStatsTitle = "Final Statistics - 2",- finalStatsDescription = "The summary of the used pit count in the final time point.",- finalStatsSeries = [pitCountName] },-- outputView $ defaultDeviationChartView {- deviationChartTitle = "Deviation Chart - 3",- deviationChartPlotTitle = "The queue size",- deviationChartSeries = [Right queueCountName] },- - outputView $ defaultFinalHistogramView {- finalHistogramTitle = "Final Histogram - 3",- finalHistogramPlotTitle = "The queue size in the final time point.",- finalHistogramSeries = [queueCountName] },-- outputView $ defaultFinalStatsView {- finalStatsTitle = "Final Statistics - 3",- finalStatsDescription = "The summary of the queue size in the final time point.",- finalStatsSeries = [queueCountName] },-- outputView $ defaultDeviationChartView {- deviationChartTitle = "Deviation Chart - 4",- deviationChartPlotTitle = "The mean wait time",- deviationChartSeries = [Right meanWaitTimeName] },-- outputView $ defaultFinalStatsView {- finalStatsTitle = "Final Statistics - 4",- finalStatsDescription = "The summary of the mean wait time in " ++- "the final time point.",- finalStatsSeries = [meanWaitTimeName] },-- outputView $ defaultDeviationChartView {- deviationChartTitle = "Deviation Chart - 5",- deviationChartPlotTitle = "The mean heating time",- deviationChartSeries = [Right meanHeatingTimeName] },-- outputView $ defaultFinalStatsView {- finalStatsTitle = "Final Statistics - 5",- finalStatsDescription = "The summary of the mean heating time in " ++- "the final time point.",- finalStatsSeries = [meanHeatingTimeName] },-- outputView $ defaultDeviationChartView {- deviationChartTitle = "Deviation Chart - 6",- deviationChartPlotTitle = "The ready ingot temperature",- deviationChartSeries = [Right readyIngotTempsName] },+ experimentTitle = "The Furnace model (the Monte-Carlo simulation)" } - outputView $ defaultFinalHistogramView {- finalHistogramTitle = "Final Histogram - 6",- 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 time point.",- finalStatsSeries = [readyIngotTempsName] }- ] }+generators :: WebPageCharting r => [WebPageGenerator r]+generators =+ [outputView defaultExperimentSpecsView,+ outputView $ defaultDeviationChartView {+ deviationChartTitle = "Deviation Chart - 1",+ deviationChartPlotTitle = "The input, loaded and output ingot counts",+ deviationChartRightYSeries =+ resultByName inputIngotCountName <>+ resultByName loadedIngotCountName <>+ resultByName outputIngotCountName },+ outputView $ defaultFinalHistogramView {+ finalHistogramTitle = "Final Histogram - 1",+ finalHistogramPlotTitle = "The distribution of input, loaded and output " +++ "ingot counts in the final time point.",+ finalHistogramSeries =+ resultByName inputIngotCountName <>+ resultByName loadedIngotCountName <>+ resultByName outputIngotCountName },+ outputView $ defaultFinalStatsView {+ finalStatsTitle = "Final Statistics - 1",+ finalStatsDescription = "The summary of input, loaded and output " +++ "ingot counts in the final time point.",+ finalStatsSeries =+ resultByName inputIngotCountName <>+ resultByName loadedIngotCountName <>+ resultByName outputIngotCountName },+ outputView $ defaultDeviationChartView {+ deviationChartTitle = "Deviation Chart - 2",+ deviationChartPlotTitle = "The used pit count",+ deviationChartRightYSeries =+ resultByName pitCountName },+ outputView $ defaultFinalHistogramView {+ finalHistogramTitle = "Final Histogram - 2",+ finalHistogramPlotTitle = "The used pit count in the final time point.",+ finalHistogramSeries =+ resultByName pitCountName },+ outputView $ defaultFinalStatsView {+ finalStatsTitle = "Final Statistics - 2",+ finalStatsDescription = "The summary of the used pit count in the final time point.",+ finalStatsSeries =+ resultByName pitCountName },+ outputView $ defaultDeviationChartView {+ deviationChartTitle = "Deviation Chart - 3",+ deviationChartPlotTitle = "The queue size",+ deviationChartRightYSeries =+ resultByName furnaceQueueName >>> resultByProperty "queueCount" },+ outputView $ defaultFinalHistogramView {+ finalHistogramTitle = "Final Histogram - 3",+ finalHistogramPlotTitle = "The queue size in the final time point.",+ finalHistogramSeries =+ resultByName furnaceQueueName >>> resultByProperty "queueCount" },+ outputView $ defaultFinalStatsView {+ finalStatsTitle = "Final Statistics - 3",+ finalStatsDescription = "The summary of the queue size in the final time point.",+ finalStatsSeries =+ resultByName furnaceQueueName >>> resultByProperty "queueCount" },+ outputView $ defaultDeviationChartView {+ deviationChartTitle = "Deviation Chart - 4",+ deviationChartPlotTitle = "The mean wait time",+ deviationChartRightYSeries =+ resultByName furnaceQueueName >>> resultByProperty "queueWaitTime" },+ outputView $ defaultFinalStatsView {+ finalStatsTitle = "Final Statistics - 4",+ finalStatsDescription = "The summary of the mean wait time in " +++ "the final time point.",+ finalStatsSeries =+ resultByName furnaceQueueName >>> resultByProperty "queueWaitTime" },+ outputView $ defaultDeviationChartView {+ deviationChartTitle = "Deviation Chart - 5",+ deviationChartPlotTitle = "The queue rate",+ deviationChartRightYSeries =+ resultByName furnaceQueueName >>> resultByProperty "queueRate" },+ outputView $ defaultFinalStatsView {+ finalStatsTitle = "Final Statistics - 5",+ finalStatsDescription = "The summary of the queue rate in " +++ "the final time point.",+ finalStatsSeries =+ resultByName furnaceQueueName >>> resultByProperty "queueRate" },+ outputView $ defaultDeviationChartView {+ deviationChartTitle = "Deviation Chart - 6",+ deviationChartPlotTitle = "The mean heating time",+ deviationChartRightYSeries =+ resultByName heatingTimeName },+ outputView $ defaultFinalStatsView {+ finalStatsTitle = "Final Statistics - 6",+ finalStatsDescription = "The summary of the mean heating time in " +++ "the final time point.",+ finalStatsSeries =+ resultByName heatingTimeName },+ outputView $ defaultDeviationChartView {+ deviationChartTitle = "Deviation Chart - 7",+ deviationChartPlotTitle = "The output ingot temperature",+ deviationChartRightYSeries =+ resultByName outputIngotTempName },+ outputView $ defaultFinalHistogramView {+ finalHistogramTitle = "Final Histogram - 7",+ finalHistogramPlotTitle = "The output ingot temperature in " +++ "the final time point.",+ finalHistogramSeries =+ resultByName outputIngotTempName },+ outputView $ defaultFinalStatsView {+ finalStatsTitle = "Final Statistics - 7",+ finalStatsDescription = "The summary of the output ingot temperature in " +++ "the final time point.",+ finalStatsSeries =+ resultByName outputIngotTempName } ]
examples/Furnace/MainUsingCairo.hs view
@@ -2,11 +2,11 @@ -- To run, package aivika-experiment-cairo must be installed. import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.CairoRenderer+import Simulation.Aivika.Experiment.Chart.Backend.Cairo import Graphics.Rendering.Chart.Backend.Cairo import Model import Experiment -main = runExperiment experiment (CairoRenderer PNG) model+main = runExperiment experiment generators (CairoRenderer PNG) model
examples/Furnace/MainUsingDiagrams.hs view
@@ -2,7 +2,7 @@ -- To run, package aivika-experiment-diagrams must be installed. import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.DiagramsRenderer+import Simulation.Aivika.Experiment.Chart.Backend.Diagrams import Graphics.Rendering.Chart.Backend.Diagrams @@ -11,4 +11,4 @@ import Model import Experiment -main = runExperiment experiment (DiagramsRenderer SVG M.empty) model+main = runExperiment experiment generators (DiagramsRenderer SVG M.empty) model
examples/Furnace/Model.hs view
@@ -5,24 +5,6 @@ -- -- [2] Труб И.И., Объектно-ориентированное моделирование на C++: Учебный курс. - СПб.: Питер, 2006 ----- This model is often used in the literature as an example of combined--- continuous-discrete simulation but this is not a point here. It illustrates--- how the time-driven and process-oriented simulation models can be combined--- based on the common event queue. It still uses the differential equation but--- it is modeled directly [3] with help of the Euler method within the time-driven--- part of the combined model.------ [3] The time bounds for such an equation are much smaller than that ones which are defined--- by the specs. Therefore there is no sense to use the 'integ' function as it would be--- very slow because of large allocating memory for each integral, although it is possible.------ However, you can still combine the differential (and difference) equations with the DES and--- agent-based models. The integral (as well as any 'Dynamics' computation) can be used directly--- in the DES sub-model. But to update something from the DES sub-model that could be used aready--- in the differential equations, you should save data with help of types 'Var' or 'UVar' as they--- keep all the history of their past values. Also the values of these two types are managed by--- the event queue that allows synchronizing them with the DES sub-model.--- -- To define the external parameters for the Monte-Carlo simulation, see the Financial model. -- -- To enable the parallel simulation, you should compile it@@ -36,25 +18,30 @@ (-- * Simulation Model model, -- * Variable Names- totalIngotCountName,+ inputIngotCountName, loadedIngotCountName,- readyIngotCountName,- awaitedIngotCountName,- readyIngotTempsName,+ outputIngotCountName,+ outputIngotTempName,+ heatingTimeName, pitCountName,- queueCountName,- meanWaitTimeName,- meanHeatingTimeName) where+ furnaceQueueName) where import Data.Maybe-+import System.Random import Control.Monad import Control.Monad.Trans import Simulation.Aivika import Simulation.Aivika.Queue.Infinite-import Simulation.Aivika.Experiment +-- | The simulation specs.+specs = Specs { spcStartTime = 0.0,+ -- spcStopTime = 1000.0,+ spcStopTime = 300.0,+ spcDT = 0.1,+ spcMethod = RungeKutta4,+ spcGeneratorType = SimpleGenerator }+ -- | Return a random initial temperature of the item. randomTemp :: Parameter Double randomTemp = randomUniform 400 600@@ -112,7 +99,7 @@ newFurnace = do pits <- sequence [newPit | i <- [1..10]] pitCount <- newRef 0- queue <- newFCFSQueue+ queue <- runEventInStartTime newFCFSQueue heatingTime <- newRef emptySamplingStats h <- newRef 1650.0 readyCount <- newRef 0@@ -307,8 +294,8 @@ loadIngot furnace (x6 { ingotLoadTemp = 800.0 }) p6 writeRef (furnaceTemp furnace) 1650.0 --- | The simulation model that returns experimental data.-model :: Simulation ExperimentData+-- | The simulation model.+model :: Simulation Results model = do furnace <- newFurnace @@ -324,46 +311,35 @@ -- load permanently the input ingots in the furnace runProcessInStartTime $ loadingProcess furnace- - experimentDataInStartTime- [(totalIngotCountName,- seriesEntity "total ingot count" $- enqueueStoreCount (furnaceQueue furnace)),- - (loadedIngotCountName,- seriesEntity "loaded ingot count" $ -- actually, +/- 1- dequeueCount (furnaceQueue furnace)),- - (readyIngotCountName,- seriesEntity "ready ingot count" $- furnaceReadyCount furnace), - (readyIngotTempsName,- seriesEntity "the temperature of ready ingot" $- furnaceReadyTemps furnace),- - (pitCountName,- seriesEntity "the used pit count" $- furnacePitCount furnace),- - (queueCountName,- seriesEntity "the queue size" $- queueCount (furnaceQueue furnace)),- - (meanWaitTimeName,- seriesEntity "the mean wait time" $- queueWaitTime (furnaceQueue furnace)),+ -- return the simulation results+ return $+ results+ [resultSource inputIngotCountName "the input ingot count" $+ enqueueStoreCount (furnaceQueue furnace),+ --+ resultSource loadedIngotCountName "the loaded ingot count" $+ dequeueCount (furnaceQueue furnace),+ --+ resultSource outputIngotCountName "the output ingot count" $+ furnaceReadyCount furnace,+ --+ resultSource outputIngotTempName "the output ingot temperature" $+ furnaceReadyTemps furnace,+ --+ resultSource heatingTimeName "the heating time" $+ furnaceHeatingTime furnace,+ --+ resultSource pitCountName "the number of ingots in pits" $+ furnacePitCount furnace,+ --+ resultSource furnaceQueueName "the furnace queue" $+ furnaceQueue furnace] - (meanHeatingTimeName,- seriesEntity "the mean heating time" $- furnaceHeatingTime furnace) ]- -totalIngotCountName = "totalIngotCount"-loadedIngotCountName = "loadedIngotCount"-readyIngotCountName = "readyIngotCount"-awaitedIngotCountName = "awaitedIngotCount"-readyIngotTempsName = "readyIngotTemps"-pitCountName = "pitCount"-queueCountName = "queueCount"-meanWaitTimeName = "the mean wait time in the queue"-meanHeatingTimeName = "the mean heating time"+inputIngotCountName = "inputIngotCount"+loadedIngotCountName = "loadedIngotCount"+outputIngotCountName = "outputIngotCount"+outputIngotTempName = "outputIngotTemp"+heatingTimeName = "heatingTime"+pitCountName = "pitCount"+furnaceQueueName = "furnaceQueue"
examples/InspectionAdjustmentStations/Experiment.hs view
@@ -1,6 +1,10 @@ -module Experiment (experiment) where+module Experiment (experiment, generators) where +import Data.Monoid++import Control.Arrow+ import Simulation.Aivika import Simulation.Aivika.Experiment import Simulation.Aivika.Experiment.Chart@@ -13,63 +17,78 @@ spcGeneratorType = SimpleGenerator } -- | The experiment.-experiment :: ChartRenderer r => Experiment r+experiment :: Experiment experiment = defaultExperiment { experimentSpecs = specs, experimentRunCount = 1000, -- experimentRunCount = 10,- experimentTitle = "Inspection and Adjustment Stations on a Production Line (the Monte-Carlo simulation)",- experimentGenerators =- [outputView defaultExperimentSpecsView,- - outputView $ defaultFinalStatsView {- finalStatsTitle = "Arrivals",- finalStatsSeries = ["incomingArrivalCount",- "outgoingArrivalCount",- "outgoingArrivalTimer"] },- - outputView $ defaultDeviationChartView {- deviationChartTitle = "The processing factor (chart)",- deviationChartWidth = 1000,- deviationChartSeries = [Right "inspectionStationProcessingFactor",- Right "adjustmentStationProcessingFactor"] },+ experimentTitle = "Inspection and Adjustment Stations on a Production Line (the Monte-Carlo simulation)" } - outputView $ defaultFinalHistogramView {- finalHistogramTitle = "The processing factor (histogram)",- finalHistogramWidth = 1000,- finalHistogramSeries = ["inspectionStationProcessingFactor",- "adjustmentStationProcessingFactor"] },- - outputView $ defaultFinalStatsView {- finalStatsTitle = "The processing factor (statistics)",- finalStatsSeries = ["inspectionStationProcessingFactor",- "adjustmentStationProcessingFactor"] },- - outputView $ defaultDeviationChartView {- deviationChartTitle = "The queue size (chart)",- deviationChartWidth = 1000,- deviationChartSeries = [Right "inspectionQueueSize",- Right "adjustmentQueueSize"] },+resultProcessingTime :: ResultTransform+resultProcessingTime =+ (resultByName "inputArrivalTimer" >>>+ resultByProperty "processingTime")+ <>+ (resultByName "outputArrivalTimer" >>>+ resultByProperty "processingTime") - outputView $ defaultFinalHistogramView {- finalHistogramTitle = "The queue size (histogram)",- finalHistogramWidth = 1000,- finalHistogramSeries = ["inspectionQueueSize",- "adjustmentQueueSize"] },- - outputView $ defaultFinalStatsView {- finalStatsTitle = "The queue size (statistics)",- finalStatsSeries = ["inspectionQueueSize",- "adjustmentQueueSize"] },- - outputView $ defaultDeviationChartView {- deviationChartTitle = "The queue wait time (chart)",- deviationChartWidth = 1000,- deviationChartSeries = [Right "inspectionQueueWaitTime",- Right "adjustmentQueueWaitTime"] },- - outputView $ defaultFinalStatsView {- finalStatsTitle = "The queue wait time (statistics)",- finalStatsSeries = ["inspectionQueueWaitTime",- "adjustmentQueueWaitTime"] } ] }+resultProcessingFactor :: ResultTransform+resultProcessingFactor =+ (resultByName "inspectionStations" >>>+ resultByProperty "processingFactor")+ <>+ (resultByName "adjustmentStations" >>>+ resultByProperty "processingFactor")++resultQueueSize :: ResultTransform+resultQueueSize =+ (resultByName "inspectionQueue" >>>+ resultByProperty "queueCount")+ <>+ (resultByName "adjustmentQueue" >>>+ resultByProperty "queueCount")++resultWaitTime :: ResultTransform+resultWaitTime =+ (resultByName "inspectionQueue" >>>+ resultByProperty "queueWaitTime")+ <>+ (resultByName "adjustmentQueue" >>>+ resultByProperty "queueWaitTime")++generators :: WebPageCharting r => [WebPageGenerator r]+generators =+ [outputView defaultExperimentSpecsView,+ outputView $ defaultFinalStatsView {+ finalStatsTitle = "Arrivals",+ finalStatsSeries = resultProcessingTime },+ outputView $ defaultDeviationChartView {+ deviationChartTitle = "The processing factor (chart)",+ deviationChartWidth = 1000,+ deviationChartRightYSeries = resultProcessingFactor },+ outputView $ defaultFinalHistogramView {+ finalHistogramTitle = "The processing factor (histogram)",+ finalHistogramWidth = 1000,+ finalHistogramSeries = resultProcessingFactor },+ outputView $ defaultFinalStatsView {+ finalStatsTitle = "The processing factor (statistics)",+ finalStatsSeries = resultProcessingFactor },+ outputView $ defaultDeviationChartView {+ deviationChartTitle = "The queue size (chart)",+ deviationChartWidth = 1000,+ deviationChartRightYSeries = resultQueueSize },+ outputView $ defaultFinalHistogramView {+ finalHistogramTitle = "The queue size (histogram)",+ finalHistogramWidth = 1000,+ finalHistogramSeries = resultQueueSize },+ outputView $ defaultFinalStatsView {+ finalStatsTitle = "The queue size (statistics)",+ finalStatsSeries = resultQueueSize },+ outputView $ defaultDeviationChartView {+ deviationChartTitle = "The queue wait time (chart)",+ deviationChartWidth = 1000,+ deviationChartRightYSeries = resultWaitTime },+ outputView $ defaultFinalStatsView {+ finalStatsTitle = "The queue wait time (statistics)",+ finalStatsSeries = resultWaitTime } ]
examples/InspectionAdjustmentStations/MainUsingCairo.hs view
@@ -2,11 +2,11 @@ -- To run, package aivika-experiment-cairo must be installed. import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.CairoRenderer+import Simulation.Aivika.Experiment.Chart.Backend.Cairo import Graphics.Rendering.Chart.Backend.Cairo import Model import Experiment -main = runExperiment experiment (CairoRenderer PNG) model+main = runExperiment experiment generators (CairoRenderer PNG) model
examples/InspectionAdjustmentStations/MainUsingDiagrams.hs view
@@ -2,7 +2,7 @@ -- To run, package aivika-experiment-diagrams must be installed. import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.DiagramsRenderer+import Simulation.Aivika.Experiment.Chart.Backend.Diagrams import Graphics.Rendering.Chart.Backend.Diagrams @@ -11,4 +11,4 @@ import Model import Experiment -main = runExperiment experiment (DiagramsRenderer SVG M.empty) model+main = runExperiment experiment generators (DiagramsRenderer SVG M.empty) model
examples/InspectionAdjustmentStations/Model.hs view
@@ -11,27 +11,6 @@ -- -- [2] Труб И.И., Объектно-ориентированное моделирование на C++: Учебный курс. - СПб.: Питер, 2006 --- CAUTION:------ This model is not yet fully tested and it may contain logical errors but it seems to be working,--- although some results may differ slightly but it can be related to a great value of the deviation--- for some variables as well as to a small number of samples in [1].------ The results for the queue sizes in [2] seem doubtful for me, while my results for these queue sizes--- are similar to [1] but I made 1000 runs versus 1 run in [1]. In comparison with [1] I see a difference--- in the queue size for the adjustment station and it can be realized as there was a too small number of--- samples (= 13) in [1], for the TV settings must fail when inspecting to be directed to the adjustor.------ Also I have received more small values for the wait time in comparison with [1] but they have--- a relatively great deviation, which may be acceptable (??), taking into account a small number of--- samples used in [1].------ At the same time, all my other results except for these queue sizes correspond to [2], where the author--- launched 1000 simulation runs too.------ Some new things that I have added the past summer (2013), i.e. Streams / Processors / Queues / Servers,--- should be yet verified for other models but, as I wrote, they seem to be working.- module Model (model) where import Prelude hiding (id, (.)) @@ -44,7 +23,12 @@ import Simulation.Aivika import Simulation.Aivika.Queue.Infinite -import Simulation.Aivika.Experiment+-- | The simulation specs.+specs = Specs { spcStartTime = 0.0,+ spcStopTime = 480.0,+ spcDT = 0.1,+ spcMethod = RungeKutta4,+ spcGeneratorType = SimpleGenerator } -- the minimum delay of arriving the next TV set minArrivalDelay = 3.5@@ -73,11 +57,6 @@ -- how many are adjustment stations? adjustmentStationCount = 1 --- create an accumulator to gather the queue size statistics -newQueueSizeAccumulator queue =- newTimingStatsAccumulator $- Signalable (queueCount queue) (queueCountChanged_ queue)- -- create an inspection station (server) newInspectionStation = newServer $ \a ->@@ -99,7 +78,7 @@ randomUniform minAdjustmentTime maxAdjustmentTime) return a -model :: Simulation ExperimentData+model :: Simulation Results model = mdo -- to count the arrived TV sets for inspecting and adjusting inputArrivalTimer <- newArrivalTimer@@ -109,17 +88,11 @@ let inputStream = randomUniformStream minArrivalDelay maxArrivalDelay -- create a queue before the inspection stations- inspectionQueue <- newFCFSQueue+ inspectionQueue <-+ runEventInStartTime newFCFSQueue -- create a queue before the adjustment stations- adjustmentQueue <- newFCFSQueue- -- the inspection stations' queue size statistics- inspectionQueueSizeAcc <- - runEventInStartTime $- newQueueSizeAccumulator inspectionQueue- -- the adjustment stations' queue size statistics- adjustmentQueueSizeAcc <- - runEventInStartTime $- newQueueSizeAccumulator adjustmentQueue+ adjustmentQueue <-+ runEventInStartTime newFCFSQueue -- create the inspection stations (servers) inspectionStations <- forM [1 .. inspectionStationCount] $ \_ ->@@ -130,7 +103,7 @@ newAdjustmentStation -- a processor loop for the inspection stations' queue let inspectionQueueProcessorLoop =- queueProcessorLoopParallel+ queueProcessorLoopSeq (liftEvent . enqueue inspectionQueue) (dequeue inspectionQueue) inspectionProcessor@@ -154,36 +127,29 @@ -- start simulating the model runProcessInStartTime $ sinkStream $ runProcessor entireProcessor inputStream- -- return the experiment data- experimentDataInStartTime- [("t", seriesEntity "time" time),- ("incomingArrivalTimer", - seriesEntity "incoming arival processing time" $ - arrivalProcessingTime inputArrivalTimer),- ("outgoingArrivalTimer", - seriesEntity "outgoing arival processing time" $ - arrivalProcessingTime outputArrivalTimer),- ("incomingArrivalCount", - seriesEntity "incoming arivals" $ - fmap samplingStatsCount $ arrivalProcessingTime inputArrivalTimer),- ("outgoingArrivalCount", - seriesEntity "outgoing arivals" $ - fmap samplingStatsCount $ arrivalProcessingTime outputArrivalTimer),- ("inspectionStationProcessingFactor",- seriesEntity "the processing factor for the inspection stations" $- map serverProcessingFactor inspectionStations),- ("adjustmentStationProcessingFactor",- seriesEntity "the processing factor for the adjustment stations" $- map serverProcessingFactor adjustmentStations),- ("inspectionQueueSize",- seriesEntity "the inspection queue size" $- queueCount inspectionQueue),- ("adjustmentQueueSize",- seriesEntity "the adjustment queue size" $- queueCount adjustmentQueue),- ("inspectionQueueWaitTime",- seriesEntity "the inspection queue wait time" $- queueWaitTime inspectionQueue),- ("adjustmentQueueWaitTime",- seriesEntity "the adjustment queue wait time" $- queueWaitTime adjustmentQueue)]+ -- return the simulation results in start time+ return $+ results+ [resultSource+ "inspectionQueue" "the inspection queue"+ inspectionQueue,+ --+ resultSource+ "adjustmentQueue" "the adjustment queue"+ adjustmentQueue,+ --+ resultSource+ "inputArrivalTimer" "the input arrival timer"+ inputArrivalTimer,+ --+ resultSource+ "outputArrivalTimer" "the output arrival timer"+ outputArrivalTimer,+ --+ resultSource+ "inspectionStations" "the inspection stations"+ inspectionStations,+ --+ resultSource+ "adjustmentStations" "the adjustment stations"+ adjustmentStations]
examples/LinearArray/Experiment.hs view
@@ -1,6 +1,8 @@ -module Experiment (experiment) where+module Experiment (experiment, generators) where +import Data.Monoid+ import Simulation.Aivika import Simulation.Aivika.Experiment import Simulation.Aivika.Experiment.Chart@@ -11,43 +13,60 @@ spcMethod = RungeKutta4, spcGeneratorType = SimpleGenerator } -experiment :: ChartRenderer r => Experiment r+experiment :: Experiment experiment = defaultExperiment { experimentSpecs = specs, experimentRunCount = 1, experimentTitle = "Linear Array", experimentDescription = "Model Linear Array as described in " ++- "the examples included in Berkeley-Madonna.",- experimentGenerators = - [outputView defaultExperimentSpecsView,- outputView $ defaultTableView {- tableSeries = ["t", "m", "c"] },- outputView $ defaultTimeSeriesView {- timeSeries = [Left "m"],- timeSeriesWidth = 800,- timeSeriesHeight = 800 },- outputView $ defaultTimeSeriesView {- timeSeries = [Right "c"],- timeSeriesWidth = 800,- timeSeriesHeight = 800 },- outputView $ defaultTimeSeriesView {- timeSeries = [Left "m", Right "c"],- timeSeriesWidth = 800,- timeSeriesHeight = 800 },- outputView $ defaultXYChartView {- xyChartXSeries = Just "t",- xyChartYSeries = [Left "m"],- xyChartWidth = 800,- xyChartHeight = 800 },- outputView $ defaultXYChartView {- xyChartXSeries = Just "t",- xyChartYSeries = [Right "c"],- xyChartWidth = 800,- xyChartHeight = 800 },- outputView $ defaultXYChartView {- xyChartXSeries = Just "t",- xyChartYSeries = [Left "m", Right "c"],- xyChartWidth = 800,- xyChartHeight = 800 }- ] }+ "the examples included in Berkeley-Madonna." }++generators :: WebPageCharting r => [WebPageGenerator r]+generators = + [outputView defaultExperimentSpecsView,+ outputView $ defaultTableView {+ tableSeries =+ resultByName "t" <>+ resultByName "m" <>+ resultByName "c" },+ outputView $ defaultTimeSeriesView {+ timeSeriesLeftYSeries =+ resultByName "m",+ timeSeriesWidth = 800,+ timeSeriesHeight = 800 },+ outputView $ defaultTimeSeriesView {+ timeSeriesRightYSeries =+ resultByName "c",+ timeSeriesWidth = 800,+ timeSeriesHeight = 800 },+ outputView $ defaultTimeSeriesView {+ timeSeriesLeftYSeries =+ resultByName "m",+ timeSeriesRightYSeries =+ resultByName "c",+ timeSeriesWidth = 800,+ timeSeriesHeight = 800 },+ outputView $ defaultXYChartView {+ xyChartXSeries =+ resultByName "t",+ xyChartLeftYSeries =+ resultByName "m",+ xyChartWidth = 800,+ xyChartHeight = 800 },+ outputView $ defaultXYChartView {+ xyChartXSeries =+ resultByName "t",+ xyChartRightYSeries =+ resultByName "c",+ xyChartWidth = 800,+ xyChartHeight = 800 },+ outputView $ defaultXYChartView {+ xyChartXSeries =+ resultByName "t",+ xyChartLeftYSeries =+ resultByName "m",+ xyChartRightYSeries =+ resultByName "c",+ xyChartWidth = 800,+ xyChartHeight = 800 } ]
examples/LinearArray/MainUsingCairo.hs view
@@ -2,11 +2,11 @@ -- To run, package aivika-experiment-cairo must be installed. import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.CairoRenderer+import Simulation.Aivika.Experiment.Chart.Backend.Cairo import Graphics.Rendering.Chart.Backend.Cairo import Model import Experiment -main = runExperiment experiment (CairoRenderer PNG) (model 51)+main = runExperiment experiment generators (CairoRenderer PNG) (model 51)
examples/LinearArray/MainUsingDiagrams.hs view
@@ -2,7 +2,7 @@ -- To run, package aivika-experiment-diagrams must be installed. import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.DiagramsRenderer+import Simulation.Aivika.Experiment.Chart.Backend.Diagrams import Graphics.Rendering.Chart.Backend.Diagrams @@ -11,4 +11,4 @@ import Model import Experiment -main = runExperiment experiment (DiagramsRenderer SVG M.empty) (model 51)+main = runExperiment experiment generators (DiagramsRenderer SVG M.empty) (model 51)
examples/LinearArray/Model.hs view
@@ -28,7 +28,7 @@ return (i, x) return $ array bnds ps -model :: Int -> Simulation ExperimentData+model :: Int -> Simulation Results model n = mdo m <- generateArray (1, n) $ \i -> integ (q + k * (c!(i - 1) - c!i) + k * (c!(i + 1) - c!i)) 0@@ -39,7 +39,7 @@ q = 1 k = 2 v = 0.75- experimentDataInStartTime- [("t", seriesEntity "time" time),- ("m", seriesEntity "M" m),- ("c", seriesEntity "C" c)]+ return $ results+ [resultSource "t" "time" time,+ resultSource "m" "M" m,+ resultSource "c" "C" c]
examples/MachRep3/Experiment.hs view
@@ -1,6 +1,8 @@ -module Experiment (experiment) where+module Experiment (experiment, generators) where +import Data.Monoid+ import Simulation.Aivika import Simulation.Aivika.Experiment import Simulation.Aivika.Experiment.Chart@@ -11,59 +13,66 @@ spcMethod = RungeKutta4, spcGeneratorType = SimpleGenerator } -experiment :: ChartRenderer r => Experiment r+experiment :: Experiment experiment = defaultExperiment { experimentSpecs = specs, experimentRunCount = 200,- experimentDescription = "Experiment Description",- experimentGenerators =- [outputView defaultExperimentSpecsView,- outputView $ defaultDeviationChartView {- deviationChartSeries = [Left "t", Right "x"] },- outputView $ defaultFinalXYChartView {- finalXYChartPlotTitle = "The proportion up time", - finalXYChartXSeries = Just "n",- finalXYChartYSeries = [Right "x"] }, - outputView $ defaultFinalXYChartView {- finalXYChartPlotTitle = "The proportion up time for simulation runs < 50 and > 100", - finalXYChartXSeries = Just "n",- finalXYChartYSeries = [Right "x"], - finalXYChartPredicate =- do i <- liftParameter simulationIndex- return $ (i < 50) || (i > 100) },- outputView $ defaultFinalHistogramView {- finalHistogramPlotTitle = "Final Histogram (Default)",- finalHistogramSeries = ["x", "x"] },- outputView $ defaultFinalHistogramView {- finalHistogramPlotTitle = "Final Histogram (Default)",- finalHistogramSeries = ["t", "t"] },- outputView $ defaultFinalStatsView {- finalStatsSeries = ["x"] },- outputView $ defaultFinalHistogramView {- finalHistogramPlotTitle = "Final Histogram (Default)",- finalHistogramSeries = ["x"] },- outputView $ defaultFinalHistogramView {- finalHistogramPlotTitle = "Final Histogram (Bin Size = 0.001)",- finalHistogramBuild = histogramBinSize 0.001,- finalHistogramSeries = ["x"] },- outputView $ defaultFinalHistogramView {- finalHistogramPlotTitle = "Final Histogram (Bin Num = 10)",- finalHistogramBuild = histogramNumBins 10,- finalHistogramSeries = ["x"] },- outputView $ defaultFinalHistogramView {- finalHistogramPlotTitle = "Final Histogram (Sturges)",- finalHistogramBuild = histogram binSturges,- finalHistogramSeries = ["x"] },- outputView $ defaultFinalHistogramView {- finalHistogramPlotTitle = "Final Histogram (Doane)",- finalHistogramBuild = histogram binDoane,- finalHistogramSeries = ["x"] },- outputView $ defaultFinalHistogramView {- finalHistogramPlotTitle = "Final Histogram (Sqrt)",- finalHistogramBuild = histogram binSqrt,- finalHistogramSeries = ["x"] },- outputView $ defaultFinalHistogramView {- finalHistogramPlotTitle = "Final Histogram (Scott)",- finalHistogramBuild = histogram binScott,- finalHistogramSeries = ["x"] } ] }+ experimentDescription = "Experiment Description" }++x = resultByName "upTimeProp"+t = resultByName "totalUpTime"+n = resultByName "runIndex"++generators :: WebPageCharting r => [WebPageGenerator r]+generators =+ [outputView defaultExperimentSpecsView,+ outputView $ defaultDeviationChartView {+ deviationChartLeftYSeries = t,+ deviationChartRightYSeries = x },+ outputView $ defaultFinalXYChartView {+ finalXYChartPlotTitle = "The proportion up time", + finalXYChartXSeries = n,+ finalXYChartRightYSeries = x }, + outputView $ defaultFinalXYChartView {+ finalXYChartPlotTitle = "The proportion up time for simulation runs < 50 and > 100", + finalXYChartXSeries = n,+ finalXYChartRightYSeries = x, + finalXYChartPredicate =+ do i <- liftParameter simulationIndex+ return $ (i < 50) || (i > 100) },+ outputView $ defaultFinalHistogramView {+ finalHistogramPlotTitle = "Final Histogram (Default, Double for Testing)",+ finalHistogramSeries = x <> x },+ outputView $ defaultFinalHistogramView {+ finalHistogramPlotTitle = "Final Histogram (Default, Double for Testing)",+ finalHistogramSeries = t <> t },+ outputView $ defaultFinalStatsView {+ finalStatsSeries = x },+ outputView $ defaultFinalHistogramView {+ finalHistogramPlotTitle = "Final Histogram (Default)",+ finalHistogramSeries = x },+ outputView $ defaultFinalHistogramView {+ finalHistogramPlotTitle = "Final Histogram (Bin Size = 0.001)",+ finalHistogramBuild = histogramBinSize 0.001,+ finalHistogramSeries = x },+ outputView $ defaultFinalHistogramView {+ finalHistogramPlotTitle = "Final Histogram (Bin Num = 10)",+ finalHistogramBuild = histogramNumBins 10,+ finalHistogramSeries = x },+ outputView $ defaultFinalHistogramView {+ finalHistogramPlotTitle = "Final Histogram (Sturges)",+ finalHistogramBuild = histogram binSturges,+ finalHistogramSeries = x },+ outputView $ defaultFinalHistogramView {+ finalHistogramPlotTitle = "Final Histogram (Doane)",+ finalHistogramBuild = histogram binDoane,+ finalHistogramSeries = x },+ outputView $ defaultFinalHistogramView {+ finalHistogramPlotTitle = "Final Histogram (Sqrt)",+ finalHistogramBuild = histogram binSqrt,+ finalHistogramSeries = x },+ outputView $ defaultFinalHistogramView {+ finalHistogramPlotTitle = "Final Histogram (Scott)",+ finalHistogramBuild = histogram binScott,+ finalHistogramSeries = x } ]
examples/MachRep3/MainUsingCairo.hs view
@@ -2,11 +2,11 @@ -- To run, package aivika-experiment-cairo must be installed. import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.CairoRenderer+import Simulation.Aivika.Experiment.Chart.Backend.Cairo import Graphics.Rendering.Chart.Backend.Cairo import Model import Experiment -main = runExperiment experiment (CairoRenderer PNG) model+main = runExperiment experiment generators (CairoRenderer PNG) model
examples/MachRep3/MainUsingDiagrams.hs view
@@ -2,7 +2,7 @@ -- To run, package aivika-experiment-diagrams must be installed. import Simulation.Aivika.Experiment-import Simulation.Aivika.Experiment.DiagramsRenderer+import Simulation.Aivika.Experiment.Chart.Backend.Diagrams import Graphics.Rendering.Chart.Backend.Diagrams @@ -11,4 +11,4 @@ import Model import Experiment -main = runExperiment experiment (DiagramsRenderer SVG M.empty) model+main = runExperiment experiment generators (DiagramsRenderer SVG M.empty) model
examples/MachRep3/Model.hs view
@@ -24,7 +24,7 @@ meanUpTime = 1.0 meanRepairTime = 0.5 -model :: Simulation ExperimentData+model :: Simulation Results model = do -- number of machines currently up nUp <- newRef 2@@ -73,12 +73,19 @@ runProcessInStartTimeUsingId pid2 (machine pid1) - let result = + let upTimeProp = do x <- readRef totalUpTime y <- liftDynamics time return $ x / (2 * y) - - experimentDataInStartTime- [("x", seriesEntity "The proportion of up time" result),- ("t", seriesEntity "Total up time" totalUpTime),- ("n", seriesEntity "Simulation run" simulationIndex)]++ return $+ results+ [resultSource+ "upTimeProp" "The proportion of up time"+ upTimeProp,+ resultSource+ "totalUpTime" "Total up time"+ totalUpTime,+ resultSource+ "runIndex" "Simulation run"+ simulationIndex]