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 @@ -110,7 +110,7 @@ deviationChartDescription = "It shows the Deviation chart by rule 3-sigma.", deviationChartWidth = 640, deviationChartHeight = 480, - deviationChartFileName = UniqueFilePath "$TITLE", + deviationChartFileName = UniqueFilePath "DeviationChart", deviationChartTransform = id, deviationChartLeftYSeries = mempty, deviationChartRightYSeries = mempty, @@ -151,8 +151,9 @@ deviationChartStats :: [IOArray Int (SamplingStats Double)] } -- | Create a new state of the view. -newDeviationChart :: DeviationChartView -> Experiment -> r -> FilePath -> IO (DeviationChartViewState r) +newDeviationChart :: DeviationChartView -> Experiment -> r -> FilePath -> ExperimentWriter (DeviationChartViewState r) newDeviationChart view exp renderer dir = + liftIO $ do f <- newIORef Nothing l <- newMVar () r <- newMRef Nothing @@ -183,7 +184,7 @@ (newDeviationChartResults names (deviationChartExperiment st)) $ \results -> if (names /= deviationChartNames results) then error "Series with different names are returned for different runs: requireDeviationChartResults" - else results + else return results -- | Simulate the specified series. simulateDeviationChart :: DeviationChartViewState r -> ExperimentData -> Event DisposableEvent @@ -217,7 +218,7 @@ y' `seq` writeArray stats i y' -- | Plot the deviation chart after the simulation is complete. -finaliseDeviationChart :: WebPageCharting r => DeviationChartViewState r -> IO () +finaliseDeviationChart :: WebPageCharting r => DeviationChartViewState r -> ExperimentWriter () finaliseDeviationChart st = do let view = deviationChartView st title = deviationChartTitle view @@ -232,10 +233,15 @@ plotBottomAxis = deviationChartBottomAxis view plotLayout = deviationChartLayout view renderer = deviationChartRenderer st - results <- readMRef $ deviationChartResults st + file <- resolveFilePath (deviationChartDir st) $ + mapFilePath (flip replaceExtension $ renderableChartExtension renderer) $ + expandFilePath (deviationChartFileName view) $ + M.fromList [("$TITLE", title)] + results <- liftIO $ readMRef $ deviationChartResults st case results of Nothing -> return () Just results -> + liftIO $ do let times = deviationChartTimes results names = deviationChartNames results stats = deviationChartStats results @@ -284,10 +290,6 @@ layoutlr_title .~ plotTitle' $ layoutlr_plots .~ ps $ def - file <- resolveFilePath (deviationChartDir st) $ - mapFilePath (flip replaceExtension $ renderableChartExtension renderer) $ - expandFilePath (deviationChartFileName view) $ - M.fromList [("$TITLE", title)] renderChart renderer (width, height) file (toRenderable chart) when (experimentVerbose $ deviationChartExperiment st) $ putStr "Generated file " >> putStrLn file 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 @@ -103,7 +103,7 @@ finalHistogramDescription = "It shows a histogram by data gathered in the final time points.", finalHistogramWidth = 640, finalHistogramHeight = 480, - finalHistogramFileName = UniqueFilePath "$TITLE", + finalHistogramFileName = UniqueFilePath "FinalHistogram", finalHistogramPredicate = return True, finalHistogramBuild = histogram binSturges, finalHistogramTransform = id, @@ -141,8 +141,9 @@ finalHistogramValues :: [MRef [Double]] } -- | Create a new state of the view. -newFinalHistogram :: FinalHistogramView -> Experiment -> r -> FilePath -> IO (FinalHistogramViewState r) +newFinalHistogram :: FinalHistogramView -> Experiment -> r -> FilePath -> ExperimentWriter (FinalHistogramViewState r) newFinalHistogram view exp renderer dir = + liftIO $ do f <- newIORef Nothing r <- newMRef Nothing return FinalHistogramViewState { finalHistogramView = view, @@ -166,7 +167,7 @@ (newFinalHistogramResults names (finalHistogramExperiment st)) $ \results -> if (names /= finalHistogramNames results) then error "Series with different names are returned for different runs: requireFinalHistogramResults" - else results + else return results -- | Simulation of the specified series. simulateFinalHistogram :: FinalHistogramViewState r -> ExperimentData -> Event DisposableEvent @@ -187,10 +188,10 @@ do xs <- forM exts resultExtractData liftIO $ forM_ (zip xs values) $ \(x, values) -> - modifyMRef values $ (++) x + modifyMRef_ values $ return . (++) x -- | Plot the histogram after the simulation is complete. -finaliseFinalHistogram :: WebPageCharting r => FinalHistogramViewState r -> IO () +finaliseFinalHistogram :: WebPageCharting r => FinalHistogramViewState r -> ExperimentWriter () finaliseFinalHistogram st = do let view = finalHistogramView st title = finalHistogramTitle view @@ -204,10 +205,15 @@ bars = finalHistogramPlotBars view layout = finalHistogramLayout view renderer = finalHistogramRenderer st - results <- readMRef $ finalHistogramResults st + file <- resolveFilePath (finalHistogramDir st) $ + mapFilePath (flip replaceExtension $ renderableChartExtension renderer) $ + expandFilePath (finalHistogramFileName view) $ + M.fromList [("$TITLE", title)] + results <- liftIO $ readMRef $ finalHistogramResults st case results of Nothing -> return () Just results -> + liftIO $ do let names = finalHistogramNames results values = finalHistogramValues results xs <- forM values readMRef @@ -231,10 +237,6 @@ layout_title .~ plotTitle' $ layout_plots .~ [p] $ def - file <- resolveFilePath (finalHistogramDir st) $ - mapFilePath (flip replaceExtension $ renderableChartExtension renderer) $ - expandFilePath (finalHistogramFileName view) $ - M.fromList [("$TITLE", title)] renderChart renderer (width, height) file (toRenderable chart) when (experimentVerbose $ finalHistogramExperiment st) $ putStr "Generated file " >> putStrLn 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 @@ -118,7 +118,7 @@ finalXYChartDescription = "It shows the XY chart for the results in the final time points.", finalXYChartWidth = 640, finalXYChartHeight = 480, - finalXYChartFileName = UniqueFilePath "$TITLE", + finalXYChartFileName = UniqueFilePath "FinalXYChart", finalXYChartPredicate = return True, finalXYChartTransform = id, finalXYChartXSeries = mempty, @@ -160,8 +160,9 @@ finalXYChartXY :: [IOArray Int (Maybe (Double, Double))] } -- | Create a new state of the view. -newFinalXYChart :: FinalXYChartView -> Experiment -> r -> FilePath -> IO (FinalXYChartViewState r) +newFinalXYChart :: FinalXYChartView -> Experiment -> r -> FilePath -> ExperimentWriter (FinalXYChartViewState r) newFinalXYChart view exp renderer dir = + liftIO $ do f <- newIORef Nothing l <- newMVar () r <- newMRef Nothing @@ -190,7 +191,7 @@ (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 + else return results -- | Simulation. simulateFinalXYChart :: FinalXYChartViewState r -> ExperimentData -> Event DisposableEvent @@ -234,7 +235,7 @@ x `seq` y `seq` writeArray xy i $ Just (x, y) -- | Plot the XY chart after the simulation is complete. -finaliseFinalXYChart :: WebPageCharting r => FinalXYChartViewState r -> IO () +finaliseFinalXYChart :: WebPageCharting r => FinalXYChartViewState r -> ExperimentWriter () finaliseFinalXYChart st = do let view = finalXYChartView st title = finalXYChartTitle view @@ -248,10 +249,15 @@ plotBottomAxis = finalXYChartBottomAxis view plotLayout = finalXYChartLayout view renderer = finalXYChartRenderer st - results <- readMRef $ finalXYChartResults st + file <- resolveFilePath (finalXYChartDir st) $ + mapFilePath (flip replaceExtension $ renderableChartExtension renderer) $ + expandFilePath (finalXYChartFileName view) $ + M.fromList [("$TITLE", title)] + results <- liftIO $ readMRef $ finalXYChartResults st case results of Nothing -> return () Just results -> + liftIO $ do let xname = finalXYChartXName results ynames = finalXYChartYNames results xys = finalXYChartXY results @@ -282,10 +288,6 @@ layoutlr_title .~ plotTitle' $ layoutlr_plots .~ ps $ def - file <- resolveFilePath (finalXYChartDir st) $ - mapFilePath (flip replaceExtension $ renderableChartExtension renderer) $ - expandFilePath (finalXYChartFileName view) $ - M.fromList [("$TITLE", title)] renderChart renderer (width, height) file (toRenderable chart) when (experimentVerbose $ finalXYChartExperiment st) $ putStr "Generated file " >> putStrLn 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 @@ -112,7 +112,7 @@ histogramDescription = "It shows the histogram(s) by data gathered in the integration time points.", histogramWidth = 640, histogramHeight = 480, - histogramFileName = UniqueFilePath "$TITLE - $RUN_INDEX", + histogramFileName = UniqueFilePath "Histogram($RUN_INDEX)", histogramPredicate = return True, histogramBuild = histogram binSturges, histogramTransform = id, @@ -145,7 +145,7 @@ histogramMap :: M.Map Int FilePath } -- | Create a new state of the view. -newHistogram :: WebPageCharting r => HistogramView -> Experiment -> r -> FilePath -> IO (HistogramViewState r) +newHistogram :: WebPageCharting r => HistogramView -> Experiment -> r -> FilePath -> ExperimentWriter (HistogramViewState r) newHistogram view exp renderer dir = do let n = experimentRunCount exp fs <- forM [0..(n - 1)] $ \i -> @@ -155,7 +155,7 @@ M.fromList [("$TITLE", histogramTitle view), ("$RUN_INDEX", show $ i + 1), ("$RUN_COUNT", show n)] - forM_ fs $ flip writeFile [] -- reserve the file names + liftIO $ forM_ fs $ flip writeFile [] -- reserve the file names let m = M.fromList $ zip [0..(n - 1)] fs return HistogramViewState { histogramView = view, histogramExperiment = exp, 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 @@ -116,7 +116,7 @@ timeSeriesDescription = "It shows the Time Series chart(s).", timeSeriesWidth = 640, timeSeriesHeight = 480, - timeSeriesFileName = UniqueFilePath "$TITLE - $RUN_INDEX", + timeSeriesFileName = UniqueFilePath "TimeSeries($RUN_INDEX)", timeSeriesPredicate = return True, timeSeriesTransform = id, timeSeriesLeftYSeries = const mempty, @@ -150,7 +150,7 @@ timeSeriesMap :: M.Map Int FilePath } -- | Create a new state of the view. -newTimeSeries :: WebPageCharting r => TimeSeriesView -> Experiment -> r -> FilePath -> IO (TimeSeriesViewState r) +newTimeSeries :: WebPageCharting r => TimeSeriesView -> Experiment -> r -> FilePath -> ExperimentWriter (TimeSeriesViewState r) newTimeSeries view exp renderer dir = do let n = experimentRunCount exp fs <- forM [0..(n - 1)] $ \i -> @@ -160,7 +160,7 @@ M.fromList [("$TITLE", timeSeriesTitle view), ("$RUN_INDEX", show $ i + 1), ("$RUN_COUNT", show n)] - forM_ fs $ flip writeFile [] -- reserve the file names + liftIO $ forM_ fs $ flip writeFile [] -- reserve the file names let m = M.fromList $ zip [0..(n - 1)] fs return TimeSeriesViewState { timeSeriesView = view, timeSeriesExperiment = exp, 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 @@ -124,7 +124,7 @@ xyChartDescription = "It shows the XY chart(s).", xyChartWidth = 640, xyChartHeight = 480, - xyChartFileName = UniqueFilePath "$TITLE - $RUN_INDEX", + xyChartFileName = UniqueFilePath "XYChart($RUN_INDEX)", xyChartPredicate = return True, xyChartTransform = id, xyChartXSeries = mempty, @@ -159,7 +159,7 @@ xyChartMap :: M.Map Int FilePath } -- | Create a new state of the view. -newXYChart :: WebPageCharting r => XYChartView -> Experiment -> r -> FilePath -> IO (XYChartViewState r) +newXYChart :: WebPageCharting r => XYChartView -> Experiment -> r -> FilePath -> ExperimentWriter (XYChartViewState r) newXYChart view exp renderer dir = do let n = experimentRunCount exp fs <- forM [0..(n - 1)] $ \i -> @@ -169,7 +169,7 @@ M.fromList [("$TITLE", xyChartTitle view), ("$RUN_INDEX", show $ i + 1), ("$RUN_COUNT", show n)] - forM_ fs $ flip writeFile [] -- reserve the file names + liftIO $ forM_ fs $ flip writeFile [] -- reserve the file names let m = M.fromList $ zip [0..(n - 1)] fs return XYChartViewState { xyChartView = view, xyChartExperiment = exp, 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.4 +version: 2.1 synopsis: Simulation experiments with charting for the Aivika library description: This package complements the Aivika and Aivika Experiment packages with @@ -86,8 +86,8 @@ lens >= 3.9, data-default-class < 0.1, colour >= 2.3.3, - aivika >= 1.4, - aivika-experiment >= 1.4 + aivika >= 2.1, + aivika-experiment >= 2.1 extensions: FlexibleInstances, MultiParamTypeClasses diff --git a/examples/Financial/Experiment.hs b/examples/Financial/Experiment.hs --- a/examples/Financial/Experiment.hs +++ b/examples/Financial/Experiment.hs @@ -29,32 +29,36 @@ monteCarloGenerators = [outputView defaultExperimentSpecsView, outputView $ defaultDeviationChartView { - deviationChartTitle = "The deviation chart for Net Income and Cash Flow", + deviationChartTitle = "Chart 1", + deviationChartPlotTitle = "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", + deviationChartTitle = "Chart 2", + deviationChartPlotTitle = "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", + finalHistogramTitle = "Histogram 1", + finalHistogramPlotTitle = "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", + finalHistogramTitle = "Histogram 2", + finalHistogramPlotTitle = "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", + finalStatsTitle = "Summary 1", finalStatsSeries = resultByName netIncomeName <> resultByName netCashFlowName }, outputView $ defaultFinalStatsView { - finalStatsTitle = "Summary for Net Present Value of Income and Cash Flow", + finalStatsTitle = "Summary 2", finalStatsSeries = resultByName npvIncomeName <> resultByName npvCashFlowName } ] @@ -72,12 +76,14 @@ singleGenerators = [outputView defaultExperimentSpecsView, outputView $ defaultTimeSeriesView { - timeSeriesTitle = "Time series of Net Income and Cash Flow", + timeSeriesTitle = "Time Series 1", + timeSeriesPlotTitle = "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", + timeSeriesTitle = "Time Series 2", + timeSeriesPlotTitle = "Time series of Net Present Value for Income and Cash Flow", timeSeriesLeftYSeries = resultByName npvIncomeName <> resultByName npvCashFlowName },