diff --git a/Simulation/Aivika/Experiment/Chart.hs b/Simulation/Aivika/Experiment/Chart.hs --- a/Simulation/Aivika/Experiment/Chart.hs +++ b/Simulation/Aivika/Experiment/Chart.hs @@ -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 diff --git a/Simulation/Aivika/Experiment/Chart/ChartRenderer.hs b/Simulation/Aivika/Experiment/Chart/ChartRenderer.hs deleted file mode 100644 --- a/Simulation/Aivika/Experiment/Chart/ChartRenderer.hs +++ /dev/null @@ -1,28 +0,0 @@ - --- | --- Module : Simulation.Aivika.Experiment.Chart.ChartRenderer --- Copyright : Copyright (c) 2012-2014, David Sorokin --- License : BSD3 --- Maintainer : David Sorokin --- 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) diff --git a/Simulation/Aivika/Experiment/Chart/DeviationChartView.hs b/Simulation/Aivika/Experiment/Chart/DeviationChartView.hs --- a/Simulation/Aivika/Experiment/Chart/DeviationChartView.hs +++ b/Simulation/Aivika/Experiment/Chart/DeviationChartView.hs @@ -7,9 +7,9 @@ -- License : BSD3 -- Maintainer : David Sorokin -- 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 diff --git a/Simulation/Aivika/Experiment/Chart/FinalHistogramView.hs b/Simulation/Aivika/Experiment/Chart/FinalHistogramView.hs --- a/Simulation/Aivika/Experiment/Chart/FinalHistogramView.hs +++ b/Simulation/Aivika/Experiment/Chart/FinalHistogramView.hs @@ -7,9 +7,9 @@ -- License : BSD3 -- Maintainer : David Sorokin -- 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 diff --git a/Simulation/Aivika/Experiment/Chart/FinalXYChartView.hs b/Simulation/Aivika/Experiment/Chart/FinalXYChartView.hs --- a/Simulation/Aivika/Experiment/Chart/FinalXYChartView.hs +++ b/Simulation/Aivika/Experiment/Chart/FinalXYChartView.hs @@ -7,10 +7,11 @@ -- License : BSD3 -- Maintainer : David Sorokin -- 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 diff --git a/Simulation/Aivika/Experiment/Chart/HistogramView.hs b/Simulation/Aivika/Experiment/Chart/HistogramView.hs --- a/Simulation/Aivika/Experiment/Chart/HistogramView.hs +++ b/Simulation/Aivika/Experiment/Chart/HistogramView.hs @@ -7,11 +7,11 @@ -- License : BSD3 -- Maintainer : David Sorokin -- 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 diff --git a/Simulation/Aivika/Experiment/Chart/TimeSeriesView.hs b/Simulation/Aivika/Experiment/Chart/TimeSeriesView.hs --- a/Simulation/Aivika/Experiment/Chart/TimeSeriesView.hs +++ b/Simulation/Aivika/Experiment/Chart/TimeSeriesView.hs @@ -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 diff --git a/Simulation/Aivika/Experiment/Chart/Types.hs b/Simulation/Aivika/Experiment/Chart/Types.hs new file mode 100644 --- /dev/null +++ b/Simulation/Aivika/Experiment/Chart/Types.hs @@ -0,0 +1,28 @@ + +-- | +-- Module : Simulation.Aivika.Experiment.Chart.Types +-- Copyright : Copyright (c) 2012-2014, David Sorokin +-- License : BSD3 +-- Maintainer : David Sorokin +-- 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) diff --git a/Simulation/Aivika/Experiment/Chart/XYChartView.hs b/Simulation/Aivika/Experiment/Chart/XYChartView.hs --- a/Simulation/Aivika/Experiment/Chart/XYChartView.hs +++ b/Simulation/Aivika/Experiment/Chart/XYChartView.hs @@ -7,9 +7,9 @@ -- License : BSD3 -- Maintainer : David Sorokin -- 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 diff --git a/aivika-experiment-chart.cabal b/aivika-experiment-chart.cabal --- a/aivika-experiment-chart.cabal +++ b/aivika-experiment-chart.cabal @@ -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 diff --git a/examples/BassDiffusion/Experiment.hs b/examples/BassDiffusion/Experiment.hs --- a/examples/BassDiffusion/Experiment.hs +++ b/examples/BassDiffusion/Experiment.hs @@ -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" } ] diff --git a/examples/BassDiffusion/MainUsingCairo.hs b/examples/BassDiffusion/MainUsingCairo.hs --- a/examples/BassDiffusion/MainUsingCairo.hs +++ b/examples/BassDiffusion/MainUsingCairo.hs @@ -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 diff --git a/examples/BassDiffusion/MainUsingDiagrams.hs b/examples/BassDiffusion/MainUsingDiagrams.hs --- a/examples/BassDiffusion/MainUsingDiagrams.hs +++ b/examples/BassDiffusion/MainUsingDiagrams.hs @@ -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 diff --git a/examples/BassDiffusion/Model.hs b/examples/BassDiffusion/Model.hs --- a/examples/BassDiffusion/Model.hs +++ b/examples/BassDiffusion/Model.hs @@ -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] diff --git a/examples/ChemicalReaction/Experiment.hs b/examples/ChemicalReaction/Experiment.hs --- a/examples/ChemicalReaction/Experiment.hs +++ b/examples/ChemicalReaction/Experiment.hs @@ -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" } ] diff --git a/examples/ChemicalReaction/MainUsingCairo.hs b/examples/ChemicalReaction/MainUsingCairo.hs --- a/examples/ChemicalReaction/MainUsingCairo.hs +++ b/examples/ChemicalReaction/MainUsingCairo.hs @@ -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 diff --git a/examples/ChemicalReaction/MainUsingDiagrams.hs b/examples/ChemicalReaction/MainUsingDiagrams.hs --- a/examples/ChemicalReaction/MainUsingDiagrams.hs +++ b/examples/ChemicalReaction/MainUsingDiagrams.hs @@ -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 diff --git a/examples/ChemicalReaction/Model.hs b/examples/ChemicalReaction/Model.hs --- a/examples/ChemicalReaction/Model.hs +++ b/examples/ChemicalReaction/Model.hs @@ -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] diff --git a/examples/DifferenceEquations/Experiment.hs b/examples/DifferenceEquations/Experiment.hs --- a/examples/DifferenceEquations/Experiment.hs +++ b/examples/DifferenceEquations/Experiment.hs @@ -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" } ] diff --git a/examples/DifferenceEquations/MainUsingCairo.hs b/examples/DifferenceEquations/MainUsingCairo.hs --- a/examples/DifferenceEquations/MainUsingCairo.hs +++ b/examples/DifferenceEquations/MainUsingCairo.hs @@ -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 diff --git a/examples/DifferenceEquations/MainUsingDiagrams.hs b/examples/DifferenceEquations/MainUsingDiagrams.hs --- a/examples/DifferenceEquations/MainUsingDiagrams.hs +++ b/examples/DifferenceEquations/MainUsingDiagrams.hs @@ -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 diff --git a/examples/DifferenceEquations/Model.hs b/examples/DifferenceEquations/Model.hs --- a/examples/DifferenceEquations/Model.hs +++ b/examples/DifferenceEquations/Model.hs @@ -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] diff --git a/examples/Financial/Experiment.hs b/examples/Financial/Experiment.hs --- a/examples/Financial/Experiment.hs +++ b/examples/Financial/Experiment.hs @@ -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] } ] diff --git a/examples/Financial/MainUsingCairo.hs b/examples/Financial/MainUsingCairo.hs --- a/examples/Financial/MainUsingCairo.hs +++ b/examples/Financial/MainUsingCairo.hs @@ -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 diff --git a/examples/Financial/MainUsingDiagrams.hs b/examples/Financial/MainUsingDiagrams.hs --- a/examples/Financial/MainUsingDiagrams.hs +++ b/examples/Financial/MainUsingDiagrams.hs @@ -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 diff --git a/examples/Financial/Model.hs b/examples/Financial/Model.hs --- a/examples/Financial/Model.hs +++ b/examples/Financial/Model.hs @@ -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" diff --git a/examples/Furnace/Experiment.hs b/examples/Furnace/Experiment.hs --- a/examples/Furnace/Experiment.hs +++ b/examples/Furnace/Experiment.hs @@ -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 } ] diff --git a/examples/Furnace/MainUsingCairo.hs b/examples/Furnace/MainUsingCairo.hs --- a/examples/Furnace/MainUsingCairo.hs +++ b/examples/Furnace/MainUsingCairo.hs @@ -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 diff --git a/examples/Furnace/MainUsingDiagrams.hs b/examples/Furnace/MainUsingDiagrams.hs --- a/examples/Furnace/MainUsingDiagrams.hs +++ b/examples/Furnace/MainUsingDiagrams.hs @@ -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 diff --git a/examples/Furnace/Model.hs b/examples/Furnace/Model.hs --- a/examples/Furnace/Model.hs +++ b/examples/Furnace/Model.hs @@ -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" diff --git a/examples/InspectionAdjustmentStations/Experiment.hs b/examples/InspectionAdjustmentStations/Experiment.hs --- a/examples/InspectionAdjustmentStations/Experiment.hs +++ b/examples/InspectionAdjustmentStations/Experiment.hs @@ -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 } ] diff --git a/examples/InspectionAdjustmentStations/MainUsingCairo.hs b/examples/InspectionAdjustmentStations/MainUsingCairo.hs --- a/examples/InspectionAdjustmentStations/MainUsingCairo.hs +++ b/examples/InspectionAdjustmentStations/MainUsingCairo.hs @@ -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 diff --git a/examples/InspectionAdjustmentStations/MainUsingDiagrams.hs b/examples/InspectionAdjustmentStations/MainUsingDiagrams.hs --- a/examples/InspectionAdjustmentStations/MainUsingDiagrams.hs +++ b/examples/InspectionAdjustmentStations/MainUsingDiagrams.hs @@ -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 diff --git a/examples/InspectionAdjustmentStations/Model.hs b/examples/InspectionAdjustmentStations/Model.hs --- a/examples/InspectionAdjustmentStations/Model.hs +++ b/examples/InspectionAdjustmentStations/Model.hs @@ -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] diff --git a/examples/LinearArray/Experiment.hs b/examples/LinearArray/Experiment.hs --- a/examples/LinearArray/Experiment.hs +++ b/examples/LinearArray/Experiment.hs @@ -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 } ] diff --git a/examples/LinearArray/MainUsingCairo.hs b/examples/LinearArray/MainUsingCairo.hs --- a/examples/LinearArray/MainUsingCairo.hs +++ b/examples/LinearArray/MainUsingCairo.hs @@ -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) diff --git a/examples/LinearArray/MainUsingDiagrams.hs b/examples/LinearArray/MainUsingDiagrams.hs --- a/examples/LinearArray/MainUsingDiagrams.hs +++ b/examples/LinearArray/MainUsingDiagrams.hs @@ -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) diff --git a/examples/LinearArray/Model.hs b/examples/LinearArray/Model.hs --- a/examples/LinearArray/Model.hs +++ b/examples/LinearArray/Model.hs @@ -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] diff --git a/examples/MachRep3/Experiment.hs b/examples/MachRep3/Experiment.hs --- a/examples/MachRep3/Experiment.hs +++ b/examples/MachRep3/Experiment.hs @@ -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 } ] diff --git a/examples/MachRep3/MainUsingCairo.hs b/examples/MachRep3/MainUsingCairo.hs --- a/examples/MachRep3/MainUsingCairo.hs +++ b/examples/MachRep3/MainUsingCairo.hs @@ -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 diff --git a/examples/MachRep3/MainUsingDiagrams.hs b/examples/MachRep3/MainUsingDiagrams.hs --- a/examples/MachRep3/MainUsingDiagrams.hs +++ b/examples/MachRep3/MainUsingDiagrams.hs @@ -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 diff --git a/examples/MachRep3/Model.hs b/examples/MachRep3/Model.hs --- a/examples/MachRep3/Model.hs +++ b/examples/MachRep3/Model.hs @@ -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]