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.Default.Class
import System.IO
import System.FilePath
import Graphics.Rendering.Chart
import Graphics.Rendering.Chart.Backend.Cairo
import Simulation.Aivika.Experiment
import Simulation.Aivika.Experiment.HtmlWriter
import Simulation.Aivika.Experiment.Utils (divideBy, replace)
import Simulation.Aivika.Experiment.Chart.Utils (colourisePlotLines)
import Simulation.Aivika.Specs
import Simulation.Aivika.Parameter
import Simulation.Aivika.Simulation
import Simulation.Aivika.Event
import Simulation.Aivika.Signal
data TimeSeriesView =
TimeSeriesView { timeSeriesTitle :: String,
timeSeriesDescription :: String,
timeSeriesWidth :: Int,
timeSeriesHeight :: Int,
timeSeriesFileName :: FileName,
timeSeriesPredicate :: Event Bool,
timeSeries :: [Either String String],
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 = UniqueFileName "$TITLE - $RUN_INDEX" ".png",
timeSeriesPredicate = return True,
timeSeries = [],
timeSeriesPlotTitle = "$TITLE",
timeSeriesRunPlotTitle = "$PLOT_TITLE / Run $RUN_INDEX of $RUN_COUNT",
timeSeriesPlotLines = colourisePlotLines,
timeSeriesBottomAxis = id,
timeSeriesLayout = id }
instance ExperimentView TimeSeriesView where
outputView v =
let reporter exp dir =
do st <- newTimeSeries v exp dir
return ExperimentReporter { reporterInitialise = return (),
reporterFinalise = return (),
reporterSimulate = simulateTimeSeries st,
reporterTOCHtml = timeSeriesTOCHtml st,
reporterHtml = timeSeriesHtml st }
in ExperimentGenerator { 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)]
forM_ fs $ flip writeFile []
let m = M.fromList $ zip [0..(n 1)] fs
return TimeSeriesViewState { timeSeriesView = view,
timeSeriesExperiment = exp,
timeSeriesDir = dir,
timeSeriesMap = m }
simulateTimeSeries :: TimeSeriesViewState -> ExperimentData -> Event (Event ())
simulateTimeSeries st expdata =
do let labels = timeSeries $ timeSeriesView st
(leftLabels, rightLabels) = partitionEithers labels
(leftProviders, rightProviders) =
(experimentSeriesProviders expdata leftLabels,
experimentSeriesProviders expdata rightLabels)
providerInput providers =
flip map providers $ \provider ->
case providerToDouble provider of
Nothing -> error $
"Cannot represent series " ++
providerName provider ++
" as double values: simulateTimeSeries"
Just input -> (providerName provider, provider, input)
leftInput = providerInput leftProviders
rightInput = providerInput rightProviders
n = experimentRunCount $ timeSeriesExperiment st
width = timeSeriesWidth $ timeSeriesView st
height = timeSeriesHeight $ timeSeriesView st
predicate = timeSeriesPredicate $ timeSeriesView st
plotLines = timeSeriesPlotLines $ timeSeriesView st
plotBottomAxis = timeSeriesBottomAxis $ timeSeriesView st
plotLayout = timeSeriesLayout $ timeSeriesView st
i <- liftParameter simulationIndex
let file = fromJust $ M.lookup (i 1) (timeSeriesMap st)
title = timeSeriesTitle $ timeSeriesView st
plotTitle =
replace "$TITLE" title
(timeSeriesPlotTitle $ timeSeriesView st)
runPlotTitle =
if n == 1
then plotTitle
else replace "$RUN_INDEX" (show i) $
replace "$RUN_COUNT" (show n) $
replace "$PLOT_TITLE" plotTitle
(timeSeriesRunPlotTitle $ timeSeriesView st)
inputHistory input =
forM input $ \(name, provider, input) ->
let transform () =
do x <- predicate
if x then input else return (1/0)
in newSignalHistory $
mapSignalM transform $
experimentMixedSignal expdata [provider]
leftHs <- inputHistory leftInput
rightHs <- inputHistory rightInput
return $
do let plots hs input plotLineTails =
do ps <-
forM (zip3 hs input (head plotLineTails)) $
\(h, (name, provider, input), plotLines) ->
do (ts, xs) <- readSignalHistory h
return $
toPlot $
plotLines $
plot_lines_values .~ filterPlotLinesValues (zip (elems ts) (elems xs)) $
plot_lines_title .~ name $
def
return (ps, drop (length hs) plotLineTails)
(leftPs, plotLineTails) <- plots leftHs leftInput (tails plotLines)
(rightPs, plotLineTails) <- plots rightHs rightInput plotLineTails
let leftPs' = map Left leftPs
rightPs' = map Right rightPs
ps' = leftPs' ++ rightPs'
axis = plotBottomAxis $
laxis_title .~ "time" $
def
updateLeftAxis =
if null leftPs
then layoutlr_left_axis_visibility .~ AxisVisibility False False False
else id
updateRightAxis =
if null rightPs
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 let opts = FileOptions (width, height) PNG
renderableToFile opts (toRenderable chart) 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)