-- | -- 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)