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.List
import Data.Accessor
import System.IO
import System.FilePath
import Graphics.Rendering.Chart
import Simulation.Aivika.Experiment
import Simulation.Aivika.Experiment.HtmlWriter
import Simulation.Aivika.Experiment.Utils (divideBy, replace)
import Simulation.Aivika.Experiment.Chart (colourisePlotLines)
import Simulation.Aivika.Dynamics
import Simulation.Aivika.Dynamics.Simulation
import Simulation.Aivika.Dynamics.Signal
data XYChartView =
XYChartView { xyChartTitle :: String,
xyChartDescription :: String,
xyChartWidth :: Int,
xyChartHeight :: Int,
xyChartFileName :: FileName,
xyChartPredicate :: Dynamics Bool,
xyChartXSeries :: Maybe String,
xyChartYSeries :: [Either String String],
xyChartPlotTitle :: String,
xyChartRunPlotTitle :: String,
xyChartPlotLines :: [PlotLines Double Double ->
PlotLines Double Double],
xyChartBottomAxis :: LayoutAxis Double ->
LayoutAxis Double,
xyChartLayout :: Layout1 Double Double ->
Layout1 Double Double
}
defaultXYChartView :: XYChartView
defaultXYChartView =
XYChartView { xyChartTitle = "XY Chart",
xyChartDescription = "It shows the XY chart(s).",
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 }
data XYChartViewState =
XYChartViewState { xyChartView :: XYChartView,
xyChartExperiment :: Experiment,
xyChartDir :: FilePath,
xyChartMap :: M.Map Int FilePath }
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 []
let m = M.fromList $ zip [0..(n 1)] fs
return XYChartViewState { xyChartView = view,
xyChartExperiment = exp,
xyChartDir = dir,
xyChartMap = m }
simulateXYChart :: XYChartViewState -> ExperimentData -> Dynamics (Dynamics ())
simulateXYChart st expdata =
do let ylabels = xyChartYSeries $ xyChartView st
xlabels = xyChartXSeries $ xyChartView st
xlabel = flip fromMaybe xlabels $
error "X series is not provided: simulateXYChart"
(leftYLabels, rightYLabels) = partitionEithers ylabels
leftYProviders = experimentSeriesProviders expdata leftYLabels
rightYProviders = experimentSeriesProviders expdata rightYLabels
xprovider =
case experimentSeriesProviders expdata [xlabel] of
[provider] -> provider
_ -> error $
"Only a single X series must be" ++
" provided: simulateXYChart"
providerInput providers =
flip map providers $ \provider ->
case providerToDouble provider of
Nothing -> error $
"Cannot represent series " ++
providerName provider ++
" as double values: simulateXYChart"
Just input -> (providerName provider, provider, input)
leftYInput = providerInput leftYProviders
rightYInput = providerInput rightYProviders
[(xname, _, x)] = providerInput [xprovider]
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)
inputHistory input =
forM input $ \(name, provider, y) ->
let transform () =
do p <- predicate
if p
then liftM2 (,) x y
else return (1/0, 1/0)
in newSignalHistory $
mapSignalM transform $
experimentMixedSignal expdata [provider] <>
experimentMixedSignal expdata [xprovider]
leftHs <- inputHistory leftYInput
rightHs <- inputHistory rightYInput
return $
do let plots hs input plotLineTails =
do ps <-
forM (zip3 hs input (head plotLineTails)) $
\(h, (name, provider, input), plotLines) ->
do (ts, zs) <- readSignalHistory h
return $
toPlot $
plotLines $
plot_lines_values ^= filterPlotLinesValues (elems zs) $
plot_lines_title ^= name $
defaultPlotLines
return (ps, drop (length hs) plotLineTails)
(leftPs, plotLineTails) <- plots leftHs leftYInput (tails plotLines)
(rightPs, plotLineTails) <- plots rightHs rightYInput plotLineTails
let leftPs' = map Left leftPs
rightPs' = map Right rightPs
ps' = leftPs' ++ rightPs'
axis = plotBottomAxis $
laxis_title ^= providerName xprovider $
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
filterPlotLinesValues :: [(Double, Double)] -> [[(Double, Double)]]
filterPlotLinesValues =
filter (not . null) .
divideBy (\(x, y) -> isNaN x || isInfinite x || isNaN y || isInfinite y)
xyChartHtml :: XYChartViewState -> Int -> HtmlWriter ()
xyChartHtml st index =
let n = experimentRunCount $ xyChartExperiment st
in if n == 1
then xyChartHtmlSingle st index
else xyChartHtmlMultiple st index
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)
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
xyChartTOCHtml :: XYChartViewState -> Int -> HtmlWriter ()
xyChartTOCHtml st index =
writeHtmlListItem $
writeHtmlLink ("#id" ++ show index) $
writeHtmlText (xyChartTitle $ xyChartView st)