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,8 @@ module Simulation.Aivika.Experiment.Chart (colourisePlotLines, - colourisePlotFillBetween) where + colourisePlotFillBetween, + colourisePlotBars) where import Data.Colour import Data.Colour.Names @@ -22,33 +23,16 @@ -- | Colourise the plot lines. colourisePlotLines :: [PlotLines x y -> PlotLines x y] -colourisePlotLines = - (plot_lines_style .> line_color ^= opaque blue) : - (plot_lines_style .> line_color ^= opaque green) : - (plot_lines_style .> line_color ^= opaque red) : - (plot_lines_style .> line_color ^= opaque black) : - (plot_lines_style .> line_color ^= opaque grey) : - (plot_lines_style .> line_color ^= opaque purple) : - (plot_lines_style .> line_color ^= opaque violet) : - (plot_lines_style .> line_color ^= opaque darkblue) : - (plot_lines_style .> line_color ^= opaque darkgreen) : - (plot_lines_style .> line_color ^= opaque darkgrey) : - (plot_lines_style .> line_color ^= opaque darkviolet) : - colourisePlotLines +colourisePlotLines = map mkstyle $ cycle defaultColorSeq + where mkstyle c = plot_lines_style .> line_color ^= c --- | Colourise the plot areas that are filling between --- any two lines. +-- | Colourise the filling areas. colourisePlotFillBetween :: [PlotFillBetween x y -> PlotFillBetween x y] -colourisePlotFillBetween = - (plot_fillbetween_style ^= solidFillStyle (withOpacity blue 0.4)) : - (plot_fillbetween_style ^= solidFillStyle (withOpacity green 0.4)) : - (plot_fillbetween_style ^= solidFillStyle (withOpacity red 0.4)) : - (plot_fillbetween_style ^= solidFillStyle (withOpacity black 0.4)) : - (plot_fillbetween_style ^= solidFillStyle (withOpacity grey 0.4)) : - (plot_fillbetween_style ^= solidFillStyle (withOpacity purple 0.4)) : - (plot_fillbetween_style ^= solidFillStyle (withOpacity violet 0.4)) : - (plot_fillbetween_style ^= solidFillStyle (withOpacity darkblue 0.4)) : - (plot_fillbetween_style ^= solidFillStyle (withOpacity darkgreen 0.4)) : - (plot_fillbetween_style ^= solidFillStyle (withOpacity darkgrey 0.4)) : - (plot_fillbetween_style ^= solidFillStyle (withOpacity darkviolet 0.4)) : - colourisePlotFillBetween +colourisePlotFillBetween = map mkstyle $ cycle defaultColorSeq + where mkstyle c = plot_fillbetween_style ^= solidFillStyle (dissolve 0.4 c) + +-- | Colourise the plot bars. +colourisePlotBars :: PlotBars x y -> PlotBars x y +colourisePlotBars = plot_bars_item_styles ^= map mkstyle (cycle defaultColorSeq) + where mkstyle c = (solidFillStyle c, Just $ solidLine 1.0 $ opaque black) + diff --git a/Simulation/Aivika/Experiment/DeviationChartView.hs b/Simulation/Aivika/Experiment/DeviationChartView.hs --- a/Simulation/Aivika/Experiment/DeviationChartView.hs +++ b/Simulation/Aivika/Experiment/DeviationChartView.hs @@ -8,7 +8,7 @@ -- Tested with: GHC 7.4.1 -- -- The module defines 'DeviationChartView' that saves the deviation --- chart as the PNG file. +-- chart in the PNG file. -- module Simulation.Aivika.Experiment.DeviationChartView @@ -51,9 +51,9 @@ -- in the PNG file. data DeviationChartView = DeviationChartView { deviationChartTitle :: String, - -- ^ This is a title used in HTML and chart. + -- ^ This is a title used in HTML. deviationChartDescription :: String, - -- ^ This is a description in the HTML. + -- ^ This is a description used in HTML. deviationChartWidth :: Int, -- ^ The width of the chart. deviationChartHeight :: Int, @@ -67,23 +67,29 @@ -- @ -- deviationChartFileName = UniqueFileName \"$TITLE\", \".png\" -- @ - deviationChartPredicate :: Dynamics Bool, - -- ^ It specifies the predicate that defines - -- when we count data when plotting the chart. deviationChartSeries :: [Either String String], -- ^ It contains the labels of data plotted - -- in the chart. + -- on the chart. + deviationChartPlotTitle :: String, + -- ^ This is a title used in the chart. + -- It may include special variable @$TITLE@. + -- + -- An example is + -- + -- @ + -- deviationChartPlotTitle = \"$TITLE\" + -- @ deviationChartPlotLines :: [PlotLines Double Double -> PlotLines Double Double], -- ^ Probably, an infinite sequence of plot -- transformations based on which the plot -- is constructed for each series. Generally, - -- it must not coincide with a sequence of + -- it may not coincide with a sequence of -- labels as one label may denote a whole list -- or an array of data providers. -- -- Here you can define a colour or style of - -- of the plot lines. + -- the plot lines. deviationChartPlotFillBetween :: [PlotFillBetween Double Double -> PlotFillBetween Double Double], -- ^ Corresponds exactly to 'deviationChartPlotLines' @@ -91,6 +97,10 @@ -- by the rule of 3-sigma, while the former -- is used for plotting the trends of the -- random processes. + deviationChartBottomAxis :: LayoutAxis Double -> + LayoutAxis Double, + -- ^ A transformation of the bottom axis, + -- after title @time@ is added. deviationChartLayout :: Layout1 Double Double -> Layout1 Double Double -- ^ A transformation of the plot layout, @@ -105,10 +115,11 @@ deviationChartWidth = 640, deviationChartHeight = 480, deviationChartFileName = UniqueFileName "$TITLE" ".png", - deviationChartPredicate = return True, deviationChartSeries = [], + deviationChartPlotTitle = "$TITLE", deviationChartPlotLines = colourisePlotLines, deviationChartPlotFillBetween = colourisePlotFillBetween, + deviationChartBottomAxis = id, deviationChartLayout = id } instance View DeviationChartView where @@ -141,9 +152,7 @@ -- | Create a new state of the view. newDeviationChart :: DeviationChartView -> Experiment -> FilePath -> IO DeviationChartViewState newDeviationChart view exp dir = - do let specs = experimentSpecs exp - bnds = integIterationBnds specs - f <- newIORef Nothing + do f <- newIORef Nothing l <- newMVar () r <- newIORef Nothing return DeviationChartViewState { deviationChartView = view, @@ -165,7 +174,7 @@ deviationChartNames = names, deviationChartStats = stats } --- | Plot the time series chart during the simulation. +-- | Simulate the specified series. simulateDeviationChart :: DeviationChartViewState -> ExperimentData -> Dynamics (Dynamics ()) simulateDeviationChart st expdata = do let protolabels = deviationChartSeries $ deviationChartView st @@ -187,7 +196,6 @@ case protoprovider of Left provider -> Left $ providerName provider Right provider -> Right $ providerName provider - predicate = deviationChartPredicate $ deviationChartView st exp = deviationChartExperiment st lock = deviationChartLock st results <- liftIO $ readIORef (deviationChartResults st) @@ -203,8 +211,7 @@ let stats = deviationChartStats results t0 <- starttime enqueue (experimentQueue expdata) t0 $ - do let h = filterSignalM (const predicate) $ - experimentSignalInIntegTimes expdata + do let h = experimentSignalInIntegTimes expdata -- we must subscribe through the event queue; -- otherwise, we will loose a signal in the start time, -- because the handleSignal_ function checks the event queue @@ -217,14 +224,18 @@ writeArray stats i $ addSamplingStats x y return $ return () --- | Plot the time series after the simulation is complete. +-- | Plot the deviation chart after the simulation is complete. finaliseDeviationChart :: DeviationChartViewState -> IO () finaliseDeviationChart st = do let title = deviationChartTitle $ deviationChartView st + plotTitle = + replace "$TITLE" title + (deviationChartPlotTitle $ deviationChartView st) width = deviationChartWidth $ deviationChartView st height = deviationChartHeight $ deviationChartView st plotLines = deviationChartPlotLines $ deviationChartView st plotFillBetween = deviationChartPlotFillBetween $ deviationChartView st + plotBottomAxis = deviationChartBottomAxis $ deviationChartView st plotLayout = deviationChartLayout $ deviationChartView st results <- readIORef $ deviationChartResults st case results of @@ -262,8 +273,12 @@ Left _ -> return $ Left p Right _ -> return $ Right p let ps = join $ flip map (zip ps1 ps2) $ \(p1, p2) -> [p2, p1] + axis = plotBottomAxis $ + laxis_title ^= "time" $ + defaultLayoutAxis chart = plotLayout $ - layout1_title ^= title $ + layout1_bottom_axis ^= axis $ + layout1_title ^= plotTitle $ layout1_plots ^= ps $ defaultLayout1 file <- resolveFileName @@ -284,8 +299,7 @@ -- | Remove the NaN and inifity values. filterPlotFillBetweenValues :: [(Double, (Double, Double))] -> [(Double, (Double, Double))] filterPlotFillBetweenValues = - join . filter (not . null) . - divideBy (\(t, (x1, x2)) -> isNaN x1 || isInfinite x1 || isNaN x2 || isInfinite x2) + filter $ \(t, (x1, x2)) -> not $ isNaN x1 || isInfinite x1 || isNaN x2 || isInfinite x2 -- | Get the HTML code. deviationChartHtml :: DeviationChartViewState -> Int -> HtmlWriter () diff --git a/Simulation/Aivika/Experiment/FinalHistogramView.hs b/Simulation/Aivika/Experiment/FinalHistogramView.hs new file mode 100644 --- /dev/null +++ b/Simulation/Aivika/Experiment/FinalHistogramView.hs @@ -0,0 +1,285 @@ + +-- | +-- Module : Simulation.Aivika.Experiment.FinalHistogramView +-- Copyright : Copyright (c) 2012, David Sorokin +-- License : BSD3 +-- Maintainer : David Sorokin +-- Stability : experimental +-- Tested with: GHC 7.4.1 +-- +-- The module defines 'FinalHistogramView' that draws a histogram +-- by the specified series in final time points collected from different +-- simulation runs. +-- + +module Simulation.Aivika.Experiment.FinalHistogramView + (FinalHistogramView(..), + defaultFinalHistogramView) where + +import Control.Monad +import Control.Monad.Trans +import Control.Concurrent.MVar + +import qualified Data.Map as M +import Data.IORef +import Data.Maybe +import Data.Either +import Data.Array +import Data.Array.IO + +import Data.Accessor + +import System.IO +import System.FilePath + +import Data.String.Utils (replace) + +import Graphics.Rendering.Chart + +import Simulation.Aivika.Experiment +import Simulation.Aivika.Experiment.HtmlWriter +import Simulation.Aivika.Experiment.Utils (divideBy) +import Simulation.Aivika.Experiment.Chart (colourisePlotBars) +import Simulation.Aivika.Experiment.Histogram + +import Simulation.Aivika.Dynamics +import Simulation.Aivika.Dynamics.Simulation +import Simulation.Aivika.Dynamics.Signal +import Simulation.Aivika.Dynamics.EventQueue +import Simulation.Aivika.Dynamics.Base (starttime, integIterationBnds, integTimes, integIteration) + +-- | Defines the 'View' that saves the histogram +-- in the PNG file by the specified series in +-- final time points collected from different +-- simulation runs. +data FinalHistogramView = + FinalHistogramView { finalHistogramTitle :: String, + -- ^ This is a title used in HTML. + finalHistogramDescription :: String, + -- ^ This is a description used in HTML. + finalHistogramWidth :: Int, + -- ^ The width of the histogram. + finalHistogramHeight :: Int, + -- ^ The height of the histogram. + finalHistogramFileName :: FileName, + -- ^ It defines the file name for the PNG file. + -- It may include special variable @$TITLE@. + -- + -- An example is + -- + -- @ + -- finalHistogramFileName = UniqueFileName \"$TITLE\", \".png\" + -- @ + finalHistogramPredicate :: Dynamics Bool, + -- ^ It specifies the predicate that defines + -- when we count data when plotting the histogram. + finalHistogramBuild :: [[Double]] -> Histogram, + -- ^ Builds a histogram by the specified list of + -- data series. + finalHistogramSeries :: [String], + -- ^ It contains the labels of data plotted + -- on the histogram. + finalHistogramPlotTitle :: String, + -- ^ This is a title used in the histogram. + -- It may include special variable @$TITLE@. + -- + -- An example is + -- + -- @ + -- finalHistogramPlotTitle = \"$TITLE\" + -- @ + finalHistogramPlotBars :: PlotBars Double Double -> + PlotBars Double Double, + -- ^ A transformation based on which the plot bar + -- is constructed for the series. + -- + -- Here you can define a colour or style of + -- the plot bars. + finalHistogramLayout :: Layout1 Double Double -> + Layout1 Double Double + -- ^ A transformation of the plot layout, + -- where you can redefine the axes, for example. + } + +-- | The default histogram view. +defaultFinalHistogramView :: FinalHistogramView +defaultFinalHistogramView = + FinalHistogramView { finalHistogramTitle = "Final Histogram", + finalHistogramDescription = [], + finalHistogramWidth = 640, + finalHistogramHeight = 480, + finalHistogramFileName = UniqueFileName "$TITLE" ".png", + finalHistogramPredicate = return True, + finalHistogramBuild = histogram binSturges, + finalHistogramSeries = [], + finalHistogramPlotTitle = "$TITLE", + finalHistogramPlotBars = colourisePlotBars, + finalHistogramLayout = id } + +instance View FinalHistogramView where + + outputView v = + let reporter exp dir = + do st <- newFinalHistogram v exp dir + return Reporter { reporterInitialise = return (), + reporterFinalise = finaliseFinalHistogram st, + reporterSimulate = simulateFinalHistogram st, + reporterTOCHtml = finalHistogramTOCHtml st, + reporterHtml = finalHistogramHtml st } + in Generator { generateReporter = reporter } + +-- | The state of the view. +data FinalHistogramViewState = + FinalHistogramViewState { finalHistogramView :: FinalHistogramView, + finalHistogramExperiment :: Experiment, + finalHistogramDir :: FilePath, + finalHistogramFile :: IORef (Maybe FilePath), + finalHistogramLock :: MVar (), + finalHistogramResults :: IORef (Maybe FinalHistogramResults) } + +-- | The histogram item. +data FinalHistogramResults = + FinalHistogramResults { finalHistogramNames :: [String], + finalHistogramValues :: [IORef [Double]] } + +-- | Create a new state of the view. +newFinalHistogram :: FinalHistogramView -> Experiment -> FilePath -> IO FinalHistogramViewState +newFinalHistogram view exp dir = + do f <- newIORef Nothing + l <- newMVar () + r <- newIORef Nothing + return FinalHistogramViewState { finalHistogramView = view, + finalHistogramExperiment = exp, + finalHistogramDir = dir, + finalHistogramFile = f, + finalHistogramLock = l, + finalHistogramResults = r } + +-- | Create new histogram results. +newFinalHistogramResults :: [String] -> Experiment -> IO FinalHistogramResults +newFinalHistogramResults names exp = + do values <- forM names $ \_ -> liftIO $ newIORef [] + return FinalHistogramResults { finalHistogramNames = names, + finalHistogramValues = values } + +-- | Simulation the specified series. +simulateFinalHistogram :: FinalHistogramViewState -> ExperimentData -> Dynamics (Dynamics ()) +simulateFinalHistogram st expdata = + do let protolabels = finalHistogramSeries $ finalHistogramView st + protoproviders = flip map protolabels $ \protolabel -> + experimentSeriesProviders expdata [protolabel] + providers = concat protoproviders + input = + flip map providers $ \provider -> + case providerToDouble provider of + Nothing -> error $ + "Cannot represent series " ++ + providerName provider ++ + " as double values: simulateFinalHistogram" + Just input -> input + names = map providerName providers + predicate = finalHistogramPredicate $ finalHistogramView st + exp = finalHistogramExperiment st + lock = finalHistogramLock st + results <- liftIO $ readIORef (finalHistogramResults st) + case results of + Nothing -> + liftIO $ + do results <- newFinalHistogramResults names exp + writeIORef (finalHistogramResults st) $ Just results + Just results -> + when (names /= finalHistogramNames results) $ + error "Series with different names are returned for different runs: simulateFinalHistogram" + results <- liftIO $ fmap fromJust $ readIORef (finalHistogramResults st) + let values = finalHistogramValues results + t0 <- starttime + enqueue (experimentQueue expdata) t0 $ + do let h = filterSignalM (const predicate) $ + experimentSignalInStopTime expdata + -- we must subscribe through the event queue; + -- otherwise, we will loose a signal in the start time, + -- because the handleSignal_ function checks the event queue + handleSignal_ h $ \_ -> + do xs <- sequence input + liftIO $ withMVar lock $ \() -> + forM_ (zip xs values) $ \(x, values) -> + modifyIORef values (x :) + return $ return () + +-- | Plot the histogram after the simulation is complete. +finaliseFinalHistogram :: FinalHistogramViewState -> IO () +finaliseFinalHistogram st = + do let title = finalHistogramTitle $ finalHistogramView st + plotTitle = + replace "$TITLE" title + (finalHistogramPlotTitle $ finalHistogramView st) + width = finalHistogramWidth $ finalHistogramView st + height = finalHistogramHeight $ finalHistogramView st + histogram = finalHistogramBuild $ finalHistogramView st + bars = finalHistogramPlotBars $ finalHistogramView st + layout = finalHistogramLayout $ finalHistogramView st + results <- readIORef $ finalHistogramResults st + case results of + Nothing -> return () + Just results -> + do let names = finalHistogramNames results + values = finalHistogramValues results + xs <- forM values readIORef + let zs = histogramToBars . filterHistogram . histogram $ + map filterData xs + p = plotBars $ + bars $ + plot_bars_values ^= zs $ + plot_bars_titles ^= names $ + defaultPlotBars + let chart = layout $ + layout1_title ^= plotTitle $ + layout1_plots ^= [Left p] $ + defaultLayout1 + file <- resolveFileName + (Just $ finalHistogramDir st) + (finalHistogramFileName $ finalHistogramView st) $ + M.fromList [("$TITLE", title)] + renderableToPNGFile (toRenderable chart) width height file + when (experimentVerbose $ finalHistogramExperiment st) $ + putStr "Generated file " >> putStrLn file + writeIORef (finalHistogramFile st) $ Just file + +-- | Remove the NaN and inifity values. +filterData :: [Double] -> [Double] +filterData = filter (\x -> not $ isNaN x || isInfinite x) + +-- | Remove the NaN and inifity values. +filterHistogram :: [(Double, a)] -> [(Double, a)] +filterHistogram = filter (\(x, _) -> not $ isNaN x || isInfinite x) + +-- | Convert a histogram to the bars. +histogramToBars :: [(Double, [Int])] -> [(Double, [Double])] +histogramToBars = map $ \(x, ns) -> (x, map fromIntegral ns) + +-- | Get the HTML code. +finalHistogramHtml :: FinalHistogramViewState -> Int -> HtmlWriter () +finalHistogramHtml st index = + do header st index + file <- liftIO $ readIORef (finalHistogramFile st) + case file of + Nothing -> return () + Just f -> + writeHtmlParagraph $ + writeHtmlImage (makeRelative (finalHistogramDir st) f) + +header :: FinalHistogramViewState -> Int -> HtmlWriter () +header st index = + do writeHtmlHeader3WithId ("id" ++ show index) $ + writeHtmlText (finalHistogramTitle $ finalHistogramView st) + let description = finalHistogramDescription $ finalHistogramView st + unless (null description) $ + writeHtmlParagraph $ + writeHtmlText description + +-- | Get the TOC item. +finalHistogramTOCHtml :: FinalHistogramViewState -> Int -> HtmlWriter () +finalHistogramTOCHtml st index = + writeHtmlListItem $ + writeHtmlLink ("#id" ++ show index) $ + writeHtmlText (finalHistogramTitle $ finalHistogramView st) diff --git a/Simulation/Aivika/Experiment/FinalXYChartView.hs b/Simulation/Aivika/Experiment/FinalXYChartView.hs new file mode 100644 --- /dev/null +++ b/Simulation/Aivika/Experiment/FinalXYChartView.hs @@ -0,0 +1,325 @@ + +-- | +-- Module : Simulation.Aivika.Experiment.FinalXYChartView +-- Copyright : Copyright (c) 2012, David Sorokin +-- License : BSD3 +-- Maintainer : David Sorokin +-- Stability : experimental +-- Tested with: GHC 7.4.1 +-- +-- The module defines 'FinalXYChartView' that saves the XY chart +-- by final time points for all simulation runs sequentially. +-- + +module Simulation.Aivika.Experiment.FinalXYChartView + (FinalXYChartView(..), + defaultFinalXYChartView) where + +import Control.Monad +import Control.Monad.Trans +import Control.Concurrent.MVar + +import qualified Data.Map as M +import Data.IORef +import Data.Maybe +import Data.Either +import Data.Array +import Data.Array.IO + +import Data.Accessor + +import System.IO +import System.FilePath + +import Data.String.Utils (replace) + +import Graphics.Rendering.Chart + +import Simulation.Aivika.Experiment +import Simulation.Aivika.Experiment.HtmlWriter +import Simulation.Aivika.Experiment.Utils (divideBy) +import Simulation.Aivika.Experiment.Chart (colourisePlotLines) + +import Simulation.Aivika.Dynamics +import Simulation.Aivika.Dynamics.Simulation +import Simulation.Aivika.Dynamics.Signal +import Simulation.Aivika.Dynamics.EventQueue +import Simulation.Aivika.Dynamics.Base (time) + +-- | Defines the 'View' that saves the XY chart +-- in the PNG file by final time points for all +-- simulation runs sequentially. +data FinalXYChartView = + FinalXYChartView { finalXYChartTitle :: String, + -- ^ This is a title used HTML. + finalXYChartDescription :: String, + -- ^ This is a description used in HTML. + finalXYChartWidth :: Int, + -- ^ The width of the chart. + finalXYChartHeight :: Int, + -- ^ The height of the chart. + finalXYChartFileName :: FileName, + -- ^ It defines the file name for the PNG file. + -- It may include special variable @$TITLE@. + -- + -- An example is + -- + -- @ + -- finalXYChartFileName = UniqueFileName \"$TITLE\", \".png\" + -- @ + finalXYChartPredicate :: Dynamics Bool, + -- ^ It specifies the predicate that defines + -- when we count data when plotting the chart. + finalXYChartXSeries :: Maybe String, + -- ^ It defines a label of the single X series. + -- + -- You must define it, because it is 'Nothing' + -- by default. + finalXYChartYSeries :: [Either String String], + -- ^ It contains the labels of Y series plotted + -- on the chart. + finalXYChartPlotTitle :: String, + -- ^ This is a title used in the chart. + -- It may include special variable @$TITLE@. + -- + -- An example is + -- + -- @ + -- finalXYChartPlotTitle = \"$TITLE\" + -- @ + finalXYChartPlotLines :: [PlotLines Double Double -> + PlotLines Double Double], + -- ^ Probably, an infinite sequence of plot + -- transformations based on which the plot + -- is constructed for each series. Generally, + -- it may not coincide with a sequence of + -- labels as one label may denote a whole list + -- or an array of data providers. + -- + -- Here you can define a colour or style of + -- the plot lines. + finalXYChartBottomAxis :: LayoutAxis Double -> + LayoutAxis Double, + -- ^ A transformation of the bottom axis, + -- after the X title is added. + finalXYChartLayout :: Layout1 Double Double -> + Layout1 Double Double + -- ^ A transformation of the plot layout, + -- where you can redefine the axes, for example. + } + +-- | The default XY chart view. +defaultFinalXYChartView :: FinalXYChartView +defaultFinalXYChartView = + FinalXYChartView { finalXYChartTitle = "Final XY Chart", + finalXYChartDescription = [], + finalXYChartWidth = 640, + finalXYChartHeight = 480, + finalXYChartFileName = UniqueFileName "$TITLE" ".png", + finalXYChartPredicate = return True, + finalXYChartXSeries = Nothing, + finalXYChartYSeries = [], + finalXYChartPlotTitle = "$TITLE", + finalXYChartPlotLines = colourisePlotLines, + finalXYChartBottomAxis = id, + finalXYChartLayout = id } + +instance View FinalXYChartView where + + outputView v = + let reporter exp dir = + do st <- newFinalXYChart v exp dir + return Reporter { reporterInitialise = return (), + reporterFinalise = finaliseFinalXYChart st, + reporterSimulate = simulateFinalXYChart st, + reporterTOCHtml = finalXYChartTOCHtml st, + reporterHtml = finalXYChartHtml st } + in Generator { generateReporter = reporter } + +-- | The state of the view. +data FinalXYChartViewState = + FinalXYChartViewState { finalXYChartView :: FinalXYChartView, + finalXYChartExperiment :: Experiment, + finalXYChartDir :: FilePath, + finalXYChartFile :: IORef (Maybe FilePath), + finalXYChartLock :: MVar (), + finalXYChartResults :: IORef (Maybe FinalXYChartResults) } + +-- | The XY chart results. +data FinalXYChartResults = + FinalXYChartResults { finalXYChartXName :: String, + finalXYChartYNames :: [Either String String], + finalXYChartXY :: [IOArray Int (Maybe (Double, Double))] } + +-- | Create a new state of the view. +newFinalXYChart :: FinalXYChartView -> Experiment -> FilePath -> IO FinalXYChartViewState +newFinalXYChart view exp dir = + do f <- newIORef Nothing + l <- newMVar () + r <- newIORef Nothing + return FinalXYChartViewState { finalXYChartView = view, + finalXYChartExperiment = exp, + finalXYChartDir = dir, + finalXYChartFile = f, + finalXYChartLock = l, + finalXYChartResults = r } + +-- | Create new chart results. +newFinalXYChartResults :: String -> [Either String String] -> Experiment -> IO FinalXYChartResults +newFinalXYChartResults xname ynames exp = + do let n = experimentRunCount exp + xy <- forM ynames $ \_ -> + liftIO $ newArray (1, n) Nothing + return FinalXYChartResults { finalXYChartXName = xname, + finalXYChartYNames = ynames, + finalXYChartXY = xy } + +-- | Simulation. +simulateFinalXYChart :: FinalXYChartViewState -> ExperimentData -> Dynamics (Dynamics ()) +simulateFinalXYChart st expdata = + do let yprotolabels = finalXYChartYSeries $ finalXYChartView st + xprotolabel = finalXYChartXSeries $ finalXYChartView st + ylabels = flip map yprotolabels $ either id id + xlabel = flip fromMaybe xprotolabel $ + error "X series is not provided: simulateFinalXYChart" + yprotoproviders = flip map yprotolabels $ \protolabel -> + case protolabel of + Left label -> map Left $ experimentSeriesProviders expdata [label] + Right label -> map Right $ experimentSeriesProviders expdata [label] + joinedproviders = join yprotoproviders + yproviders = flip map joinedproviders $ either id id + xprovider = + case experimentSeriesProviders expdata [xlabel] of + [provider] -> provider + _ -> error $ + "Only a single X series must be" ++ + " provided: simulateFinalXYChart" + ys = input yproviders + [x] = input [xprovider] + input providers = + flip map providers $ \provider -> + case providerToDouble provider of + Nothing -> error $ + "Cannot represent series " ++ + providerName provider ++ + " as double values: simulateFinalXYChart" + Just input -> input + ynames = flip map joinedproviders $ \protoprovider -> + case protoprovider of + Left provider -> Left $ providerName provider + Right provider -> Right $ providerName provider + xname = providerName xprovider + predicate = finalXYChartPredicate $ finalXYChartView st + exp = finalXYChartExperiment st + lock = finalXYChartLock st + results <- liftIO $ readIORef (finalXYChartResults st) + case results of + Nothing -> + liftIO $ + do results <- newFinalXYChartResults xname ynames exp + writeIORef (finalXYChartResults st) $ Just results + Just results -> + let diffnames = + (xname /= finalXYChartXName results) || + (ynames /= finalXYChartYNames results) + in when diffnames $ + error "Series with different names are returned for different runs: simulateFinalXYChart" + results <- liftIO $ fmap fromJust $ readIORef (finalXYChartResults st) + let xys = finalXYChartXY results + t <- time + enqueue (experimentQueue expdata) t $ + do let h = filterSignalM (const predicate) $ + experimentSignalInStopTime expdata + -- we must subscribe through the event queue; + -- otherwise, we will loose a signal in the start time, + -- because the handleSignal_ function checks the event queue + handleSignal_ h $ \_ -> + do x' <- x + ys' <- sequence ys + i <- liftSimulation simulationIndex + liftIO $ withMVar lock $ \() -> + forM_ (zip ys' xys) $ \(y', xy) -> + writeArray xy i $ Just (x', y') + return $ return () + +-- | Plot the XY chart after the simulation is complete. +finaliseFinalXYChart :: FinalXYChartViewState -> IO () +finaliseFinalXYChart st = + do let title = finalXYChartTitle $ finalXYChartView st + plotTitle = + replace "$TITLE" title + (finalXYChartPlotTitle $ finalXYChartView st) + width = finalXYChartWidth $ finalXYChartView st + height = finalXYChartHeight $ finalXYChartView st + plotLines = finalXYChartPlotLines $ finalXYChartView st + plotBottomAxis = finalXYChartBottomAxis $ finalXYChartView st + plotLayout = finalXYChartLayout $ finalXYChartView st + results <- readIORef $ finalXYChartResults st + case results of + Nothing -> return () + Just results -> + do let xname = finalXYChartXName results + ynames = finalXYChartYNames results + xys = finalXYChartXY results + ps <- forM (zip3 ynames xys plotLines) $ \(name, xy, plotLines) -> + do zs <- getElems xy + let p = toPlot $ + plotLines $ + plot_lines_values ^= filterPlotLinesValues zs $ + plot_lines_title ^= either id id name $ + defaultPlotLines + r = case name of + Left _ -> Left p + Right _ -> Right p + return r + let axis = plotBottomAxis $ + laxis_title ^= xname $ + defaultLayoutAxis + chart = plotLayout $ + layout1_bottom_axis ^= axis $ + layout1_title ^= plotTitle $ + layout1_plots ^= ps $ + defaultLayout1 + file <- resolveFileName + (Just $ finalXYChartDir st) + (finalXYChartFileName $ finalXYChartView st) $ + M.fromList [("$TITLE", title)] + renderableToPNGFile (toRenderable chart) width height file + when (experimentVerbose $ finalXYChartExperiment st) $ + putStr "Generated file " >> putStrLn file + writeIORef (finalXYChartFile st) $ Just file + +-- | Remove the NaN and inifity values. +filterPlotLinesValues :: [Maybe (Double, Double)] -> [[(Double, Double)]] +filterPlotLinesValues = + filter (not . null) . map (map fromJust) . divideBy pred + where pred Nothing = True + pred (Just (x, y)) = isNaN x || isInfinite x || + isNaN y || isInfinite y + +-- | Get the HTML code. +finalXYChartHtml :: FinalXYChartViewState -> Int -> HtmlWriter () +finalXYChartHtml st index = + do header st index + file <- liftIO $ readIORef (finalXYChartFile st) + case file of + Nothing -> return () + Just f -> + writeHtmlParagraph $ + writeHtmlImage (makeRelative (finalXYChartDir st) f) + +header :: FinalXYChartViewState -> Int -> HtmlWriter () +header st index = + do writeHtmlHeader3WithId ("id" ++ show index) $ + writeHtmlText (finalXYChartTitle $ finalXYChartView st) + let description = finalXYChartDescription $ finalXYChartView st + unless (null description) $ + writeHtmlParagraph $ + writeHtmlText description + +-- | Get the TOC item. +finalXYChartTOCHtml :: FinalXYChartViewState -> Int -> HtmlWriter () +finalXYChartTOCHtml st index = + writeHtmlListItem $ + writeHtmlLink ("#id" ++ show index) $ + writeHtmlText (finalXYChartTitle $ finalXYChartView st) diff --git a/Simulation/Aivika/Experiment/HistogramView.hs b/Simulation/Aivika/Experiment/HistogramView.hs new file mode 100644 --- /dev/null +++ b/Simulation/Aivika/Experiment/HistogramView.hs @@ -0,0 +1,273 @@ + +-- | +-- Module : Simulation.Aivika.Experiment.HistogramView +-- Copyright : Copyright (c) 2012, David Sorokin +-- License : BSD3 +-- Maintainer : David Sorokin +-- Stability : experimental +-- Tested with: GHC 7.4.1 +-- +-- The module defines 'HistogramView' that saves the histogram +-- in the PNG files by all integration time points for each +-- simulation run separately. +-- + +module Simulation.Aivika.Experiment.HistogramView + (HistogramView(..), + defaultHistogramView) where + +import Control.Monad +import Control.Monad.Trans + +import qualified Data.Map as M +import Data.IORef +import Data.Maybe +import Data.Either +import Data.Array + +import Data.Accessor + +import System.IO +import System.FilePath + +import Data.String.Utils (replace) + +import Graphics.Rendering.Chart + +import Simulation.Aivika.Experiment +import Simulation.Aivika.Experiment.HtmlWriter +import Simulation.Aivika.Experiment.Utils (divideBy) +import Simulation.Aivika.Experiment.Chart (colourisePlotBars) +import Simulation.Aivika.Experiment.Histogram + +import Simulation.Aivika.Dynamics +import Simulation.Aivika.Dynamics.Simulation +import Simulation.Aivika.Dynamics.Signal +import Simulation.Aivika.Dynamics.EventQueue + +-- | Defines the 'View' that saves the histogram in +-- the PNG files by all integration time points for +-- each simulation run separately. +data HistogramView = + HistogramView { histogramTitle :: String, + -- ^ This is a title used in HTML. + histogramDescription :: String, + -- ^ This is a description used in HTML. + histogramWidth :: Int, + -- ^ The width of the histogram. + histogramHeight :: Int, + -- ^ The height of the histogram. + histogramFileName :: FileName, + -- ^ It defines the file name for each PNG file. + -- It may include special variables @$TITLE@, + -- @$RUN_INDEX@ and @$RUN_COUNT@. + -- + -- An example is + -- + -- @ + -- histogramFileName = UniqueFileName \"$TITLE - $RUN_INDEX\", \".png\" + -- @ + histogramPredicate :: Dynamics Bool, + -- ^ It specifies the predicate that defines + -- when we count data when plotting the histogram. + histogramBuild :: [[Double]] -> Histogram, + -- ^ Builds a histogram by the specified list of + -- data series. + histogramSeries :: [String], + -- ^ It contains the labels of data for which + -- the histogram is plotted. + histogramPlotTitle :: String, + -- ^ This is a title used in the histogram when + -- simulating a single run. It may include + -- special variable @$TITLE@. + -- + -- An example is + -- + -- @ + -- histogramPlotTitle = \"$TITLE\" + -- @ + histogramRunPlotTitle :: String, + -- ^ The run title for the histogram. It is used + -- when simulating multiple runs and it may + -- include special variables @$RUN_INDEX@, + -- @$RUN_COUNT@ and @$PLOT_TITLE@. + -- + -- An example is + -- + -- @ + -- histogramRunPlotTitle = \"$PLOT_TITLE / Run $RUN_INDEX of $RUN_COUNT\" + -- @ + histogramPlotBars :: PlotBars Double Double -> + PlotBars Double Double, + -- ^ A transformation based on which the plot bar + -- is constructed for the series. + -- + -- Here you can define a colour or style of + -- the plot bars. + histogramLayout :: Layout1 Double Double -> + Layout1 Double Double + -- ^ A transformation of the plot layout, + -- where you can redefine the axes, for example. + } + +-- | The default histogram view. +defaultHistogramView :: HistogramView +defaultHistogramView = + HistogramView { histogramTitle = "Histogram", + histogramDescription = [], + histogramWidth = 640, + histogramHeight = 480, + histogramFileName = UniqueFileName "$TITLE - $RUN_INDEX" ".png", + histogramPredicate = return True, + histogramBuild = histogram binSturges, + histogramSeries = [], + histogramPlotTitle = "$TITLE", + histogramRunPlotTitle = "$PLOT_TITLE / Run $RUN_INDEX of $RUN_COUNT", + histogramPlotBars = colourisePlotBars, + histogramLayout = id } + +instance View HistogramView where + + outputView v = + let reporter exp dir = + do st <- newHistogram v exp dir + return Reporter { reporterInitialise = return (), + reporterFinalise = return (), + reporterSimulate = simulateHistogram st, + reporterTOCHtml = histogramTOCHtml st, + reporterHtml = histogramHtml st } + in Generator { generateReporter = reporter } + +-- | The state of the view. +data HistogramViewState = + HistogramViewState { histogramView :: HistogramView, + histogramExperiment :: Experiment, + histogramDir :: FilePath, + histogramMap :: M.Map Int FilePath } + +-- | Create a new state of the view. +newHistogram :: HistogramView -> Experiment -> FilePath -> IO HistogramViewState +newHistogram view exp dir = + do let n = experimentRunCount exp + fs <- forM [0..(n - 1)] $ \i -> + resolveFileName (Just dir) (histogramFileName view) $ + M.fromList [("$TITLE", histogramTitle view), + ("$RUN_INDEX", show $ i + 1), + ("$RUN_COUNT", show n)] + forM_ fs $ flip writeFile [] -- reserve the file names + let m = M.fromList $ zip [0..(n - 1)] fs + return HistogramViewState { histogramView = view, + histogramExperiment = exp, + histogramDir = dir, + histogramMap = m } + +-- | Plot the histogram during the simulation. +simulateHistogram :: HistogramViewState -> ExperimentData -> Dynamics (Dynamics ()) +simulateHistogram st expdata = + do let labels = histogramSeries $ histogramView st + providers = experimentSeriesProviders expdata labels + names = map providerName providers + input = + flip map providers $ \provider -> + case providerToDouble provider of + Nothing -> error $ + "Cannot represent series " ++ + providerName provider ++ + " as double values: simulateHistogram" + Just input -> input + n = experimentRunCount $ histogramExperiment st + width = histogramWidth $ histogramView st + height = histogramHeight $ histogramView st + predicate = histogramPredicate $ histogramView st + bars = histogramPlotBars $ histogramView st + layout = histogramLayout $ histogramView st + build = histogramBuild $ histogramView st + i <- liftSimulation simulationIndex + let file = fromJust $ M.lookup (i - 1) (histogramMap st) + title = histogramTitle $ histogramView st + plotTitle = + replace "$TITLE" title + (histogramPlotTitle $ histogramView st) + runPlotTitle = + if n == 1 + then plotTitle + else replace "$RUN_INDEX" (show i) $ + replace "$RUN_COUNT" (show n) $ + replace "$PLOT_TITLE" plotTitle + (histogramRunPlotTitle $ histogramView st) + hs <- forM (zip providers input) $ \(provider, input) -> + newSignalHistoryThrough (experimentQueue expdata) $ + mapSignalM (const input) $ + filterSignalM (const predicate) $ + experimentSignalInIntegTimes expdata + return $ + do xs <- forM hs readSignalHistory + let zs = histogramToBars . filterHistogram . build $ + map (filterData . elems . snd) xs + p = plotBars $ + bars $ + plot_bars_values ^= zs $ + plot_bars_titles ^= names $ + defaultPlotBars + chart = layout $ + layout1_title ^= runPlotTitle $ + layout1_plots ^= [Left p] $ + defaultLayout1 + liftIO $ + do renderableToPNGFile (toRenderable chart) width height file + when (experimentVerbose $ histogramExperiment st) $ + putStr "Generated file " >> putStrLn file + +-- | Remove the NaN and inifity values. +filterData :: [Double] -> [Double] +filterData = filter (\x -> not $ isNaN x || isInfinite x) + +-- | Remove the NaN and inifity values. +filterHistogram :: [(Double, a)] -> [(Double, a)] +filterHistogram = filter (\(x, _) -> not $ isNaN x || isInfinite x) + +-- | Convert a histogram to the bars. +histogramToBars :: [(Double, [Int])] -> [(Double, [Double])] +histogramToBars = map $ \(x, ns) -> (x, map fromIntegral ns) + +-- | Get the HTML code. +histogramHtml :: HistogramViewState -> Int -> HtmlWriter () +histogramHtml st index = + let n = experimentRunCount $ histogramExperiment st + in if n == 1 + then histogramHtmlSingle st index + else histogramHtmlMultiple st index + +-- | Get the HTML code for a single run. +histogramHtmlSingle :: HistogramViewState -> Int -> HtmlWriter () +histogramHtmlSingle st index = + do header st index + let f = fromJust $ M.lookup 0 (histogramMap st) + writeHtmlParagraph $ + writeHtmlImage (makeRelative (histogramDir st) f) + +-- | Get the HTML code for multiple runs. +histogramHtmlMultiple :: HistogramViewState -> Int -> HtmlWriter () +histogramHtmlMultiple st index = + do header st index + let n = experimentRunCount $ histogramExperiment st + forM_ [0..(n - 1)] $ \i -> + let f = fromJust $ M.lookup i (histogramMap st) + in writeHtmlParagraph $ + writeHtmlImage (makeRelative (histogramDir st) f) + +header :: HistogramViewState -> Int -> HtmlWriter () +header st index = + do writeHtmlHeader3WithId ("id" ++ show index) $ + writeHtmlText (histogramTitle $ histogramView st) + let description = histogramDescription $ histogramView st + unless (null description) $ + writeHtmlParagraph $ + writeHtmlText description + +-- | Get the TOC item. +histogramTOCHtml :: HistogramViewState -> Int -> HtmlWriter () +histogramTOCHtml st index = + writeHtmlListItem $ + writeHtmlLink ("#id" ++ show index) $ + writeHtmlText (histogramTitle $ histogramView st) diff --git a/Simulation/Aivika/Experiment/TimeSeriesView.hs b/Simulation/Aivika/Experiment/TimeSeriesView.hs --- a/Simulation/Aivika/Experiment/TimeSeriesView.hs +++ b/Simulation/Aivika/Experiment/TimeSeriesView.hs @@ -47,20 +47,9 @@ -- in the PNG files. data TimeSeriesView = TimeSeriesView { timeSeriesTitle :: String, - -- ^ This is a title used in HTML and chart. - timeSeriesRunTitle :: String, - -- ^ The run title for the view. It is used - -- when simulating multiple runs and it may - -- include special variables @$RUN_INDEX@, - -- @$RUN_COUNT@ and @$TITLE@. - -- - -- An example is - -- - -- @ - -- timeSeriesRunTitle = \"$TITLE / Run $RUN_INDEX of $RUN_COUNT\" - -- @ + -- ^ This is a title used in HTML. timeSeriesDescription :: String, - -- ^ This is a description in the HTML. + -- ^ This is a description used in HTML. timeSeriesWidth :: Int, -- ^ The width of the chart. timeSeriesHeight :: Int, @@ -80,7 +69,28 @@ -- when we plot data in the chart. timeSeries :: [Either String String], -- ^ It contains the labels of data plotted - -- in the chart. + -- on the chart. + timeSeriesPlotTitle :: String, + -- ^ This is a title used in the chart when + -- simulating a single run. It may include + -- special variable @$TITLE@. + -- + -- An example is + -- + -- @ + -- timeSeriesPlotTitle = \"$TITLE\" + -- @ + timeSeriesRunPlotTitle :: String, + -- ^ The run title for the chart. It is used + -- when simulating multiple runs and it may + -- include special variables @$RUN_INDEX@, + -- @$RUN_COUNT@ and @$PLOT_TITLE@. + -- + -- An example is + -- + -- @ + -- timeSeriesRunPlotTitle = \"$PLOT_TITLE / Run $RUN_INDEX of $RUN_COUNT\" + -- @ timeSeriesPlotLines :: [PlotLines Double Double -> PlotLines Double Double], -- ^ Probably, an infinite sequence of plot @@ -91,7 +101,11 @@ -- or an array of data providers. -- -- Here you can define a colour or style of - -- of the plot lines. + -- the plot lines. + timeSeriesBottomAxis :: LayoutAxis Double -> + LayoutAxis Double, + -- ^ A transformation of the bottom axis, + -- after title @time@ is added. timeSeriesLayout :: Layout1 Double Double -> Layout1 Double Double -- ^ A transformation of the plot layout, @@ -102,14 +116,16 @@ defaultTimeSeriesView :: TimeSeriesView defaultTimeSeriesView = TimeSeriesView { timeSeriesTitle = "Time Series", - timeSeriesRunTitle = "$TITLE / Run $RUN_INDEX of $RUN_COUNT", timeSeriesDescription = [], timeSeriesWidth = 640, timeSeriesHeight = 480, timeSeriesFileName = UniqueFileName "$TITLE - $RUN_INDEX" ".png", timeSeriesPredicate = return True, timeSeries = [], + timeSeriesPlotTitle = "$TITLE", + timeSeriesRunPlotTitle = "$PLOT_TITLE / Run $RUN_INDEX of $RUN_COUNT", timeSeriesPlotLines = colourisePlotLines, + timeSeriesBottomAxis = id, timeSeriesLayout = id } instance View TimeSeriesView where @@ -140,6 +156,7 @@ M.fromList [("$TITLE", timeSeriesTitle view), ("$RUN_INDEX", show $ i + 1), ("$RUN_COUNT", show n)] + forM_ fs $ flip writeFile [] -- reserve the file names let m = M.fromList $ zip [0..(n - 1)] fs return TimeSeriesViewState { timeSeriesView = view, timeSeriesExperiment = exp, @@ -165,21 +182,28 @@ height = timeSeriesHeight $ timeSeriesView st predicate = timeSeriesPredicate $ timeSeriesView st plotLines = timeSeriesPlotLines $ timeSeriesView st + plotBottomAxis = timeSeriesBottomAxis $ timeSeriesView st plotLayout = timeSeriesLayout $ timeSeriesView st i <- liftSimulation simulationIndex let file = fromJust $ M.lookup (i - 1) (timeSeriesMap st) - title = + title = timeSeriesTitle $ timeSeriesView st + plotTitle = + replace "$TITLE" title + (timeSeriesPlotTitle $ timeSeriesView st) + runPlotTitle = if n == 1 - then timeSeriesTitle $ timeSeriesView st + then plotTitle else replace "$RUN_INDEX" (show i) $ replace "$RUN_COUNT" (show n) $ - replace "$TITLE" (timeSeriesTitle $ timeSeriesView st) - (timeSeriesRunTitle $ timeSeriesView st) + replace "$PLOT_TITLE" plotTitle + (timeSeriesRunPlotTitle $ timeSeriesView st) hs <- forM (zip providers input) $ \(provider, input) -> - newSignalHistoryThrough (experimentQueue expdata) $ - mapSignalM (const input) $ - filterSignalM (const predicate) $ - experimentMixedSignal expdata [provider] + let transform () = + do x <- predicate + if x then input else return (1/0) -- the infinite values will be ignored then + in newSignalHistoryThrough (experimentQueue expdata) $ + mapSignalM transform $ + experimentMixedSignal expdata [provider] return $ do ps <- forM (zip3 hs providers plotLines) $ \(h, provider, plotLines) -> do (ts, xs) <- readSignalHistory h @@ -193,8 +217,12 @@ case label of Left _ -> Left p Right _ -> Right p - let chart = plotLayout $ - layout1_title ^= title $ + axis = plotBottomAxis $ + laxis_title ^= "time" $ + defaultLayoutAxis + chart = plotLayout $ + layout1_bottom_axis ^= axis $ + layout1_title ^= runPlotTitle $ layout1_plots ^= ps' $ defaultLayout1 liftIO $ diff --git a/Simulation/Aivika/Experiment/XYChartView.hs b/Simulation/Aivika/Experiment/XYChartView.hs new file mode 100644 --- /dev/null +++ b/Simulation/Aivika/Experiment/XYChartView.hs @@ -0,0 +1,300 @@ + +-- | +-- Module : Simulation.Aivika.Experiment.XYChartView +-- Copyright : Copyright (c) 2012, David Sorokin +-- License : BSD3 +-- Maintainer : David Sorokin +-- Stability : experimental +-- Tested with: GHC 7.4.1 +-- +-- The module defines 'XYChartView' that saves the XY charts +-- in the PNG files. +-- + +module Simulation.Aivika.Experiment.XYChartView + (XYChartView(..), + defaultXYChartView) where + +import Control.Monad +import Control.Monad.Trans + +import qualified Data.Map as M +import Data.IORef +import Data.Maybe +import Data.Either +import Data.Array +import Data.Monoid + +import Data.Accessor + +import System.IO +import System.FilePath + +import Data.String.Utils (replace) + +import Graphics.Rendering.Chart + +import Simulation.Aivika.Experiment +import Simulation.Aivika.Experiment.HtmlWriter +import Simulation.Aivika.Experiment.Utils (divideBy) +import Simulation.Aivika.Experiment.Chart (colourisePlotLines) + +import Simulation.Aivika.Dynamics +import Simulation.Aivika.Dynamics.Simulation +import Simulation.Aivika.Dynamics.Signal +import Simulation.Aivika.Dynamics.EventQueue + +-- | Defines the 'View' that saves the XY charts +-- in the PNG files. +data XYChartView = + XYChartView { xyChartTitle :: String, + -- ^ This is a title used in HTML. + xyChartDescription :: String, + -- ^ This is a description used in HTML. + xyChartWidth :: Int, + -- ^ The width of the chart. + xyChartHeight :: Int, + -- ^ The height of the chart. + xyChartFileName :: FileName, + -- ^ It defines the file name for each PNG file. + -- It may include special variables @$TITLE@, + -- @$RUN_INDEX@ and @$RUN_COUNT@. + -- + -- An example is + -- + -- @ + -- xyChartFileName = UniqueFileName \"$TITLE - $RUN_INDEX\", \".png\" + -- @ + xyChartPredicate :: Dynamics Bool, + -- ^ It specifies the predicate that defines + -- when we plot data in the chart. + xyChartXSeries :: Maybe String, + -- ^ This is a label of the X series. + -- + -- You must define it, because it is 'Nothing' + -- by default. + xyChartYSeries :: [Either String String], + -- ^ It contains the labels of Y series plotted + -- on the XY chart. + xyChartPlotTitle :: String, + -- ^ This is a title used in the chart when + -- simulating a single run. It may include + -- special variable @$TITLE@. + -- + -- An example is + -- + -- @ + -- xyChartPlotTitle = \"$TITLE\" + -- @ + xyChartRunPlotTitle :: String, + -- ^ The run title for the chart. It is used + -- when simulating multiple runs and it may + -- include special variables @$RUN_INDEX@, + -- @$RUN_COUNT@ and @$PLOT_TITLE@. + -- + -- An example is + -- + -- @ + -- xyChartRunPlotTitle = \"$PLOT_TITLE / Run $RUN_INDEX of $RUN_COUNT\" + -- @ + xyChartPlotLines :: [PlotLines Double Double -> + PlotLines Double Double], + -- ^ Probably, an infinite sequence of plot + -- transformations based on which the plot + -- is constructed for each Y series. Generally, + -- it may not coincide with a sequence of + -- Y labels as one label may denote a whole list + -- or an array of data providers. + -- + -- Here you can define a colour or style of + -- the plot lines. + xyChartBottomAxis :: LayoutAxis Double -> + LayoutAxis Double, + -- ^ A transformation of the bottom axis, + -- after the X title is added. + xyChartLayout :: Layout1 Double Double -> + Layout1 Double Double + -- ^ A transformation of the plot layout, + -- where you can redefine the axes, for example. + } + +-- | The default time series view. +defaultXYChartView :: XYChartView +defaultXYChartView = + XYChartView { xyChartTitle = "XY Chart", + xyChartDescription = [], + xyChartWidth = 640, + xyChartHeight = 480, + xyChartFileName = UniqueFileName "$TITLE - $RUN_INDEX" ".png", + xyChartPredicate = return True, + xyChartXSeries = Nothing, + xyChartYSeries = [], + xyChartPlotTitle = "$TITLE", + xyChartRunPlotTitle = "$PLOT_TITLE / Run $RUN_INDEX of $RUN_COUNT", + xyChartPlotLines = colourisePlotLines, + xyChartBottomAxis = id, + xyChartLayout = id } + +instance View XYChartView where + + outputView v = + let reporter exp dir = + do st <- newXYChart v exp dir + return Reporter { reporterInitialise = return (), + reporterFinalise = return (), + reporterSimulate = simulateXYChart st, + reporterTOCHtml = xyChartTOCHtml st, + reporterHtml = xyChartHtml st } + in Generator { generateReporter = reporter } + +-- | The state of the view. +data XYChartViewState = + XYChartViewState { xyChartView :: XYChartView, + xyChartExperiment :: Experiment, + xyChartDir :: FilePath, + xyChartMap :: M.Map Int FilePath } + +-- | Create a new state of the view. +newXYChart :: XYChartView -> Experiment -> FilePath -> IO XYChartViewState +newXYChart view exp dir = + do let n = experimentRunCount exp + fs <- forM [0..(n - 1)] $ \i -> + resolveFileName (Just dir) (xyChartFileName view) $ + M.fromList [("$TITLE", xyChartTitle view), + ("$RUN_INDEX", show $ i + 1), + ("$RUN_COUNT", show n)] + forM_ fs $ flip writeFile [] -- reserve the file names + let m = M.fromList $ zip [0..(n - 1)] fs + return XYChartViewState { xyChartView = view, + xyChartExperiment = exp, + xyChartDir = dir, + xyChartMap = m } + +-- | Plot the XY chart during the simulation. +simulateXYChart :: XYChartViewState -> ExperimentData -> Dynamics (Dynamics ()) +simulateXYChart st expdata = + do let yprotolabels = xyChartYSeries $ xyChartView st + xprotolabel = xyChartXSeries $ xyChartView st + ylabels = flip map yprotolabels $ either id id + xlabel = flip fromMaybe xprotolabel $ + error "X series is not provided: simulateXYChart" + yproviders = experimentSeriesProviders expdata ylabels + xprovider = + case experimentSeriesProviders expdata [xlabel] of + [provider] -> provider + _ -> error $ + "Only a single X series must be" ++ + " provided: simulateXYChart" + ys = input yproviders + [x] = input [xprovider] + input providers = + flip map providers $ \provider -> + case providerToDouble provider of + Nothing -> error $ + "Cannot represent series " ++ + providerName provider ++ + " as double values: simulateXYChart" + Just input -> input + n = experimentRunCount $ xyChartExperiment st + width = xyChartWidth $ xyChartView st + height = xyChartHeight $ xyChartView st + predicate = xyChartPredicate $ xyChartView st + plotLines = xyChartPlotLines $ xyChartView st + plotBottomAxis = xyChartBottomAxis $ xyChartView st + plotLayout = xyChartLayout $ xyChartView st + i <- liftSimulation simulationIndex + let file = fromJust $ M.lookup (i - 1) (xyChartMap st) + title = xyChartTitle $ xyChartView st + plotTitle = + replace "$TITLE" title + (xyChartPlotTitle $ xyChartView st) + runPlotTitle = + if n == 1 + then plotTitle + else replace "$RUN_INDEX" (show i) $ + replace "$RUN_COUNT" (show n) $ + replace "$PLOT_TITLE" plotTitle + (xyChartRunPlotTitle $ xyChartView st) + hs <- forM (zip yproviders ys) $ \(provider, y) -> + let transform () = + do p <- predicate + if p + then liftM2 (,) x y + else return (1/0, 1/0) -- such values will be ignored then + in newSignalHistoryThrough (experimentQueue expdata) $ + mapSignalM transform $ + experimentMixedSignal expdata [provider] <> + experimentMixedSignal expdata [xprovider] + return $ + do ps <- forM (zip3 hs yproviders plotLines) $ \(h, provider, plotLines) -> + do (ts, zs) <- readSignalHistory h + return $ + toPlot $ + plotLines $ + plot_lines_values ^= filterPlotLinesValues (elems zs) $ + plot_lines_title ^= providerName provider $ + defaultPlotLines + let ps' = flip map (zip ps yprotolabels) $ \(p, label) -> + case label of + Left _ -> Left p + Right _ -> Right p + axis = plotBottomAxis $ + laxis_title ^= providerName xprovider $ + defaultLayoutAxis + chart = plotLayout $ + layout1_bottom_axis ^= axis $ + layout1_title ^= runPlotTitle $ + layout1_plots ^= ps' $ + defaultLayout1 + liftIO $ + do renderableToPNGFile (toRenderable chart) width height file + when (experimentVerbose $ xyChartExperiment st) $ + putStr "Generated file " >> putStrLn file + +-- | Remove the NaN and inifity values. +filterPlotLinesValues :: [(Double, Double)] -> [[(Double, Double)]] +filterPlotLinesValues = + filter (not . null) . + divideBy (\(x, y) -> isNaN x || isInfinite x || isNaN y || isInfinite y) + +-- | Get the HTML code. +xyChartHtml :: XYChartViewState -> Int -> HtmlWriter () +xyChartHtml st index = + let n = experimentRunCount $ xyChartExperiment st + in if n == 1 + then xyChartHtmlSingle st index + else xyChartHtmlMultiple st index + +-- | Get the HTML code for a single run. +xyChartHtmlSingle :: XYChartViewState -> Int -> HtmlWriter () +xyChartHtmlSingle st index = + do header st index + let f = fromJust $ M.lookup 0 (xyChartMap st) + writeHtmlParagraph $ + writeHtmlImage (makeRelative (xyChartDir st) f) + +-- | Get the HTML code for multiple runs. +xyChartHtmlMultiple :: XYChartViewState -> Int -> HtmlWriter () +xyChartHtmlMultiple st index = + do header st index + let n = experimentRunCount $ xyChartExperiment st + forM_ [0..(n - 1)] $ \i -> + let f = fromJust $ M.lookup i (xyChartMap st) + in writeHtmlParagraph $ + writeHtmlImage (makeRelative (xyChartDir st) f) + +header :: XYChartViewState -> Int -> HtmlWriter () +header st index = + do writeHtmlHeader3WithId ("id" ++ show index) $ + writeHtmlText (xyChartTitle $ xyChartView st) + let description = xyChartDescription $ xyChartView st + unless (null description) $ + writeHtmlParagraph $ + writeHtmlText description + +-- | Get the TOC item. +xyChartTOCHtml :: XYChartViewState -> Int -> HtmlWriter () +xyChartTOCHtml st index = + writeHtmlListItem $ + writeHtmlLink ("#id" ++ show index) $ + writeHtmlText (xyChartTitle $ xyChartView st) 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: 0.1 +version: 0.1.2 synopsis: Simulation experiments with charting for the Aivika library description: This package complements the Aivika and Aivika Experiment packages with @@ -27,7 +27,11 @@ library exposed-modules: Simulation.Aivika.Experiment.TimeSeriesView + Simulation.Aivika.Experiment.XYChartView + Simulation.Aivika.Experiment.FinalXYChartView Simulation.Aivika.Experiment.DeviationChartView + Simulation.Aivika.Experiment.HistogramView + Simulation.Aivika.Experiment.FinalHistogramView Simulation.Aivika.Experiment.Chart build-depends: base >= 3 && < 6, @@ -40,6 +44,6 @@ data-accessor >= 0.2.2.3, colour >= 2.3.3, aivika >= 0.4.3, - aivika-experiment >= 0.1 + aivika-experiment >= 0.1.2 ghc-options: -O2 diff --git a/examples/BassDiffusion.hs b/examples/BassDiffusion.hs --- a/examples/BassDiffusion.hs +++ b/examples/BassDiffusion.hs @@ -12,6 +12,7 @@ import Simulation.Aivika.Experiment import Simulation.Aivika.Experiment.DeviationChartView +import Simulation.Aivika.Experiment.TimeSeriesView n = 100 -- the number of agents @@ -33,7 +34,10 @@ experimentGenerators = [outputView $ defaultDeviationChartView { deviationChartSeries = [Left "potentialAdopters", - Left "adopters"] } ] } + Left "adopters"] }, + outputView $ defaultTimeSeriesView { + timeSeries = [Left "potentialAdopters", + Left "adopters"] } ] } exprnd :: Double -> IO Double exprnd lambda = @@ -111,7 +115,7 @@ definePersons ps potentialAdopters adopters runDynamicsInStartTime $ activatePersons ps - experimentDataInStartTime q $ + experimentDataInStartTime q [("potentialAdopters", seriesEntity "Potential Adopters" potentialAdopters), diff --git a/examples/ChemicalReaction.hs b/examples/ChemicalReaction.hs --- a/examples/ChemicalReaction.hs +++ b/examples/ChemicalReaction.hs @@ -9,6 +9,7 @@ import Simulation.Aivika.Experiment.LastValueView import Simulation.Aivika.Experiment.TableView import Simulation.Aivika.Experiment.TimeSeriesView +import Simulation.Aivika.Experiment.XYChartView specs = Specs { spcStartTime = 0, spcStopTime = 13, @@ -19,6 +20,7 @@ experiment = defaultExperiment { experimentSpecs = specs, + experimentRunCount = 1, experimentDescription = "Experiment Description", experimentGenerators = [outputView $ defaultLastValueView { @@ -28,7 +30,29 @@ tableDescription = "Table description", tableSeries = ["t", "a", "b", "c"] }, outputView $ defaultTimeSeriesView { - timeSeries = [Left "a", Left "b", Left "c"] } ] } + timeSeries = [Left "a", Left "b", Left "c"] }, + -- outputView $ defaultTimeSeriesView { + -- timeSeriesPlotTitle = "Variables a, b and c for t <= 5 or t >= 7", + -- timeSeries = [Left "a", Left "b", Left "c"], + -- timeSeriesPredicate = + -- do t <- time + -- return (t <= 5 || t >= 7) }, + outputView $ defaultXYChartView { + xyChartXSeries = Just "a", + xyChartYSeries = [Left "b", Right "c"] }, + outputView $ defaultXYChartView { + xyChartXSeries = Just "b", + xyChartYSeries = [Right "a", Right "c"] }, + outputView $ defaultXYChartView { + xyChartXSeries = Just "c", + xyChartYSeries = [Right "a", Left "b"] } ] } + -- outputView $ defaultXYChartView { + -- xyChartPlotTitle = "Functions a=a(c) and b=b(c) for t <= 2 or t >= 3", + -- xyChartXSeries = Just "c", + -- xyChartYSeries = [Right "a", Left "b"], + -- xyChartPredicate = + -- do t <- time + -- return (t <= 2 || t >= 3) } ] } model :: Simulation ExperimentData model = @@ -44,7 +68,7 @@ integDiff integA (- ka * a) integDiff integB (ka * a - kb * b) integDiff integC (kb * b) - experimentDataInStartTime queue $ + experimentDataInStartTime queue [("t", seriesEntity "time" time), ("a", seriesEntity "a" a), ("b", seriesEntity "b" b), diff --git a/examples/MachRep3.hs b/examples/MachRep3.hs --- a/examples/MachRep3.hs +++ b/examples/MachRep3.hs @@ -28,10 +28,13 @@ import Simulation.Aivika.Dynamics.Process import Simulation.Aivika.Experiment +import Simulation.Aivika.Experiment.Histogram import Simulation.Aivika.Experiment.LastValueView import Simulation.Aivika.Experiment.TableView import Simulation.Aivika.Experiment.TimeSeriesView import Simulation.Aivika.Experiment.DeviationChartView +import Simulation.Aivika.Experiment.FinalHistogramView +import Simulation.Aivika.Experiment.FinalXYChartView specs = Specs { spcStartTime = 0.0, spcStopTime = 1000.0, @@ -42,19 +45,51 @@ experiment = defaultExperiment { experimentSpecs = specs, - experimentRunCount = 3, + experimentRunCount = 200, experimentDescription = "Experiment Description", experimentGenerators = - [outputView $ defaultLastValueView { - lastValueDescription = "Last Value description", - lastValueSeries = ["x"] }, - outputView $ defaultTableView { - tableDescription = "Table description", - tableSeries = ["x"] }, - outputView $ defaultTimeSeriesView { - timeSeries = [Left "t", Right "x"] }, - outputView $ defaultDeviationChartView { - deviationChartSeries = [Left "t", Right "x"] } ] } + [outputView $ defaultDeviationChartView { + deviationChartSeries = [Left "t", Right "x"] }, + outputView $ defaultFinalXYChartView { + finalXYChartPlotTitle = "The proportion up time for simulation runs < 50 and > 100", + finalXYChartXSeries = Just "n", + finalXYChartYSeries = [Right "x"], + finalXYChartPredicate = + do i <- liftSimulation simulationIndex + return $ (i < 50) || (i > 100) }, + outputView $ defaultFinalHistogramView { + finalHistogramPlotTitle = "Final Histogram (Default)", + finalHistogramSeries = ["x", "x"] }, + outputView $ defaultFinalHistogramView { + finalHistogramPlotTitle = "Final Histogram (Default)", + finalHistogramSeries = ["t", "t"] }, + outputView $ defaultFinalHistogramView { + finalHistogramPlotTitle = "Final Histogram (Default)", + finalHistogramSeries = ["x"] }, + outputView $ defaultFinalHistogramView { + finalHistogramPlotTitle = "Final Histogram (Bin Size = 0.001)", + finalHistogramBuild = histogramBinSize 0.001, + finalHistogramSeries = ["x"] }, + outputView $ defaultFinalHistogramView { + finalHistogramPlotTitle = "Final Histogram (Bin Num = 10)", + finalHistogramBuild = histogramNumBins 10, + finalHistogramSeries = ["x"] }, + outputView $ defaultFinalHistogramView { + finalHistogramPlotTitle = "Final Histogram (Sturges)", + finalHistogramBuild = histogram binSturges, + finalHistogramSeries = ["x"] }, + outputView $ defaultFinalHistogramView { + finalHistogramPlotTitle = "Final Histogram (Doane)", + finalHistogramBuild = histogram binDoane, + finalHistogramSeries = ["x"] }, + outputView $ defaultFinalHistogramView { + finalHistogramPlotTitle = "Final Histogram (Sqrt)", + finalHistogramBuild = histogram binSqrt, + finalHistogramSeries = ["x"] }, + outputView $ defaultFinalHistogramView { + finalHistogramPlotTitle = "Final Histogram (Scott)", + finalHistogramBuild = histogram binScott, + finalHistogramSeries = ["x"] } ] } upRate = 1.0 / 1.0 -- reciprocal of mean up time repairRate = 1.0 / 0.5 -- reciprocal of mean repair time @@ -115,8 +150,9 @@ y <- time return $ x / (2 * y) - experimentDataInStartTime queue $ + experimentDataInStartTime queue [("x", seriesEntity "The proportion of up time" result), - ("t", seriesEntity "Total up time" totalUpTime)] + ("t", seriesEntity "Total up time" totalUpTime), + ("n", seriesEntity "Simulation run" simulationIndex)] main = runExperiment experiment model