module Simulation.Aivika.Experiment.TimeSeriesView
(TimeSeriesView(..),
defaultTimeSeriesView) 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 (colourisePlotLines)
import Simulation.Aivika.Dynamics
import Simulation.Aivika.Dynamics.Simulation
import Simulation.Aivika.Dynamics.Signal
import Simulation.Aivika.Dynamics.EventQueue
data TimeSeriesView =
TimeSeriesView { timeSeriesTitle :: String,
timeSeriesRunTitle :: String,
timeSeriesDescription :: String,
timeSeriesWidth :: Int,
timeSeriesHeight :: Int,
timeSeriesFileName :: FileName,
timeSeriesPredicate :: Dynamics Bool,
timeSeries :: [Either String String],
timeSeriesPlotLines :: [PlotLines Double Double ->
PlotLines Double Double],
timeSeriesLayout :: Layout1 Double Double ->
Layout1 Double Double
}
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 = [],
timeSeriesPlotLines = colourisePlotLines,
timeSeriesLayout = id }
instance View TimeSeriesView where
outputView v =
let reporter exp dir =
do st <- newTimeSeries v exp dir
return Reporter { reporterInitialise = return (),
reporterFinalise = return (),
reporterSimulate = simulateTimeSeries st,
reporterTOCHtml = timeSeriesTOCHtml st,
reporterHtml = timeSeriesHtml st }
in Generator { generateReporter = reporter }
data TimeSeriesViewState =
TimeSeriesViewState { timeSeriesView :: TimeSeriesView,
timeSeriesExperiment :: Experiment,
timeSeriesDir :: FilePath,
timeSeriesMap :: M.Map Int FilePath }
newTimeSeries :: TimeSeriesView -> Experiment -> FilePath -> IO TimeSeriesViewState
newTimeSeries view exp dir =
do let n = experimentRunCount exp
fs <- forM [0..(n 1)] $ \i ->
resolveFileName (Just dir) (timeSeriesFileName view) $
M.fromList [("$TITLE", timeSeriesTitle view),
("$RUN_INDEX", show $ i + 1),
("$RUN_COUNT", show n)]
let m = M.fromList $ zip [0..(n 1)] fs
return TimeSeriesViewState { timeSeriesView = view,
timeSeriesExperiment = exp,
timeSeriesDir = dir,
timeSeriesMap = m }
simulateTimeSeries :: TimeSeriesViewState -> ExperimentData -> Dynamics (Dynamics ())
simulateTimeSeries st expdata =
do let protolabels = timeSeries $ timeSeriesView st
labels = flip map protolabels $ either id id
providers = experimentSeriesProviders expdata labels
input =
flip map providers $ \provider ->
case providerToDouble provider of
Nothing -> error $
"Cannot represent series " ++
providerName provider ++
" as double values: simulateTimeSeries"
Just input -> input
n = experimentRunCount $ timeSeriesExperiment st
width = timeSeriesWidth $ timeSeriesView st
height = timeSeriesHeight $ timeSeriesView st
predicate = timeSeriesPredicate $ timeSeriesView st
plotLines = timeSeriesPlotLines $ timeSeriesView st
plotLayout = timeSeriesLayout $ timeSeriesView st
i <- liftSimulation simulationIndex
let file = fromJust $ M.lookup (i 1) (timeSeriesMap st)
title =
if n == 1
then timeSeriesTitle $ timeSeriesView st
else replace "$RUN_INDEX" (show i) $
replace "$RUN_COUNT" (show n) $
replace "$TITLE" (timeSeriesTitle $ timeSeriesView st)
(timeSeriesRunTitle $ timeSeriesView st)
hs <- forM (zip providers input) $ \(provider, input) ->
newSignalHistoryThrough (experimentQueue expdata) $
mapSignalM (const input) $
filterSignalM (const predicate) $
experimentMixedSignal expdata [provider]
return $
do ps <- forM (zip3 hs providers plotLines) $ \(h, provider, plotLines) ->
do (ts, xs) <- readSignalHistory h
return $
toPlot $
plotLines $
plot_lines_values ^= filterPlotLinesValues (zip (elems ts) (elems xs)) $
plot_lines_title ^= providerName provider $
defaultPlotLines
let ps' = flip map (zip ps protolabels) $ \(p, label) ->
case label of
Left _ -> Left p
Right _ -> Right p
let chart = plotLayout $
layout1_title ^= title $
layout1_plots ^= ps' $
defaultLayout1
liftIO $
do renderableToPNGFile (toRenderable chart) width height file
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 -> Int -> HtmlWriter ()
timeSeriesHtml st index =
let n = experimentRunCount $ timeSeriesExperiment st
in if n == 1
then timeSeriesHtmlSingle st index
else timeSeriesHtmlMultiple st index
timeSeriesHtmlSingle :: TimeSeriesViewState -> 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 -> 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 -> 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 -> Int -> HtmlWriter ()
timeSeriesTOCHtml st index =
writeHtmlListItem $
writeHtmlLink ("#id" ++ show index) $
writeHtmlText (timeSeriesTitle $ timeSeriesView st)