module Simulation.Aivika.Experiment.Chart.FinalXYChartView
(FinalXYChartView(..),
defaultFinalXYChartView) where
import Control.Monad
import Control.Monad.Trans
import Control.Concurrent.MVar
import Control.Lens
import qualified Data.Map as M
import Data.IORef
import Data.Maybe
import Data.Either
import Data.Monoid
import Data.Array
import Data.Array.IO.Safe
import Data.Default.Class
import System.IO
import System.FilePath
import Graphics.Rendering.Chart
import Simulation.Aivika
import Simulation.Aivika.Experiment
import Simulation.Aivika.Experiment.MRef
import Simulation.Aivika.Experiment.Chart.Types
import Simulation.Aivika.Experiment.Chart.Utils (colourisePlotLines)
data FinalXYChartView =
FinalXYChartView { finalXYChartTitle :: String,
finalXYChartDescription :: String,
finalXYChartWidth :: Int,
finalXYChartHeight :: Int,
finalXYChartFileName :: ExperimentFilePath,
finalXYChartPredicate :: Event Bool,
finalXYChartTransform :: ResultTransform,
finalXYChartXSeries :: ResultTransform,
finalXYChartLeftYSeries :: ResultTransform,
finalXYChartRightYSeries :: ResultTransform,
finalXYChartPlotTitle :: String,
finalXYChartPlotLines :: [PlotLines Double Double ->
PlotLines Double Double],
finalXYChartBottomAxis :: LayoutAxis Double ->
LayoutAxis Double,
finalXYChartLayout :: LayoutLR Double Double Double ->
LayoutLR Double Double Double
}
defaultFinalXYChartView :: FinalXYChartView
defaultFinalXYChartView =
FinalXYChartView { finalXYChartTitle = "Final XY Chart",
finalXYChartDescription = "It shows the XY chart for the results in the final time points.",
finalXYChartWidth = 640,
finalXYChartHeight = 480,
finalXYChartFileName = UniqueFilePath "FinalXYChart",
finalXYChartPredicate = return True,
finalXYChartTransform = id,
finalXYChartXSeries = mempty,
finalXYChartLeftYSeries = mempty,
finalXYChartRightYSeries = mempty,
finalXYChartPlotTitle = "$TITLE",
finalXYChartPlotLines = colourisePlotLines,
finalXYChartBottomAxis = id,
finalXYChartLayout = id }
instance ChartRendering r => ExperimentView FinalXYChartView (WebPageRenderer r) where
outputView v =
let reporter exp (WebPageRenderer renderer) dir =
do st <- newFinalXYChart v exp renderer dir
let context =
WebPageContext $
WebPageWriter { reporterWriteTOCHtml = finalXYChartTOCHtml st,
reporterWriteHtml = finalXYChartHtml st }
return ExperimentReporter { reporterInitialise = return (),
reporterFinalise = finaliseFinalXYChart st,
reporterSimulate = simulateFinalXYChart st,
reporterContext = context }
in ExperimentGenerator { generateReporter = reporter }
instance ChartRendering r => ExperimentView FinalXYChartView (FileRenderer r) where
outputView v =
let reporter exp (FileRenderer renderer) dir =
do st <- newFinalXYChart v exp renderer dir
return ExperimentReporter { reporterInitialise = return (),
reporterFinalise = finaliseFinalXYChart st,
reporterSimulate = simulateFinalXYChart st,
reporterContext = FileContext }
in ExperimentGenerator { generateReporter = reporter }
data FinalXYChartViewState r =
FinalXYChartViewState { finalXYChartView :: FinalXYChartView,
finalXYChartExperiment :: Experiment,
finalXYChartRenderer :: r,
finalXYChartDir :: FilePath,
finalXYChartFile :: IORef (Maybe FilePath),
finalXYChartLock :: MVar (),
finalXYChartResults :: MRef (Maybe FinalXYChartResults) }
data FinalXYChartResults =
FinalXYChartResults { finalXYChartXName :: String,
finalXYChartYNames :: [Either String String],
finalXYChartXY :: [IOArray Int (Maybe (Double, Double))] }
newFinalXYChart :: FinalXYChartView -> Experiment -> r -> FilePath -> ExperimentWriter (FinalXYChartViewState r)
newFinalXYChart view exp renderer dir =
liftIO $
do f <- newIORef Nothing
l <- newMVar ()
r <- newMRef Nothing
return FinalXYChartViewState { finalXYChartView = view,
finalXYChartExperiment = exp,
finalXYChartRenderer = renderer,
finalXYChartDir = dir,
finalXYChartFile = f,
finalXYChartLock = l,
finalXYChartResults = r }
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 }
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 return results
simulateFinalXYChart :: FinalXYChartViewState r -> ExperimentData -> Event DisposableEvent
simulateFinalXYChart st expdata =
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 resultsToDoubleValues rs0 of
[x] -> x
_ -> error "Expected to see a single X series: simulateFinalXYChart"
exts1 = resultsToDoubleValues rs1
exts2 = resultsToDoubleValues rs2
exts = exts1 ++ exts2
name0 = resultValueName ext0
names1 = map resultValueName exts1
names2 = map resultValueName 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 $ requireFinalXYChartResults st name0 names
let xys = finalXYChartXY results
handleSignal signal $ \_ ->
do x <- resultValueData ext0
ys <- forM exts resultValueData
i <- liftParameter simulationIndex
liftIO $
forM_ (zip ys xys) $ \(y, xy) ->
withMVar lock $ \() ->
x `seq` y `seq` writeArray xy i $ Just (x, y)
finaliseFinalXYChart :: ChartRendering r => FinalXYChartViewState r -> ExperimentWriter ()
finaliseFinalXYChart st =
do let view = finalXYChartView st
title = finalXYChartTitle view
plotTitle = finalXYChartPlotTitle view
plotTitle' =
replace "$TITLE" title
plotTitle
width = finalXYChartWidth view
height = finalXYChartHeight view
plotLines = finalXYChartPlotLines view
plotBottomAxis = finalXYChartBottomAxis view
plotLayout = finalXYChartLayout view
renderer = finalXYChartRenderer 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
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 $
def
r = case name of
Left _ -> Left p
Right _ -> Right p
return r
let axis = plotBottomAxis $
laxis_title .~ xname $
def
updateLeftAxis =
if null $ lefts ps
then layoutlr_left_axis_visibility .~ AxisVisibility False False False
else id
updateRightAxis =
if null $ rights ps
then layoutlr_right_axis_visibility .~ AxisVisibility False False False
else id
chart = plotLayout . updateLeftAxis . updateRightAxis $
layoutlr_x_axis .~ axis $
layoutlr_title .~ plotTitle' $
layoutlr_plots .~ ps $
def
renderChart renderer (width, height) file (toRenderable chart)
when (experimentVerbose $ finalXYChartExperiment st) $
putStr "Generated file " >> putStrLn file
writeIORef (finalXYChartFile st) $ Just file
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
finalXYChartHtml :: FinalXYChartViewState r -> 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 r -> 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
finalXYChartTOCHtml :: FinalXYChartViewState r -> Int -> HtmlWriter ()
finalXYChartTOCHtml st index =
writeHtmlListItem $
writeHtmlLink ("#id" ++ show index) $
writeHtmlText (finalXYChartTitle $ finalXYChartView st)