module Simulation.Aivika.Experiment.Chart.TimeSeriesView
(TimeSeriesView(..),
defaultTimeSeriesView) where
import Control.Monad
import Control.Monad.Trans
import Control.Lens
import qualified Data.Map as M
import Data.IORef
import Data.Maybe
import Data.Either
import Data.Array
import Data.List
import Data.Monoid
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.Chart.Types
import Simulation.Aivika.Experiment.Chart.Utils (colourisePlotLines)
data TimeSeriesView =
TimeSeriesView { timeSeriesTitle :: String,
timeSeriesDescription :: String,
timeSeriesWidth :: Int,
timeSeriesHeight :: Int,
timeSeriesFileName :: ExperimentFilePath,
timeSeriesPredicate :: Event Bool,
timeSeriesTransform :: ResultTransform,
timeSeriesLeftYSeries :: ResultTransform,
timeSeriesRightYSeries :: ResultTransform,
timeSeriesPlotTitle :: String,
timeSeriesRunPlotTitle :: String,
timeSeriesPlotLines :: [PlotLines Double Double ->
PlotLines Double Double],
timeSeriesBottomAxis :: LayoutAxis Double ->
LayoutAxis Double,
timeSeriesLayout :: LayoutLR Double Double Double ->
LayoutLR Double Double Double
}
defaultTimeSeriesView :: TimeSeriesView
defaultTimeSeriesView =
TimeSeriesView { timeSeriesTitle = "Time Series",
timeSeriesDescription = "It shows the Time Series chart(s).",
timeSeriesWidth = 640,
timeSeriesHeight = 480,
timeSeriesFileName = UniqueFilePath "TimeSeries($RUN_INDEX)",
timeSeriesPredicate = return True,
timeSeriesTransform = id,
timeSeriesLeftYSeries = const mempty,
timeSeriesRightYSeries = const mempty,
timeSeriesPlotTitle = "$TITLE",
timeSeriesRunPlotTitle = "$PLOT_TITLE / Run $RUN_INDEX of $RUN_COUNT",
timeSeriesPlotLines = colourisePlotLines,
timeSeriesBottomAxis = id,
timeSeriesLayout = id }
instance ChartRendering r => ExperimentView TimeSeriesView (WebPageRenderer r) where
outputView v =
let reporter exp (WebPageRenderer renderer) dir =
do st <- newTimeSeries v exp renderer dir
let context =
WebPageContext $
WebPageWriter { reporterWriteTOCHtml = timeSeriesTOCHtml st,
reporterWriteHtml = timeSeriesHtml st }
return ExperimentReporter { reporterInitialise = return (),
reporterFinalise = return (),
reporterSimulate = simulateTimeSeries st,
reporterContext = context }
in ExperimentGenerator { generateReporter = reporter }
instance ChartRendering r => ExperimentView TimeSeriesView (FileRenderer r) where
outputView v =
let reporter exp (FileRenderer renderer) dir =
do st <- newTimeSeries v exp renderer dir
return ExperimentReporter { reporterInitialise = return (),
reporterFinalise = return (),
reporterSimulate = simulateTimeSeries st,
reporterContext = FileContext }
in ExperimentGenerator { generateReporter = reporter }
data TimeSeriesViewState r =
TimeSeriesViewState { timeSeriesView :: TimeSeriesView,
timeSeriesExperiment :: Experiment,
timeSeriesRenderer :: r,
timeSeriesDir :: FilePath,
timeSeriesMap :: M.Map Int FilePath }
newTimeSeries :: ChartRendering r => TimeSeriesView -> Experiment -> r -> FilePath -> ExperimentWriter (TimeSeriesViewState r)
newTimeSeries view exp renderer dir =
do let n = experimentRunCount exp
fs <- forM [0..(n 1)] $ \i ->
resolveFilePath dir $
mapFilePath (flip replaceExtension $ renderableChartExtension renderer) $
expandFilePath (timeSeriesFileName view) $
M.fromList [("$TITLE", timeSeriesTitle view),
("$RUN_INDEX", show $ i + 1),
("$RUN_COUNT", show n)]
liftIO $ forM_ fs $ flip writeFile []
let m = M.fromList $ zip [0..(n 1)] fs
return TimeSeriesViewState { timeSeriesView = view,
timeSeriesExperiment = exp,
timeSeriesRenderer = renderer,
timeSeriesDir = dir,
timeSeriesMap = m }
simulateTimeSeries :: ChartRendering r => TimeSeriesViewState r -> ExperimentData -> Event DisposableEvent
simulateTimeSeries st expdata =
do let view = timeSeriesView st
rs1 = timeSeriesLeftYSeries view $
timeSeriesTransform view $
experimentResults expdata
rs2 = timeSeriesRightYSeries view $
timeSeriesTransform view $
experimentResults expdata
exts1 = resultsToDoubleValues rs1
exts2 = resultsToDoubleValues rs2
signals = experimentPredefinedSignals expdata
n = experimentRunCount $ timeSeriesExperiment st
width = timeSeriesWidth view
height = timeSeriesHeight view
predicate = timeSeriesPredicate view
title = timeSeriesTitle view
plotTitle = timeSeriesPlotTitle view
runPlotTitle = timeSeriesRunPlotTitle view
plotLines = timeSeriesPlotLines view
plotBottomAxis = timeSeriesBottomAxis view
plotLayout = timeSeriesLayout view
renderer = timeSeriesRenderer st
i <- liftParameter simulationIndex
let file = fromJust $ M.lookup (i 1) (timeSeriesMap st)
plotTitle' =
replace "$TITLE" title
plotTitle
runPlotTitle' =
if n == 1
then plotTitle'
else replace "$RUN_INDEX" (show i) $
replace "$RUN_COUNT" (show n) $
replace "$PLOT_TITLE" plotTitle'
runPlotTitle
inputHistory exts =
forM exts $ \ext ->
let transform () =
do x <- predicate
if x
then resultValueData ext
else return (1/0)
in newSignalHistory $
mapSignalM transform $
pureResultSignal signals $
resultValueSignal ext
hs1 <- inputHistory exts1
hs2 <- inputHistory exts2
return $
DisposableEvent $
do let plots hs exts plotLineTails =
do ps <-
forM (zip3 hs exts (head plotLineTails)) $
\(h, ext, plotLines) ->
do (ts, xs) <- readSignalHistory h
return $
toPlot $
plotLines $
plot_lines_values .~ filterPlotLinesValues (zip (elems ts) (elems xs)) $
plot_lines_title .~ resultValueName ext $
def
return (ps, drop (length hs) plotLineTails)
(ps1, plotLineTails) <- plots hs1 exts1 (tails plotLines)
(ps2, plotLineTails) <- plots hs2 exts2 plotLineTails
let ps1' = map Left ps1
ps2' = map Right ps2
ps' = ps1' ++ ps2'
axis = plotBottomAxis $
laxis_title .~ "time" $
def
updateLeftAxis =
if null ps1
then layoutlr_left_axis_visibility .~ AxisVisibility False False False
else id
updateRightAxis =
if null ps2
then layoutlr_right_axis_visibility .~ AxisVisibility False False False
else id
chart = plotLayout . updateLeftAxis . updateRightAxis $
layoutlr_x_axis .~ axis $
layoutlr_title .~ runPlotTitle' $
layoutlr_plots .~ ps' $
def
liftIO $
do renderChart renderer (width, height) file (toRenderable chart)
when (experimentVerbose $ timeSeriesExperiment st) $
putStr "Generated file " >> putStrLn file
filterPlotLinesValues :: [(Double, Double)] -> [[(Double, Double)]]
filterPlotLinesValues =
filter (not . null) .
divideBy (\(t, x) -> isNaN x || isInfinite x)
timeSeriesHtml :: TimeSeriesViewState r -> Int -> HtmlWriter ()
timeSeriesHtml st index =
let n = experimentRunCount $ timeSeriesExperiment st
in if n == 1
then timeSeriesHtmlSingle st index
else timeSeriesHtmlMultiple st index
timeSeriesHtmlSingle :: TimeSeriesViewState r -> Int -> HtmlWriter ()
timeSeriesHtmlSingle st index =
do header st index
let f = fromJust $ M.lookup 0 (timeSeriesMap st)
writeHtmlParagraph $
writeHtmlImage (makeRelative (timeSeriesDir st) f)
timeSeriesHtmlMultiple :: TimeSeriesViewState r -> Int -> HtmlWriter ()
timeSeriesHtmlMultiple st index =
do header st index
let n = experimentRunCount $ timeSeriesExperiment st
forM_ [0..(n 1)] $ \i ->
let f = fromJust $ M.lookup i (timeSeriesMap st)
in writeHtmlParagraph $
writeHtmlImage (makeRelative (timeSeriesDir st) f)
header :: TimeSeriesViewState r -> Int -> HtmlWriter ()
header st index =
do writeHtmlHeader3WithId ("id" ++ show index) $
writeHtmlText (timeSeriesTitle $ timeSeriesView st)
let description = timeSeriesDescription $ timeSeriesView st
unless (null description) $
writeHtmlParagraph $
writeHtmlText description
timeSeriesTOCHtml :: TimeSeriesViewState r -> Int -> HtmlWriter ()
timeSeriesTOCHtml st index =
writeHtmlListItem $
writeHtmlLink ("#id" ++ show index) $
writeHtmlText (timeSeriesTitle $ timeSeriesView st)