module Simulation.Aivika.Experiment.LastValueView
(LastValueView(..),
defaultLastValueView) where
import Control.Monad
import Control.Monad.Trans
import qualified Data.Map as M
import Data.IORef
import Data.Maybe
import Simulation.Aivika
import Simulation.Aivika.Experiment.Types
import Simulation.Aivika.Experiment.WebPageRenderer
import Simulation.Aivika.Experiment.ExperimentWriter
import Simulation.Aivika.Experiment.HtmlWriter
import Simulation.Aivika.Experiment.Utils (replace)
data LastValueView =
LastValueView { lastValueTitle :: String,
lastValueRunTitle :: String,
lastValueDescription :: String,
lastValueFormatter :: ShowS,
lastValueTransform :: ResultTransform,
lastValueSeries :: ResultTransform
}
defaultLastValueView :: LastValueView
defaultLastValueView =
LastValueView { lastValueTitle = "The Last Values",
lastValueRunTitle = "$TITLE / Run $RUN_INDEX of $RUN_COUNT",
lastValueDescription = "It shows the values in the final time point(s).",
lastValueFormatter = id,
lastValueTransform = id,
lastValueSeries = id }
instance ExperimentView LastValueView (WebPageRenderer a) where
outputView v =
let reporter exp renderer dir =
do st <- newLastValues v exp
let context =
WebPageContext $
WebPageWriter { reporterWriteTOCHtml = lastValueTOCHtml st,
reporterWriteHtml = lastValueHtml st }
return ExperimentReporter { reporterInitialise = return (),
reporterFinalise = return (),
reporterSimulate = simulateLastValues st,
reporterContext = context }
in ExperimentGenerator { generateReporter = reporter }
data LastValueViewState =
LastValueViewState { lastValueView :: LastValueView,
lastValueExperiment :: Experiment,
lastValueMap :: M.Map Int (IORef [(String, String)]) }
newLastValues :: LastValueView -> Experiment -> ExperimentWriter LastValueViewState
newLastValues view exp =
do let n = experimentRunCount exp
rs <- forM [0..(n 1)] $ \i -> liftIO $ newIORef []
let m = M.fromList $ zip [0..(n 1)] rs
return LastValueViewState { lastValueView = view,
lastValueExperiment = exp,
lastValueMap = m }
simulateLastValues :: LastValueViewState -> ExperimentData -> Event DisposableEvent
simulateLastValues st expdata =
do let view = lastValueView st
rs = lastValueSeries view $
lastValueTransform view $
experimentResults expdata
exts = resultsToStringValues rs
signals = experimentPredefinedSignals expdata
signal = resultSignalInStopTime signals
i <- liftParameter simulationIndex
handleSignal signal $ \t ->
do let r = fromJust $ M.lookup (i 1) (lastValueMap st)
output <- forM exts $ \ext ->
do x <- resultValueData ext
return (resultValueName ext, x)
liftIO $ writeIORef r output
lastValueHtml :: LastValueViewState -> Int -> HtmlWriter ()
lastValueHtml st index =
let n = experimentRunCount $ lastValueExperiment st
in if n == 1
then lastValueHtmlSingle st index
else lastValueHtmlMultiple st index
lastValueHtmlSingle :: LastValueViewState -> Int -> HtmlWriter ()
lastValueHtmlSingle st index =
do header st index
let r = fromJust $ M.lookup 0 (lastValueMap st)
pairs <- liftIO $ readIORef r
forM_ pairs $ \pair ->
formatPair pair (lastValueFormatter $ lastValueView st)
lastValueHtmlMultiple :: LastValueViewState -> Int -> HtmlWriter ()
lastValueHtmlMultiple st index =
do header st index
let n = experimentRunCount $ lastValueExperiment st
forM_ [0..(n 1)] $ \i ->
do let subtitle =
replace "$RUN_INDEX" (show $ i + 1) $
replace "$RUN_COUNT" (show n) $
replace "$TITLE" (lastValueTitle $ lastValueView st)
(lastValueRunTitle $ lastValueView st)
writeHtmlHeader4 $
writeHtmlText subtitle
let r = fromJust $ M.lookup i (lastValueMap st)
pairs <- liftIO $ readIORef r
forM_ pairs $ \pair ->
formatPair pair (lastValueFormatter $ lastValueView st)
header :: LastValueViewState -> Int -> HtmlWriter ()
header st index =
do writeHtmlHeader3WithId ("id" ++ show index) $
writeHtmlText (lastValueTitle $ lastValueView st)
let description = lastValueDescription $ lastValueView st
unless (null description) $
writeHtmlParagraph $
writeHtmlText description
formatPair :: (String, String) -> ShowS -> HtmlWriter ()
formatPair (name, value) formatter =
writeHtmlParagraph $
do writeHtmlText name
writeHtmlText " = "
writeHtmlText $ formatter value
lastValueTOCHtml :: LastValueViewState -> Int -> HtmlWriter ()
lastValueTOCHtml st index =
writeHtmlListItem $
writeHtmlLink ("#id" ++ show index) $
writeHtmlText (lastValueTitle $ lastValueView st)