aivika-experiment 1.3.1 → 1.4

raw patch · 21 files changed

+558/−1295 lines, 21 filesdep +network-uridep −arraydep −networkdep −vectordep ~aivikaPVP ok

version bump matches the API change (PVP)

Dependencies added: network-uri

Dependencies removed: array, network, vector

Dependency ranges changed: aivika

API changes (from Hackage documentation)

Files

• Simulation/Aivika/Experiment.hs +1/−7
• Simulation/Aivika/Experiment/ExperimentSpecsView.hs +16/−12
• Simulation/Aivika/Experiment/ExperimentSpecsWriter.hs +5/−9
• Simulation/Aivika/Experiment/FileRenderer.hs +0/−24
• Simulation/Aivika/Experiment/FinalStatsView.hs +56/−69
• Simulation/Aivika/Experiment/FinalTableView.hs +59/−70
• Simulation/Aivika/Experiment/Histogram.hs +8/−0
• Simulation/Aivika/Experiment/HtmlWriter.hs +12/−2
• Simulation/Aivika/Experiment/LastValueView.hs +36/−39
• Simulation/Aivika/Experiment/ListSource.hs +0/−88
• Simulation/Aivika/Experiment/MRef.hs +88/−0
• Simulation/Aivika/Experiment/SamplingStatsSource.hs +0/−68
• Simulation/Aivika/Experiment/SamplingStatsWriter.hs +2/−2
• Simulation/Aivika/Experiment/TableView.hs +47/−48
• Simulation/Aivika/Experiment/TimingStatsView.hs +46/−52
• Simulation/Aivika/Experiment/TimingStatsWriter.hs +2/−2
• Simulation/Aivika/Experiment/Types.hs +112/−751
• Simulation/Aivika/Experiment/Utils.hs +2/−2
• aivika-experiment.cabal +7/−10
• examples/LinearArray.hs +37/−20
• examples/MachRep3.hs +22/−20

@@ -5,7 +5,7 @@ -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 -- -- This module re-exports the library functionality. --@@ -13,35 +13,29 @@ module Simulation.Aivika.Experiment        (-- * Modules         module Simulation.Aivika.Experiment.Types,-        module Simulation.Aivika.Experiment.FileRenderer,         module Simulation.Aivika.Experiment.HtmlWriter,         module Simulation.Aivika.Experiment.LastValueView,         module Simulation.Aivika.Experiment.TableView,         module Simulation.Aivika.Experiment.TimingStatsView,         module Simulation.Aivika.Experiment.TimingStatsWriter,         module Simulation.Aivika.Experiment.SamplingStatsWriter,-        module Simulation.Aivika.Experiment.SamplingStatsSource,         module Simulation.Aivika.Experiment.FinalStatsView,         module Simulation.Aivika.Experiment.Histogram,         module Simulation.Aivika.Experiment.ExperimentSpecsView,         module Simulation.Aivika.Experiment.ExperimentSpecsWriter,         module Simulation.Aivika.Experiment.FinalTableView,-        module Simulation.Aivika.Experiment.ListSource,         module Simulation.Aivika.Experiment.Utils) where  import Simulation.Aivika.Experiment.Types-import Simulation.Aivika.Experiment.FileRenderer import Simulation.Aivika.Experiment.HtmlWriter import Simulation.Aivika.Experiment.LastValueView import Simulation.Aivika.Experiment.TableView import Simulation.Aivika.Experiment.TimingStatsView import Simulation.Aivika.Experiment.TimingStatsWriter import Simulation.Aivika.Experiment.SamplingStatsWriter-import Simulation.Aivika.Experiment.SamplingStatsSource import Simulation.Aivika.Experiment.FinalStatsView import Simulation.Aivika.Experiment.Histogram import Simulation.Aivika.Experiment.ExperimentSpecsView import Simulation.Aivika.Experiment.ExperimentSpecsWriter import Simulation.Aivika.Experiment.FinalTableView-import Simulation.Aivika.Experiment.ListSource import Simulation.Aivika.Experiment.Utils

@@ -3,11 +3,11 @@  -- | -- Module     : Simulation.Aivika.Experiment.ExperimentSpecsView--- Copyright  : Copyright (c) 2012, David Sorokin <david.sorokin@gmail.com>+-- Copyright  : Copyright (c) 2012-2014, David Sorokin <david.sorokin@gmail.com> -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.4.1+-- Tested with: GHC 7.6.3 -- -- The module defines 'ExperimentSpecsView' that shows the  -- experiment specs.@@ -20,6 +20,8 @@ import Control.Monad import Control.Monad.Trans +import Data.Monoid+ import Simulation.Aivika.Experiment.Types import Simulation.Aivika.Experiment.HtmlWriter import Simulation.Aivika.Experiment.ExperimentSpecsWriter@@ -41,31 +43,33 @@                         experimentSpecsDescription = "It shows the experiment specs.",                         experimentSpecsWriter      = defaultExperimentSpecsWriter } -instance ExperimentView ExperimentSpecsView r where  +instance WebPageRendering r => ExperimentView ExperimentSpecsView r WebPageWriter where        outputView v =      let reporter exp renderer dir =           do st <- newExperimentSpecs v exp+             let writer =+                   WebPageWriter { reporterWriteTOCHtml = experimentSpecsTOCHtml st,+                                   reporterWriteHtml    = experimentSpecsHtml st }              return ExperimentReporter { reporterInitialise = return (),                                          reporterFinalise   = return (),-                                         reporterSimulate   = const $ return $ return (),-                                         reporterTOCHtml    = experimentSpecsTOCHtml st,-                                         reporterHtml       = experimentSpecsHtml st }+                                         reporterSimulate   = const $ return mempty,+                                         reporterRequest    = writer }     in ExperimentGenerator { generateReporter = reporter }    -- | The state of the view.-data ExperimentSpecsViewState r =+data ExperimentSpecsViewState =   ExperimentSpecsViewState { experimentSpecsView       :: ExperimentSpecsView,-                             experimentSpecsExperiment :: Experiment r }+                             experimentSpecsExperiment :: Experiment }    -- | Create a new state of the view.-newExperimentSpecs :: ExperimentSpecsView -> Experiment r -> IO (ExperimentSpecsViewState r)+newExperimentSpecs :: ExperimentSpecsView -> Experiment -> IO ExperimentSpecsViewState newExperimentSpecs view exp =   return ExperimentSpecsViewState { experimentSpecsView       = view,                                     experimentSpecsExperiment = exp }         -- | Get the HTML code.     -experimentSpecsHtml :: ExperimentSpecsViewState r -> Int -> HtmlWriter ()     +experimentSpecsHtml :: ExperimentSpecsViewState -> Int -> HtmlWriter ()      experimentSpecsHtml st index =   do header st index      let writer = experimentSpecsWriter (experimentSpecsView st)@@ -73,7 +77,7 @@          exp    = experimentSpecsExperiment st      write writer exp -header :: ExperimentSpecsViewState r -> Int -> HtmlWriter ()+header :: ExperimentSpecsViewState -> Int -> HtmlWriter () header st index =   do writeHtmlHeader3WithId ("id" ++ show index) $        writeHtmlText (experimentSpecsTitle $ experimentSpecsView st)@@ -83,7 +87,7 @@        writeHtmlText description  -- | Get the TOC item     -experimentSpecsTOCHtml :: ExperimentSpecsViewState r -> Int -> HtmlWriter ()+experimentSpecsTOCHtml :: ExperimentSpecsViewState -> Int -> HtmlWriter () experimentSpecsTOCHtml st index =   writeHtmlListItem $   writeHtmlLink ("#id" ++ show index) $

@@ -1,13 +1,11 @@ -{-# LANGUAGE RankNTypes #-}- -- | -- Module     : Simulation.Aivika.Experiment.ExperimentSpecsWriter--- Copyright  : Copyright (c) 2012, David Sorokin <david.sorokin@gmail.com>+-- Copyright  : Copyright (c) 2012-2014, David Sorokin <david.sorokin@gmail.com> -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.4.1+-- Tested with: GHC 7.6.3 -- -- The module defines 'ExperimentSpecsWriter' that knows how to write -- in HTML the experiment specs which include the simulation specs and @@ -18,11 +16,10 @@        (ExperimentSpecsWriter(..),         defaultExperimentSpecsWriter) where +import Simulation.Aivika import Simulation.Aivika.Experiment.Types import Simulation.Aivika.Experiment.HtmlWriter -import Simulation.Aivika.Specs- -- | Defines a writer that knows how to represent the -- experiment specs as the HTML table. data ExperimentSpecsWriter =@@ -48,9 +45,8 @@                           -- ^ Translated text \"the 4-th order Runge-Kutta\".                           experimentSpecsFormatter     :: ShowS,                           -- ^ The formatter of numbers.-                          experimentSpecsWrite :: forall r.-                                                  ExperimentSpecsWriter-                                                  -> Experiment r+                          experimentSpecsWrite :: ExperimentSpecsWriter+                                                  -> Experiment                                                   -> HtmlWriter ()                           -- ^ This function creates HTML.                         }

@@ -1,24 +0,0 @@---- |--- Module     : Simulation.Aivika.Experiment.FileRenderer--- Copyright  : Copyright (c) 2012, David Sorokin <david.sorokin@gmail.com>--- License    : BSD3--- Maintainer : David Sorokin <david.sorokin@gmail.com>--- Stability  : experimental--- Tested with: GHC 7.4.1------ It defines a basic experiment renderer that allows saving the simulation results in files.-----module Simulation.Aivika.Experiment.FileRenderer-       (FileRenderer(..),-        HtmlRenderer(..)) where---- | The experiment renderer that allows saving the simulation results in files.-class FileRenderer a---- | The default renderer that creates an HTML page for the simulation experiment.-data HtmlRenderer = HtmlRenderer-                    -- ^ The default HTML renderer.--instance FileRenderer HtmlRenderer

@@ -3,11 +3,11 @@  -- | -- Module     : Simulation.Aivika.Experiment.FinalStatsView--- Copyright  : Copyright (c) 2012, David Sorokin <david.sorokin@gmail.com>+-- Copyright  : Copyright (c) 2012-2014, David Sorokin <david.sorokin@gmail.com> -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.4.1+-- Tested with: GHC 7.8.3 -- -- The module defines 'FinalStatsView' gathers the statistics -- in the final time points for different simulation runs.@@ -24,16 +24,11 @@ import Data.IORef import Data.Maybe +import Simulation.Aivika import Simulation.Aivika.Experiment.Types import Simulation.Aivika.Experiment.HtmlWriter import Simulation.Aivika.Experiment.SamplingStatsWriter-import Simulation.Aivika.Experiment.SamplingStatsSource--import Simulation.Aivika.Specs-import Simulation.Aivika.Simulation-import Simulation.Aivika.Event-import Simulation.Aivika.Signal-import Simulation.Aivika.Statistics+import Simulation.Aivika.Experiment.MRef  -- | Defines the 'View' that gathers the statistics -- in the final time points.@@ -47,38 +42,41 @@                    finalStatsPredicate   :: Event Bool,                    -- ^ It specifies the predicate that defines                    -- when we count data when gathering the statistics.-                   finalStatsSeries      :: [String]-                   -- ^ It contains the labels of data for which-                   -- the statistics is collected.+                   finalStatsTransform   :: ResultTransform,+                   -- ^ The transform applied to the results before receiving series.+                   finalStatsSeries      :: ResultTransform +                   -- ^ It defines the series for which the statistics to be collected.                  }    -- | The default statistics view.   defaultFinalStatsView :: FinalStatsView defaultFinalStatsView =    FinalStatsView { finalStatsTitle       = "Final Statistics",-                   finalStatsDescription = "The statistical data are gathered in the final time points for all runs.",+                   finalStatsDescription = "Statistics is gathered in final time points for all runs.",                    finalStatsWriter      = defaultSamplingStatsWriter,                    finalStatsPredicate   = return True,-                   finalStatsSeries      = [] }+                   finalStatsTransform   = id,+                   finalStatsSeries      = id } -instance ExperimentView FinalStatsView r where+instance WebPageRendering r => ExperimentView FinalStatsView r WebPageWriter where      outputView v =      let reporter exp renderer dir =           do st <- newFinalStats v exp dir+             let writer =+                   WebPageWriter { reporterWriteTOCHtml = finalStatsTOCHtml st,+                                   reporterWriteHtml    = finalStatsHtml st }              return ExperimentReporter { reporterInitialise = return (),                                          reporterFinalise   = return (),                                          reporterSimulate   = simulateFinalStats st,-                                         reporterTOCHtml    = finalStatsTOCHtml st,-                                         reporterHtml       = finalStatsHtml st }+                                         reporterRequest    = writer }     in ExperimentGenerator { generateReporter = reporter }    -- | The state of the view.-data FinalStatsViewState r =+data FinalStatsViewState =   FinalStatsViewState { finalStatsView       :: FinalStatsView,-                        finalStatsExperiment :: Experiment r,-                        finalStatsLock       :: MVar (),-                        finalStatsResults    :: IORef (Maybe FinalStatsResults) }+                        finalStatsExperiment :: Experiment,+                        finalStatsResults    :: MRef (Maybe FinalStatsResults) }  -- | The statistics results. data FinalStatsResults =@@ -86,68 +84,57 @@                       finalStatsValues :: [IORef (SamplingStats Double)] }    -- | Create a new state of the view.-newFinalStats :: FinalStatsView -> Experiment r -> FilePath -> IO (FinalStatsViewState r)+newFinalStats :: FinalStatsView -> Experiment -> FilePath -> IO FinalStatsViewState newFinalStats view exp dir =-  do l <- newMVar () -     r <- newIORef Nothing+  do r <- newMRef Nothing      return FinalStatsViewState { finalStatsView       = view,                                   finalStatsExperiment = exp,-                                  finalStatsLock       = l,                                    finalStatsResults    = r }         -- | Create new statistics results.-newFinalStatsResults :: [String] -> Experiment r -> IO FinalStatsResults+newFinalStatsResults :: [String] -> Experiment -> IO FinalStatsResults newFinalStatsResults names exp =   do values <- forM names $ \_ -> liftIO $ newIORef emptySamplingStats      return FinalStatsResults { finalStatsNames  = names,                                 finalStatsValues = values }++-- | Require to return unique final statistics results associated with the specified state. +requireFinalStatsResults :: FinalStatsViewState -> [String] -> IO FinalStatsResults+requireFinalStatsResults st names =+  maybeWriteMRef (finalStatsResults st)+  (newFinalStatsResults names (finalStatsExperiment st)) $ \results ->+  if (names /= finalStatsNames results)+  then error "Series with different names are returned for different runs: requireFinalStatsResults"+  else results        --- | Simulation the specified series.-simulateFinalStats :: FinalStatsViewState r -> ExperimentData -> Event (Event ())+-- | Simulate the specified series.+simulateFinalStats :: FinalStatsViewState -> ExperimentData -> Event DisposableEvent simulateFinalStats st expdata =-  do let protolabels = finalStatsSeries $ finalStatsView st-         protoproviders = flip map protolabels $ \protolabel ->-           experimentSeriesProviders expdata [protolabel]-         providers = concat protoproviders-         input =-           flip map providers $ \provider ->-           case providerToDoubleStatsSource provider of-             Nothing -> error $-                        "Cannot represent series " ++-                        providerName provider ++ -                        " as a source of double values: simulateFinalStats"-             Just input -> samplingStatsSourceData input-         names = map providerName providers-         predicate = finalStatsPredicate $ finalStatsView st-         exp = finalStatsExperiment st-         lock = finalStatsLock st-     results <- liftIO $ readIORef (finalStatsResults st)-     case results of-       Nothing ->-         liftIO $-         do results <- newFinalStatsResults names exp-            writeIORef (finalStatsResults st) $ Just results-       Just results ->-         when (names /= finalStatsNames results) $-         error "Series with different names are returned for different runs: simulateFinalStats"-     results <- liftIO $ fmap fromJust $ readIORef (finalStatsResults st)-     let values = finalStatsValues results-         h = filterSignalM (const predicate) $-             experimentSignalInStopTime expdata-     handleSignal_ h $ \_ ->-       do xs <- sequence input-          liftIO $ withMVar lock $ \() ->-            forM_ (zip xs values) $ \(x, values) ->-            do y <- readIORef values-               let y' = addDataToSamplingStats x y-               y' `seq` writeIORef values y'-     return $ return ()+  do let view    = finalStatsView st+         rs      = finalStatsSeries view $+                   finalStatsTransform view $+                   experimentResults expdata+         exts    = extractDoubleStatsEitherResults rs+         signals = experimentPredefinedSignals expdata+         signal  = filterSignalM (const predicate) $+                   resultSignalInStopTime signals+         names   = map resultExtractName exts+         predicate = finalStatsPredicate view+     results <- liftIO $ requireFinalStatsResults st names+     let values = finalStatsValues results +     handleSignal signal $ \_ ->+       forM_ (zip exts values) $ \(ext, value) ->+       do x <- resultExtractData ext+          liftIO $+            do y <- readIORef value+               let y' = combineSamplingStatsEither x y+               y' `seq` writeIORef value y'  -- | Get the HTML code.     -finalStatsHtml :: FinalStatsViewState r -> Int -> HtmlWriter ()+finalStatsHtml :: FinalStatsViewState -> Int -> HtmlWriter () finalStatsHtml st index =   do header st index-     results <- liftIO $ readIORef (finalStatsResults st)+     results <- liftIO $ readMRef (finalStatsResults st)      case results of        Nothing -> return ()        Just results ->@@ -159,7 +146,7 @@               do stats <- liftIO $ readIORef value                  write writer name stats -header :: FinalStatsViewState r -> Int -> HtmlWriter ()+header :: FinalStatsViewState -> Int -> HtmlWriter () header st index =   do writeHtmlHeader3WithId ("id" ++ show index) $         writeHtmlText (finalStatsTitle $ finalStatsView st)@@ -169,7 +156,7 @@        writeHtmlText description  -- | Get the TOC item.-finalStatsTOCHtml :: FinalStatsViewState r -> Int -> HtmlWriter ()+finalStatsTOCHtml :: FinalStatsViewState -> Int -> HtmlWriter () finalStatsTOCHtml st index =   writeHtmlListItem $   writeHtmlLink ("#id" ++ show index) $

@@ -3,11 +3,11 @@  -- | -- Module     : Simulation.Aivika.Experiment.FinalTableView--- Copyright  : Copyright (c) 2012, David Sorokin <david.sorokin@gmail.com>+-- Copyright  : Copyright (c) 2012-2014, David Sorokin <david.sorokin@gmail.com> -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.4.1+-- Tested with: GHC 7.8.3 -- -- The module defines 'FinalTableView' that saves the simulation -- results in the final time points for all simulation runs in@@ -29,15 +29,10 @@ import System.IO import System.FilePath +import Simulation.Aivika import Simulation.Aivika.Experiment.Types-import Simulation.Aivika.Experiment.FileRenderer import Simulation.Aivika.Experiment.HtmlWriter--import Simulation.Aivika.Specs-import Simulation.Aivika.Parameter-import Simulation.Aivika.Simulation-import Simulation.Aivika.Event-import Simulation.Aivika.Signal+import Simulation.Aivika.Experiment.MRef  -- | Defines the 'View' that saves the simulation  -- results in the final time points for all @@ -79,9 +74,10 @@                    finalTablePredicate   :: Event Bool,                    -- ^ It specifies the predicate that defines                    -- when we can save data in the table.-                   finalTableSeries      :: [String] -                   -- ^ It contains the labels of data saved-                   -- in the CSV file.+                   finalTableTransform   :: ResultTransform,+                   -- ^ The transform applied to the results before receiving series.+                   finalTableSeries      :: ResultTransform +                   -- ^ It defines the series to save in the CSV file.                  }    -- | The default table view.  @@ -95,105 +91,98 @@                    finalTableSeparator   = ",",                    finalTableFormatter   = id,                    finalTablePredicate   = return True,-                   finalTableSeries      = [] }+                   finalTableTransform   = expandResults,+                   finalTableSeries      = id } -instance FileRenderer r => ExperimentView FinalTableView r where+instance WebPageRendering r => ExperimentView FinalTableView r WebPageWriter where      outputView v =      let reporter exp renderer dir =           do st <- newFinalTable v exp dir+             let writer =+                   WebPageWriter { reporterWriteTOCHtml = finalTableTOCHtml st,+                                   reporterWriteHtml    = finalTableHtml st }              return ExperimentReporter { reporterInitialise = return (),                                          reporterFinalise   = finaliseFinalTable st,                                          reporterSimulate   = simulateFinalTable st,-                                         reporterTOCHtml    = finalTableTOCHtml st,-                                         reporterHtml       = finalTableHtml st }+                                         reporterRequest    = writer }     in ExperimentGenerator { generateReporter = reporter }    -- | The state of the view.-data FinalTableViewState r =+data FinalTableViewState =   FinalTableViewState { finalTableView       :: FinalTableView,-                        finalTableExperiment :: Experiment r,+                        finalTableExperiment :: Experiment,                         finalTableDir        :: FilePath,                          finalTableFile       :: IORef (Maybe FilePath),-                        finalTableLock       :: MVar (),-                        finalTableResults    :: IORef (Maybe FinalTableResults) }+                        finalTableResults    :: MRef (Maybe FinalTableResults) }  -- | The table results. data FinalTableResults =   FinalTableResults { finalTableNames  :: [String],-                      finalTableValues :: IORef (M.Map Int [String]) }+                      finalTableValues :: MRef (M.Map Int [String]) }    -- | Create a new state of the view.-newFinalTable :: FinalTableView -> Experiment r -> FilePath -> IO (FinalTableViewState r)+newFinalTable :: FinalTableView -> Experiment -> FilePath -> IO FinalTableViewState newFinalTable view exp dir =   do f <- newIORef Nothing-     l <- newMVar () -     r <- newIORef Nothing+     r <- newMRef Nothing      return FinalTableViewState { finalTableView       = view,                                   finalTableExperiment = exp,                                   finalTableDir        = dir,                                    finalTableFile       = f,-                                  finalTableLock       = l,                                    finalTableResults    = r }         -- | Create new table results.-newFinalTableResults :: [String] -> Experiment r -> IO FinalTableResults+newFinalTableResults :: [String] -> Experiment -> IO FinalTableResults newFinalTableResults names exp =-  do values <- newIORef M.empty +  do values <- newMRef M.empty       return FinalTableResults { finalTableNames  = names,                                 finalTableValues = values }++-- | Require to return unique final tables results associated with the specified state. +requireFinalTableResults :: FinalTableViewState -> [String] -> IO FinalTableResults+requireFinalTableResults st names =+  maybeWriteMRef (finalTableResults st)+  (newFinalTableResults names (finalTableExperiment st)) $ \results ->+  if (names /= finalTableNames results)+  then error "Series with different names are returned for different runs: requireFinalTableResults"+  else results         -- | Simulation of the specified series.-simulateFinalTable :: FinalTableViewState r -> ExperimentData -> Event (Event ())+simulateFinalTable :: FinalTableViewState -> ExperimentData -> Event DisposableEvent simulateFinalTable st expdata =-  do let labels = finalTableSeries $ finalTableView st-         providers = experimentSeriesProviders expdata labels-         input =-           flip map providers $ \provider ->-           case providerToString provider of-             Nothing -> error $-                        "Cannot represent series " ++-                        providerName provider ++ -                        " as string values: simulateFinalTable"-             Just input -> input-         names = map providerName providers-         predicate = finalTablePredicate $ finalTableView st-         exp = finalTableExperiment st-         lock = finalTableLock st-     results <- liftIO $ readIORef (finalTableResults st)-     case results of-       Nothing ->-         liftIO $-         do results <- newFinalTableResults names exp-            writeIORef (finalTableResults st) $ Just results-       Just results ->-         when (names /= finalTableNames results) $-         error "Series with different names are returned for different runs: simulateFinalTable"-     results <- liftIO $ fmap fromJust $ readIORef (finalTableResults st)-     let values = finalTableValues results-         h = filterSignalM (const predicate) $-             experimentSignalInStopTime expdata-     handleSignal_ h $ \_ ->-       do xs <- sequence input+  do let view    = finalTableView st+         rs      = finalTableSeries view $+                   finalTableTransform view $+                   experimentResults expdata+         exts    = extractStringResults rs+         signals = experimentPredefinedSignals expdata+         signal  = filterSignalM (const predicate) $+                   resultSignalInStopTime signals+         names   = map resultExtractName exts+         predicate = finalTablePredicate view+     results <- liftIO $ requireFinalTableResults st names+     let values = finalTableValues results +     handleSignal signal $ \_ ->+       do xs <- mapM resultExtractData exts           i  <- liftParameter simulationIndex-          liftIO $ withMVar lock $ \() ->-            modifyIORef values $ M.insert i xs-     return $ return ()+          liftIO $ modifyMRef values $ M.insert i xs       -- | Save the results in the CSV file after the simulation is complete.-finaliseFinalTable :: FinalTableViewState r -> IO ()+finaliseFinalTable :: FinalTableViewState -> IO () finaliseFinalTable st =-  do let run       = finalTableRunText $ finalTableView st-         formatter = finalTableFormatter $ finalTableView st-         title     = finalTableTitle $ finalTableView st-         separator = finalTableSeparator $ finalTableView st-     results <- readIORef $ finalTableResults st+  do let view      = finalTableView st+         run       = finalTableRunText view+         formatter = finalTableFormatter view+         title     = finalTableTitle view+         separator = finalTableSeparator view+     results <- readMRef $ finalTableResults st      case results of        Nothing -> return ()        Just results ->          do let names  = finalTableNames results                 values = finalTableValues results-            m <- readIORef values +            m <- readMRef values              file <- resolveFilePath (finalTableDir st) $                     mapFilePath (flip replaceExtension ".csv") $                     expandFilePath (finalTableFileName $ finalTableView st) $@@ -220,7 +209,7 @@             writeIORef (finalTableFile st) $ Just file       -- | Get the HTML code.     -finalTableHtml :: FinalTableViewState r -> Int -> HtmlWriter ()+finalTableHtml :: FinalTableViewState -> Int -> HtmlWriter () finalTableHtml st index =   do header st index      file <- liftIO $ readIORef (finalTableFile st)@@ -231,7 +220,7 @@          writeHtmlLink (makeRelative (finalTableDir st) f) $          writeHtmlText (finalTableLinkText $ finalTableView st) -header :: FinalTableViewState r -> Int -> HtmlWriter ()+header :: FinalTableViewState -> Int -> HtmlWriter () header st index =   do writeHtmlHeader3WithId ("id" ++ show index) $         writeHtmlText (finalTableTitle $ finalTableView st)@@ -241,7 +230,7 @@        writeHtmlText description  -- | Get the TOC item.-finalTableTOCHtml :: FinalTableViewState r -> Int -> HtmlWriter ()+finalTableTOCHtml :: FinalTableViewState -> Int -> HtmlWriter () finalTableTOCHtml st index =   writeHtmlListItem $   writeHtmlLink ("#id" ++ show index) $

@@ -1,4 +1,12 @@ +-- |+-- Module     : Simulation.Aivika.Experiment.Histogram+-- Copyright  : Copyright (c) 2012-2014, David Sorokin <david.sorokin@gmail.com>+-- License    : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability  : experimental+-- Tested with: GHC 7.6.3+-- -- | This module computes the histogram by the  -- specified data and strategy applied for such computing. --

@@ -1,11 +1,11 @@  -- | -- Module     : Simulation.Aivika.Experiment.HtmlWriter--- Copyright  : Copyright (c) 2012, David Sorokin <david.sorokin@gmail.com>+-- Copyright  : Copyright (c) 2012-2014, David Sorokin <david.sorokin@gmail.com> -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.4.1+-- Tested with: GHC 7.8.3 -- -- This is an utility module that provides an HTML writer. --@@ -41,6 +41,7 @@  import Control.Monad import Control.Monad.Trans+import Control.Applicative  import Network.URI @@ -64,6 +65,15 @@   liftIO m = HtmlWriter $ \f ->     do x <- m        return (x, f)++instance Functor HtmlWriter where++  fmap f m = m >>= \a -> return (f a)++instance Applicative HtmlWriter where++  pure = return+  (<*>) = ap         -- | Write the HTML code. writeHtml :: String -> HtmlWriter ()

@@ -3,11 +3,11 @@  -- | -- Module     : Simulation.Aivika.Experiment.LastValueView--- Copyright  : Copyright (c) 2012, David Sorokin <david.sorokin@gmail.com>+-- Copyright  : Copyright (c) 2012-2014, David Sorokin <david.sorokin@gmail.com> -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.4.1+-- Tested with: GHC 7.8.3 -- -- The module defines 'LastValueView' that shows the last values -- for the simulation variables.@@ -24,16 +24,11 @@ import Data.IORef import Data.Maybe +import Simulation.Aivika import Simulation.Aivika.Experiment.Types import Simulation.Aivika.Experiment.HtmlWriter import Simulation.Aivika.Experiment.Utils (replace) -import Simulation.Aivika.Specs-import Simulation.Aivika.Parameter-import Simulation.Aivika.Simulation-import Simulation.Aivika.Event-import Simulation.Aivika.Signal- -- | Defines the 'View' that shows the last values of the simulation -- variables. data LastValueView =@@ -53,8 +48,10 @@                   -- ^ The description for the view.                   lastValueFormatter   :: ShowS,                   -- ^ It transforms data before they will be shown.-                  lastValueSeries      :: [String] -                  -- ^ It contains the labels of the observed series.+                  lastValueTransform   :: ResultTransform,+                  -- ^ The transform applied to the results before receiving series.+                  lastValueSeries      :: ResultTransform +                  -- ^ It defines the series for which the last values to be shown.                 }    -- | This is the default view.@@ -62,30 +59,33 @@ defaultLastValueView =     LastValueView { lastValueTitle       = "The Last Values",                   lastValueRunTitle    = "$TITLE / Run $RUN_INDEX of $RUN_COUNT",-                  lastValueDescription = "It shows the values in the final time points.",+                  lastValueDescription = "It shows the values in the final time point(s).",                   lastValueFormatter   = id,-                  lastValueSeries      = [] }+                  lastValueTransform   = id,+                  lastValueSeries      = id }   -instance ExperimentView LastValueView r where  +instance WebPageRendering r => ExperimentView LastValueView r WebPageWriter where        outputView v =      let reporter exp renderer dir =           do st <- newLastValues v exp+             let writer =+                   WebPageWriter { reporterWriteTOCHtml = lastValueTOCHtml st,+                                   reporterWriteHtml    = lastValueHtml st }              return ExperimentReporter { reporterInitialise = return (),                                          reporterFinalise   = return (),                                          reporterSimulate   = simulateLastValues st,-                                         reporterTOCHtml    = lastValueTOCHtml st,-                                         reporterHtml       = lastValueHtml st }+                                         reporterRequest    = writer }     in ExperimentGenerator { generateReporter = reporter }-  + -- | The state of the view.-data LastValueViewState r =+data LastValueViewState =   LastValueViewState { lastValueView       :: LastValueView,-                       lastValueExperiment :: Experiment r,+                       lastValueExperiment :: Experiment,                        lastValueMap        :: M.Map Int (IORef [(String, String)]) }    -- | Create a new state of the view.-newLastValues :: LastValueView -> Experiment r -> IO (LastValueViewState r)+newLastValues :: LastValueView -> Experiment -> IO LastValueViewState newLastValues view exp =   do let n = experimentRunCount exp      rs <- forM [0..(n - 1)] $ \i -> newIORef []    @@ -95,28 +95,25 @@                                  lastValueMap        = m }         -- | Get the last values during the simulation.-simulateLastValues :: LastValueViewState r -> ExperimentData -> Event (Event ())+simulateLastValues :: LastValueViewState -> ExperimentData -> Event DisposableEvent simulateLastValues st expdata =-  do let labels = lastValueSeries $ lastValueView st-         input  =-           flip map (experimentSeriesProviders expdata labels) $ \provider ->-           case providerToString provider of-             Nothing -> error $-                        "Cannot represent series " ++-                        providerName provider ++ -                        " as a string: simulateLastValues"-             Just input -> (providerName provider, input)+  do let view    = lastValueView st+         rs      = lastValueSeries view $+                   lastValueTransform view $+                   experimentResults expdata+         exts    = extractStringResults rs+         signals = experimentPredefinedSignals expdata+         signal  = resultSignalInStopTime signals      i <- liftParameter simulationIndex-     handleSignal_ (experimentSignalInStopTime expdata) $ \t ->+     handleSignal signal $ \t ->        do let r = fromJust $ M.lookup (i - 1) (lastValueMap st)-          output <- forM input $ \(name, input) ->-            do x <- input-               return (name, x)+          output <- forM exts $ \ext ->+            do x <- resultExtractData ext+               return (resultExtractName ext, x)           liftIO $ writeIORef r output-     return $ return ()       -- | Get the HTML code.     -lastValueHtml :: LastValueViewState r -> Int -> HtmlWriter ()     +lastValueHtml :: LastValueViewState -> Int -> HtmlWriter ()      lastValueHtml st index =   let n = experimentRunCount $ lastValueExperiment st   in if n == 1@@ -124,7 +121,7 @@      else lastValueHtmlMultiple st index       -- | Get the HTML code for a single run.-lastValueHtmlSingle :: LastValueViewState r -> Int -> HtmlWriter ()+lastValueHtmlSingle :: LastValueViewState -> Int -> HtmlWriter () lastValueHtmlSingle st index =   do header st index      let r = fromJust $ M.lookup 0 (lastValueMap st)@@ -133,7 +130,7 @@        formatPair pair (lastValueFormatter $ lastValueView st)  -- | Get the HTML code for multiple runs-lastValueHtmlMultiple :: LastValueViewState r -> Int -> HtmlWriter ()+lastValueHtmlMultiple :: LastValueViewState -> Int -> HtmlWriter () lastValueHtmlMultiple st index =   do header st index      let n = experimentRunCount $ lastValueExperiment st@@ -150,7 +147,7 @@           forM_ pairs $ \pair ->             formatPair pair (lastValueFormatter $ lastValueView st) -header :: LastValueViewState r -> Int -> HtmlWriter ()+header :: LastValueViewState -> Int -> HtmlWriter () header st index =   do writeHtmlHeader3WithId ("id" ++ show index) $        writeHtmlText (lastValueTitle $ lastValueView st)@@ -167,7 +164,7 @@      writeHtmlText $ formatter value            -- | Get the TOC item     -lastValueTOCHtml :: LastValueViewState r -> Int -> HtmlWriter ()+lastValueTOCHtml :: LastValueViewState -> Int -> HtmlWriter () lastValueTOCHtml st index =   writeHtmlListItem $   writeHtmlLink ("#id" ++ show index) $

@@ -1,88 +0,0 @@---- |--- Module     : Simulation.Aivika.Experiment.ListSource--- Copyright  : Copyright (c) 2013, David Sorokin <david.sorokin@gmail.com>--- License    : BSD3--- Maintainer : David Sorokin <david.sorokin@gmail.com>--- Stability  : experimental--- Tested with: GHC 7.6.3------ It represents an optimized source of data to construct the list.-----module Simulation.Aivika.Experiment.ListSource-       (ListSource,-        providerToDoubleListSource,-        providerToIntListSource,-        ListData,-        listSourceData,-        listDataList,-        ListRef,-        newListRef,-        addDataToListRef,-        readListRef) where--import Data.IORef-import Control.Monad--import Simulation.Aivika.Event-import Simulation.Aivika.Statistics-import Simulation.Aivika.Experiment.Types---- | Represents the optimized source of data for constructing the list.-data ListSource a = SingleValueSource (Event a)-                  | MultipleValueSource (Event [a])---- | Represents the optimized data by which the list will be created.-data ListData a = SingleValueData !a-                | MultipleValueData [a]---- | Try to return the source of list data by the specified provider.-providerToDoubleListSource :: SeriesProvider -> Maybe (ListSource Double)-providerToDoubleListSource provider =-  case providerToDouble provider of-    Just x -> Just $ SingleValueSource x-    Nothing ->-      case providerToDoubleList provider of-        Just x -> Just $ MultipleValueSource x-        Nothing -> Nothing-        --- | Try to return the source of list data by the specified provider.-providerToIntListSource :: SeriesProvider -> Maybe (ListSource Int)-providerToIntListSource provider =-  case providerToInt provider of-    Just x -> Just $ SingleValueSource x-    Nothing ->-      case providerToIntList provider of-        Just x -> Just $ MultipleValueSource x-        Nothing -> Nothing---- | Get data from the source in the current time point.-listSourceData :: ListSource a -> Event (ListData a)-listSourceData (SingleValueSource x)    = x >>= return . SingleValueData-listSourceData (MultipleValueSource xs) =-  do ys <- xs-     zs <- forM ys $ \y -> return $ y `seq` y-     return $ MultipleValueData ys  -- it contains strict data, which is important for big models ---- | Return the list of values contained in the specified data.-listDataList :: ListData a -> [a]-listDataList (SingleValueData x)    = [x]-listDataList (MultipleValueData xs) = xs---- | Represents a reference to the list, optimized to work with the source of data.-newtype ListRef a = ListRef { listRef :: IORef [ListData a] } ---- | Create a new list reference.-newListRef :: IO (ListRef a)-newListRef = fmap ListRef $ newIORef []---- | Add data to the list reference.-addDataToListRef :: ListRef a -> ListData a -> IO ()-addDataToListRef (ListRef r) a = modifyIORef r (a :)---- | Read the list contained in the reference.-readListRef :: ListRef a -> IO [a]-readListRef (ListRef r) =-  do x <- readIORef r-     return $ concat $ map listDataList x 

@@ -0,0 +1,88 @@++-- |+-- Module     : Simulation.Aivika.Experiment.MRef+-- Copyright  : Copyright (c) 2012-2014, David Sorokin <david.sorokin@gmail.com>+-- License    : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability  : experimental+-- Tested with: GHC 7.8.3+--+-- The module defines a shared mutable reference accessible from different threads.+--++module Simulation.Aivika.Experiment.MRef+       (MRef,+        newMRef,+        readMRef,+        maybeReadMRef,+        writeMRef,+        maybeWriteMRef,+        modifyMRef) where++import Control.Concurrent.MVar++import Data.Maybe+import Data.IORef++-- | This is a shared mutable reference accessible from different threads.+data MRef a =+  MRef { mrefLock :: MVar (),+         -- ^ A reference lock.+         mrefData :: IORef a+         -- ^ The reference itself.+       }++-- | Create a new shared reference with the specified initial value.+newMRef :: a -> IO (MRef a)+newMRef a =+  do v <- newMVar ()+     r <- newIORef a+     return MRef { mrefLock = v,+                   mrefData = r }++-- | Read the contents of the shared reference.+readMRef :: MRef a -> IO a+readMRef = readIORef . mrefData++-- | Like 'maybe' but for the shared reference under assumption+-- that the reference is updated only once by its initial value.+maybeReadMRef :: b -> (a -> b) -> MRef (Maybe a) -> IO b+maybeReadMRef b0 f x =+  do a <- readIORef (mrefData x)+     case a of+       Just a -> return (f a)+       Nothing ->+         withMVar (mrefLock x) $ \() ->+         do a <- readIORef (mrefData x)+            case a of+              Just a -> return (f a)+              Nothing -> return b0++-- | Update the contents of the shared reference.+writeMRef :: MRef a -> a -> IO ()+writeMRef x a =+  withMVar (mrefLock x) $ \() ->+  writeIORef (mrefData x) a++-- | Update the contents if the reference was empty and then return a result of+-- applying the specified function to either the initial or current value.+maybeWriteMRef :: MRef (Maybe a) -> IO a -> (a -> b) -> IO b+maybeWriteMRef x m0 f =+  do a <- readIORef (mrefData x)+     case a of+       Just a -> return (f a)+       Nothing ->+         withMVar (mrefLock x) $ \() ->+         do a <- readIORef (mrefData x)+            case a of+              Just a -> return (f a)+              Nothing ->+                do a0 <- m0+                   writeIORef (mrefData x) (Just a0)+                   return (f a0)++-- | Modify the contents of the shared reference.+modifyMRef :: MRef a -> (a -> a) -> IO ()+modifyMRef x f =+  withMVar (mrefLock x) $ \() ->+  modifyIORef (mrefData x) f

@@ -1,68 +0,0 @@---- |--- Module     : Simulation.Aivika.Experiment.SamplingStatsSource--- Copyright  : Copyright (c) 2013, David Sorokin <david.sorokin@gmail.com>--- License    : BSD3--- Maintainer : David Sorokin <david.sorokin@gmail.com>--- Stability  : experimental--- Tested with: GHC 7.6.3------ It represents an optimized source of statistical data.-----module Simulation.Aivika.Experiment.SamplingStatsSource-       (SamplingStatsSource,-        providerToDoubleStatsSource,-        providerToIntStatsSource,-        SamplingStatsData,-        samplingStatsSourceData,-        addDataToSamplingStats) where--import Simulation.Aivika.Event-import Simulation.Aivika.Statistics-import Simulation.Aivika.Experiment.Types---- | Represents the optimized source of data for the statistics.-data SamplingStatsSource a = SingleValueSource (Event a)-                           | MultipleValueSource (Event (SamplingStats a))---- | Represents the optimized data to be included in the statistics.-data SamplingStatsData a = SingleValueData !a-                         | MultipleValueData (SamplingStats a)---- | Try to return the source of statistical data by the specified provider.-providerToDoubleStatsSource :: SeriesProvider -> Maybe (SamplingStatsSource Double)-providerToDoubleStatsSource provider =-  case providerToDouble provider of-    Just x -> Just $ SingleValueSource x-    Nothing ->-      case providerToDoubleStats provider of-        Just x -> Just $ MultipleValueSource x-        Nothing -> Nothing-        --- | Try to return the source of statistical data.-providerToIntStatsSource :: SeriesProvider -> Maybe (SamplingStatsSource Int)-providerToIntStatsSource provider =-  case providerToInt provider of-    Just x -> Just $ SingleValueSource x-    Nothing ->-      case providerToIntStats provider of-        Just x -> Just $ MultipleValueSource x-        Nothing -> Nothing---- | Get data from the source in the current time point.-samplingStatsSourceData :: SamplingStatsSource a -> Event (SamplingStatsData a)-samplingStatsSourceData source =-  case source of-    SingleValueSource x -> x >>= return . SingleValueData-    MultipleValueSource x -> x >>= return . MultipleValueData---- | Add data from the source to the statistics.-addDataToSamplingStats :: SamplingData a-                          => SamplingStatsData a-                          -> SamplingStats a-                          -> SamplingStats a-addDataToSamplingStats d stats =-  case d of-    SingleValueData x -> addSamplingStats x stats-    MultipleValueData x -> combineSamplingStats x stats

@@ -1,11 +1,11 @@  -- | -- Module     : Simulation.Aivika.Experiment.SamplingStatsWriter--- Copyright  : Copyright (c) 2012, David Sorokin <david.sorokin@gmail.com>+-- Copyright  : Copyright (c) 2012-2014, David Sorokin <david.sorokin@gmail.com> -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.4.1+-- Tested with: GHC 7.6.3 -- -- The module defines 'SamplingStatsWriter' that knows how to write -- the sampling statistics in HTML.

@@ -3,11 +3,11 @@  -- | -- Module     : Simulation.Aivika.Experiment.TableView--- Copyright  : Copyright (c) 2012, David Sorokin <david.sorokin@gmail.com>+-- Copyright  : Copyright (c) 2012-2014, David Sorokin <david.sorokin@gmail.com> -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.4.1+-- Tested with: GHC 7.8.3 -- -- The module defines 'TableView' that saves the simulation -- results in the CSV file(s).@@ -23,21 +23,16 @@ import qualified Data.Map as M import Data.IORef import Data.Maybe+import Data.Monoid  import System.IO import System.FilePath +import Simulation.Aivika import Simulation.Aivika.Experiment.Types-import Simulation.Aivika.Experiment.FileRenderer import Simulation.Aivika.Experiment.HtmlWriter import Simulation.Aivika.Experiment.Utils (replace) -import Simulation.Aivika.Specs-import Simulation.Aivika.Parameter-import Simulation.Aivika.Simulation-import Simulation.Aivika.Event-import Simulation.Aivika.Signal- -- | Defines the 'View' that saves the simulation results -- in the CSV file(s). data TableView =@@ -97,9 +92,10 @@               tablePredicate   :: Event Bool,               -- ^ It specifies the predicate that defines               -- when we can save data in the table.-              tableSeries      :: [String] -              -- ^ It contains the labels of data saved-              -- in the CSV file(s).+              tableTransform   :: ResultTransform,+              -- ^ The transform applied to the results before receiving series.+              tableSeries      :: ResultTransform +              -- ^ It defines the series to save in the CSV file(s).             }    -- | The default table view.  @@ -113,29 +109,32 @@               tableSeparator   = ",",               tableFormatter   = id,               tablePredicate   = return True,-              tableSeries      = [] }+              tableTransform   = expandResults,+              tableSeries      = id }   -instance FileRenderer r => ExperimentView TableView r where+instance WebPageRendering r => ExperimentView TableView r WebPageWriter where      outputView v =      let reporter exp renderer dir =           do st <- newTable v exp dir+             let writer =+                   WebPageWriter { reporterWriteTOCHtml = tableTOCHtml st,+                                   reporterWriteHtml    = tableHtml st }              return ExperimentReporter { reporterInitialise = return (),                                          reporterFinalise   = return (),                                          reporterSimulate   = simulateTable st,-                                         reporterTOCHtml    = tableTOCHtml st,-                                         reporterHtml       = tableHtml st }+                                         reporterRequest    = writer }     in ExperimentGenerator { generateReporter = reporter }    -- | The state of the view.-data TableViewState r =+data TableViewState =   TableViewState { tableView       :: TableView,-                   tableExperiment :: Experiment r,+                   tableExperiment :: Experiment,                    tableDir        :: FilePath,                     tableMap        :: M.Map Int FilePath }    -- | Create a new state of the view.-newTable :: TableView -> Experiment r -> FilePath -> IO (TableViewState r)+newTable :: TableView -> Experiment -> FilePath -> IO TableViewState newTable view exp dir =   do let n = experimentRunCount exp      fs <- forM [0..(n - 1)] $ \i ->@@ -153,50 +152,50 @@                              tableMap          = m }         -- | Write the tables during the simulation.-simulateTable :: TableViewState r -> ExperimentData -> Event (Event ())+simulateTable :: TableViewState -> ExperimentData -> Event DisposableEvent simulateTable st expdata =-  do let labels = tableSeries $ tableView st-         providers = experimentSeriesProviders expdata labels-         input =-           flip map providers $ \provider ->-           case providerToString provider of-             Nothing -> error $-                        "Cannot represent series " ++-                        providerName provider ++ -                        " as a string: simulateTable"-             Just input -> input-         separator = tableSeparator $ tableView st-         formatter = tableFormatter $ tableView st-         predicate = tablePredicate $ tableView st+  do let view    = tableView st+         rs      = tableSeries view $+                   tableTransform view $+                   experimentResults expdata+         exts    = extractStringResults rs+         signals = experimentPredefinedSignals expdata+         signal  = pureResultSignal signals $+                   resultSignal rs+         separator = tableSeparator view+         formatter = tableFormatter view+         predicate = tablePredicate view      i <- liftParameter simulationIndex      -- create a new file      let f = fromJust $ M.lookup (i - 1) (tableMap st)      h <- liftIO $ openFile f WriteMode      -- write a header      liftIO $-       do forM_ (zip [0..] providers) $ \(column, provider) ->+       do forM_ (zip [0..] exts) $ \(column, ext) ->             do when (column > 0) $                   hPutStr h separator-               hPutStr h $ show $ providerName provider+               hPutStr h $ show $ resultExtractName ext           hPutStrLn h ""-     handleSignal_ (experimentMixedSignal expdata providers) $ \t ->+     d1 <- handleSignal signal $ \t ->        do p <- predicate           when p $-            do forM_ (zip [0..] input) $ \(column, input) ->  -- write the row-                 do x <- input                                -- write the column+            do forM_ (zip [0..] exts) $ \(column, ext) ->  -- write the row+                 do x <- resultExtractData ext             -- write the column                     liftIO $                       do when (column > 0) $                             hPutStr h separator                          hPutStr h $ formatter x                liftIO $ hPutStrLn h ""-     return $ -       liftIO $-       do when (experimentVerbose $ tableExperiment st) $-            putStr "Generated file " >> putStrLn f-          hClose h  -- close the file+     let d2 =          +           DisposableEvent $+           liftIO $+           do when (experimentVerbose $ tableExperiment st) $+                putStr "Generated file " >> putStrLn f+              hClose h  -- close the file+     return $ d1 <> d2       -- | Get the HTML code.     -tableHtml :: TableViewState r -> Int -> HtmlWriter ()     +tableHtml :: TableViewState -> Int -> HtmlWriter ()      tableHtml st index =   let n = experimentRunCount $ tableExperiment st   in if n == 1@@ -204,7 +203,7 @@      else tableHtmlMultiple st index       -- | Get the HTML code for a single run.-tableHtmlSingle :: TableViewState r -> Int -> HtmlWriter ()+tableHtmlSingle :: TableViewState -> Int -> HtmlWriter () tableHtmlSingle st index =   do header st index      let f = fromJust $ M.lookup 0 (tableMap st)@@ -213,7 +212,7 @@        writeHtmlText (tableLinkText $ tableView st)  -- | Get the HTML code for multiple runs-tableHtmlMultiple :: TableViewState r -> Int -> HtmlWriter ()+tableHtmlMultiple :: TableViewState -> Int -> HtmlWriter () tableHtmlMultiple st index =   do header st index      let n = experimentRunCount $ tableExperiment st@@ -228,7 +227,7 @@             writeHtmlLink (makeRelative (tableDir st) f) $             writeHtmlText sublink -header :: TableViewState r -> Int -> HtmlWriter ()+header :: TableViewState -> Int -> HtmlWriter () header st index =   do writeHtmlHeader3WithId ("id" ++ show index) $         writeHtmlText (tableTitle $ tableView st)@@ -238,7 +237,7 @@        writeHtmlText description  -- | Get the TOC item     -tableTOCHtml :: TableViewState r -> Int -> HtmlWriter ()+tableTOCHtml :: TableViewState -> Int -> HtmlWriter () tableTOCHtml st index =   writeHtmlListItem $   writeHtmlLink ("#id" ++ show index) $

@@ -3,11 +3,11 @@  -- | -- Module     : Simulation.Aivika.Experiment.TimingStatsView--- Copyright  : Copyright (c) 2012, David Sorokin <david.sorokin@gmail.com>+-- Copyright  : Copyright (c) 2012-2014, David Sorokin <david.sorokin@gmail.com> -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.4.1+-- Tested with: GHC 7.8.3 -- -- The module defines 'TimingStatsView' that shows the timing statistics -- for the variables for every simulation run separately.@@ -23,20 +23,14 @@ import qualified Data.Map as M import Data.IORef import Data.Maybe+import Data.Monoid +import Simulation.Aivika import Simulation.Aivika.Experiment.Types import Simulation.Aivika.Experiment.HtmlWriter import Simulation.Aivika.Experiment.TimingStatsWriter import Simulation.Aivika.Experiment.Utils (replace) -import Simulation.Aivika.Specs-import Simulation.Aivika.Parameter-import Simulation.Aivika.Simulation-import Simulation.Aivika.Dynamics-import Simulation.Aivika.Event-import Simulation.Aivika.Signal-import Simulation.Aivika.Statistics- -- | Defines the 'View' that shows the timing statistics -- for variables for every simulation run separately. data TimingStatsView =@@ -58,8 +52,10 @@                     -- ^ It shows the timing statistics.                     timingStatsPredicate   :: Event Bool,                     -- ^ Specifies when gathering the statistics.-                    timingStatsSeries      :: [String] -                    -- ^ It contains the labels of the observed series.+                    timingStatsTransform   :: ResultTransform,+                    -- ^ The transform applied to the results before receiving series.+                    timingStatsSeries      :: ResultTransform +                    -- ^ It defines the series for which the statistics to be collected.                   }    -- | This is the default view.@@ -70,28 +66,31 @@                     timingStatsDescription = "The statistical data are gathered in the time points.",                     timingStatsWriter      = defaultTimingStatsWriter,                     timingStatsPredicate   = return True,-                    timingStatsSeries      = [] }+                    timingStatsTransform   = id,+                    timingStatsSeries      = id } -instance ExperimentView TimingStatsView r where  +instance WebPageRendering r => ExperimentView TimingStatsView r WebPageWriter where        outputView v =      let reporter exp renderer dir =           do st <- newTimingStats v exp+             let writer =+                   WebPageWriter { reporterWriteTOCHtml = timingStatsTOCHtml st,+                                   reporterWriteHtml    = timingStatsHtml st }              return ExperimentReporter { reporterInitialise = return (),                                          reporterFinalise   = return (),                                          reporterSimulate   = simulateTimingStats st,-                                         reporterTOCHtml    = timingStatsTOCHtml st,-                                         reporterHtml       = timingStatsHtml st }+                                         reporterRequest    = writer }     in ExperimentGenerator { generateReporter = reporter }    -- | The state of the view.-data TimingStatsViewState r =+data TimingStatsViewState =   TimingStatsViewState { timingStatsView       :: TimingStatsView,-                         timingStatsExperiment :: Experiment r,+                         timingStatsExperiment :: Experiment,                          timingStatsMap        :: M.Map Int (IORef [(String, IORef (TimingStats Double))]) }    -- | Create a new state of the view.-newTimingStats :: TimingStatsView -> Experiment r -> IO (TimingStatsViewState r)+newTimingStats :: TimingStatsView -> Experiment -> IO TimingStatsViewState newTimingStats view exp =   do let n = experimentRunCount exp      rs <- forM [0..(n - 1)] $ \i -> newIORef []    @@ -101,40 +100,35 @@                                    timingStatsMap        = m }         -- | Get the timing statistics during the simulation.-simulateTimingStats :: TimingStatsViewState r -> ExperimentData -> Event (Event ())+simulateTimingStats :: TimingStatsViewState -> ExperimentData -> Event DisposableEvent simulateTimingStats st expdata =-  do let labels = timingStatsSeries $ timingStatsView st-         input providers =-           flip map providers $ \provider ->-           case providerToDouble provider of-             Nothing -> error $-                        "Cannot represent series " ++-                        providerName provider ++ -                        " as double values: simulateTimingStats"-             Just input -> (provider, input)-         predicate = timingStatsPredicate $ timingStatsView st+  do let view    = timingStatsView st+         rs      = timingStatsSeries view $+                   timingStatsTransform view $+                   experimentResults expdata+         exts    = extractDoubleResults rs+         signals = experimentPredefinedSignals expdata+         signal  = filterSignalM (const predicate) $+                   pureResultSignal signals $+                   resultSignal rs+         predicate = timingStatsPredicate view      i <- liftParameter simulationIndex      let r = fromJust $ M.lookup (i - 1) $ timingStatsMap st-     forM_ labels $ \label ->-       do let providers = experimentSeriesProviders expdata [label]-              pairs     = input providers-          forM_ pairs $ \(provider, input) ->-            do stats <- liftIO $ newIORef emptyTimingStats-               let name = providerName provider-               liftIO $ modifyIORef r ((:) (name, stats))-               let h = filterSignalM (const predicate) $-                       experimentMixedSignal expdata [provider]-               handleSignal_ h $ \_ ->-                 do t <- liftDynamics time-                    x <- input-                    liftIO $-                      do y <- readIORef stats-                         let y' = addTimingStats t x y-                         y' `seq` writeIORef stats y'-     return $ return ()+     ds <- forM exts $ \ext ->+       do stats <- liftIO $ newIORef emptyTimingStats+          let name = resultExtractName ext+          liftIO $ modifyIORef r ((:) (name, stats))+          handleSignal signal $ \_ ->+            do t <- liftDynamics time+               x <- resultExtractData ext+               liftIO $+                 do y <- readIORef stats+                    let y' = addTimingStats t x y+                    y' `seq` writeIORef stats y'+     return $ mconcat ds       -- | Get the HTML code.     -timingStatsHtml :: TimingStatsViewState r -> Int -> HtmlWriter ()     +timingStatsHtml :: TimingStatsViewState -> Int -> HtmlWriter ()      timingStatsHtml st index =   let n = experimentRunCount $ timingStatsExperiment st   in if n == 1@@ -142,7 +136,7 @@      else timingStatsHtmlMultiple st index       -- | Get the HTML code for a single run.-timingStatsHtmlSingle :: TimingStatsViewState r -> Int -> HtmlWriter ()+timingStatsHtmlSingle :: TimingStatsViewState -> Int -> HtmlWriter () timingStatsHtmlSingle st index =   do header st index      let r = fromJust $ M.lookup 0 (timingStatsMap st)@@ -154,7 +148,7 @@           write writer name stats  -- | Get the HTML code for multiple runs-timingStatsHtmlMultiple :: TimingStatsViewState r -> Int -> HtmlWriter ()+timingStatsHtmlMultiple :: TimingStatsViewState -> Int -> HtmlWriter () timingStatsHtmlMultiple st index =   do header st index      let n = experimentRunCount $ timingStatsExperiment st@@ -174,7 +168,7 @@                    write  = timingStatsWrite writer                write writer name stats -header :: TimingStatsViewState r -> Int -> HtmlWriter ()+header :: TimingStatsViewState -> Int -> HtmlWriter () header st index =   do writeHtmlHeader3WithId ("id" ++ show index) $        writeHtmlText (timingStatsTitle $ timingStatsView st)@@ -184,7 +178,7 @@        writeHtmlText description  -- | Get the TOC item     -timingStatsTOCHtml :: TimingStatsViewState r -> Int -> HtmlWriter ()+timingStatsTOCHtml :: TimingStatsViewState -> Int -> HtmlWriter () timingStatsTOCHtml st index =   writeHtmlListItem $   writeHtmlLink ("#id" ++ show index) $

@@ -1,11 +1,11 @@  -- | -- Module     : Simulation.Aivika.Experiment.TimingStatsWriter--- Copyright  : Copyright (c) 2012, David Sorokin <david.sorokin@gmail.com>+-- Copyright  : Copyright (c) 2012-2014, David Sorokin <david.sorokin@gmail.com> -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.4.1+-- Tested with: GHC 7.6.3 -- -- The module defines 'TimingStatsWriter' that knows how to write -- the timing statistics in HTML.

@@ -1,13 +1,13 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts #-}  -- | -- Module     : Simulation.Aivika.Experiment.Types--- Copyright  : Copyright (c) 2012-2013, David Sorokin <david.sorokin@gmail.com>+-- Copyright  : Copyright (c) 2012-2014, David Sorokin <david.sorokin@gmail.com> -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.6.3+-- Tested with: GHC 7.8.3 -- -- The module defines the simulation experiments. They automate -- the process of generating and analyzing the results. Moreover,@@ -20,46 +20,32 @@ --  module Simulation.Aivika.Experiment.Types-       (Experiment(..),+       (-- * General Definitions+        Experiment(..),+        ExperimentRendering(..),         defaultExperiment,         runExperiment,         runExperimentParallel,         ExperimentData(..),-        experimentDataInStartTime,-        experimentSeriesProviders,-        experimentMixedSignal,-        Series(..),-        SeriesContainer(..),-        SeriesEntity(..),-        SeriesProvider(..),-        SeriesListWithSubscript,-        SeriesArrayWithSubscript,-        SeriesVectorWithSubscript,-        seriesListWithSubscript,-        seriesArrayWithSubscript,-        seriesVectorWithSubscript,         ExperimentView(..),         ExperimentGenerator(..),         ExperimentReporter(..),         ExperimentFilePath(..),         resolveFilePath,         expandFilePath,-        mapFilePath) where+        mapFilePath,+        -- * Web Page Rendering+        WebPageRendering(..),+        WebPageRenderer(..),+        WebPageWriter(..),+        WebPageGenerator(..)) where  import Control.Monad import Control.Monad.State import Control.Concurrent.ParallelIO.Local  import qualified Data.Map as M-import qualified Data.Vector as V-import qualified Data.Vector.Unboxed as UV-import qualified Data.Array as A-import qualified Data.Array.Unboxed as UA -import Data.Array (Array)-import Data.Array.Unboxed (UArray)-import Data.Array.IO- import Data.Ix import Data.Maybe import Data.Monoid@@ -70,17 +56,18 @@  import GHC.Conc (getNumCapabilities) -import Simulation.Aivika hiding (Var, readVar, varChanged_)-import Simulation.Aivika.Var-import qualified Simulation.Aivika.Ref.Light as LR-+import Simulation.Aivika import Simulation.Aivika.Experiment.HtmlWriter import Simulation.Aivika.Experiment.Utils (replace) --- | It defines the simulation experiment with the specified rendering backend.-data Experiment r = +-- | It defines the simulation experiment with the specified rendering backend and its bound data.+data Experiment =    Experiment { experimentSpecs         :: Specs,                -- ^ The simulation specs for the experiment.+               experimentTransform     :: ResultTransform,+               -- ^ How the results must be transformed before rendering.+               experimentLocalisation  :: ResultLocalisation,+               -- ^ Specifies a localisation applied when rendering the experiment.                experimentRunCount      :: Int,                -- ^ How many simulation runs should be launched.                experimentDirectoryName :: ExperimentFilePath,@@ -91,194 +78,81 @@                -- ^ The experiment description.                experimentVerbose       :: Bool,                -- ^ Whether the process of generating the results is verbose.-               experimentGenerators    :: [ExperimentGenerator r], -               -- ^ The experiment generators.-               experimentIndexHtml     :: Experiment r -> [ExperimentReporter] -> FilePath -> IO (),-               -- ^ Create the @index.html@ file after the simulation is finished-               -- in the specified directory.                experimentNumCapabilities :: IO Int                -- ^ The number of threads used for the Monte-Carlo simulation                -- if the executable was compiled with the support of multi-threading.              }  -- | The default experiment.-defaultExperiment :: Experiment r+defaultExperiment :: Experiment defaultExperiment =   Experiment { experimentSpecs         = Specs 0 10 0.01 RungeKutta4 SimpleGenerator,+               experimentTransform     = id,+               experimentLocalisation  = englishResultLocalisation,                experimentRunCount      = 1,                experimentDirectoryName = UniqueFilePath "experiment",                experimentTitle         = "Simulation Experiment",                experimentDescription   = "",                experimentVerbose       = True,-               experimentGenerators    = [], -               experimentIndexHtml     = createIndexHtml,                experimentNumCapabilities = getNumCapabilities } +-- | It allows rendering the simulation results in an arbitrary way.+class ExperimentRendering r a | r -> a where++  -- | Render the experiment after the simulation is finished, for example,+  -- creating the @index.html@ file in the specified directory.+  renderExperiment :: Experiment -> r -> [ExperimentReporter a] -> FilePath -> IO ()+ -- | This is a generator of the reporter with the specified rendering backend.                     -data ExperimentGenerator r = -  ExperimentGenerator { generateReporter :: Experiment r -> r -> FilePath -> IO ExperimentReporter -                        -- ^ Generate a reporter for the specified directory,-                        -- where the @index.html@ file will be saved for the -                        -- current simulation experiment.+data ExperimentGenerator r a = +  ExperimentGenerator { generateReporter :: Experiment -> r -> FilePath -> IO (ExperimentReporter a)+                        -- ^ Generate a reporter bound up with the specified directory.                       }  -- | Defines a view in which the simulation results should be saved. -- You should extend this type class to define your own views such -- as the PDF document.-class ExperimentView v r where+class ExperimentRendering r a => ExperimentView v r a | r -> a where      -- | Create a generator of the reporter.-  outputView :: v -> ExperimentGenerator r-  --- | Represents the series. It is usually something, or--- an array of something, or a list of such values which--- can be simulated.------ The array and list of series are treated as a sequence of--- separate sub-series that have a subscript which can be--- optionally specified explicitly. By default, the subscript--- is numeric but it may be any string.---  --- At the same time, if the array or list of numeric values--- is wrapped in monads 'Simulation', 'Dynamics' or 'Event' then the--- underlying numeric array and list are already treated as--- a sampling statistics or list of numbers in time point.------ Moreover, if the array or list of numbers is contained in--- reference 'Ref' or variable 'Var' then the array and list--- of such values are also treated as a sampling statistics--- or list of numbers in time point.-class Series s where-  -  -- | Return the simulatable entity with the specified name-  -- for the given series.-  seriesEntity :: String -> s -> SeriesEntity-  --- | Defines the simulatable entity.-data SeriesEntity =-  SeriesEntity { seriesProviders :: [SeriesProvider]-                 -- ^ Return the providers for the entity.-               }-  --- | This is provider of the simulatable data.-data SeriesProvider =-  SeriesProvider { providerName :: String,-                   -- ^ Return the name.-                   providerToDouble :: Maybe (Event Double),-                   -- ^ Try to return the data as double values.-                   providerToDoubleStats :: Maybe (Event (SamplingStats Double)),-                   -- ^ Try to return the statistics data in time points.-                   providerToDoubleList :: Maybe (Event [Double]),-                   -- ^ Try to return the list of double values.-                   providerToInt :: Maybe (Event Int),-                   -- ^ Try to return the data as integers.-                   providerToIntStats :: Maybe (Event (SamplingStats Int)),-                   -- ^ Try to return the statistics data in time points.-                   providerToIntList :: Maybe (Event [Int]),-                   -- ^ Try to return the list of integer values.-                   providerToString :: Maybe (Event String),-                   -- ^ Try to return the data as strings.-                   providerSignal :: Maybe (Signal ())-                   -- ^ Try to get a signal for the data, which-                   -- is actual for the 'Ref' references and -                   -- the 'Var' variables. You should not provide-                   -- such a signal if the data are calculated-                   -- only in the integration time points, which-                   -- is true for the integrals, for example.-                 }+  outputView :: v -> ExperimentGenerator r a  -- | It describes the source simulation data used in the experiment. data ExperimentData =-  ExperimentData { experimentSignalInIntegTimes :: Signal Double,-                   -- ^ The signal triggered in the integration time points.-                   experimentSignalInStartTime :: Signal Double,-                   -- ^ The signal triggered in the start time.-                   experimentSignalInStopTime :: Signal Double,-                   -- ^ The signal triggered in the stop time.-                   experimentSeries :: M.Map String SeriesEntity-                   -- ^ The simulation entitities with labels as keys.+  ExperimentData { experimentResults :: Results,+                   -- ^ The simulation results used in the experiment.+                   experimentPredefinedSignals :: ResultPredefinedSignals+                   -- ^ The predefined signals provided by every model.                  } --- | Prepare data for the simulation experiment in start time from the series --- with the specified labels.-experimentDataInStartTime :: [(String, SeriesEntity)] -> Simulation ExperimentData-experimentDataInStartTime m = runDynamicsInStartTime $ runEventWith EarlierEvents d where-  d = do signalInIntegTimes <- newSignalInIntegTimes-         signalInStartTime  <- newSignalInStartTime-         signalInStopTime   <- newSignalInStopTime-         let series = M.fromList m-         return ExperimentData { experimentSignalInIntegTimes = signalInIntegTimes,-                                 experimentSignalInStartTime  = signalInStartTime,-                                 experimentSignalInStopTime   = signalInStopTime,-                                 experimentSeries             = series }---- | Get a mixed signal for the specified providers based on --- the experimental data. This signal is triggered when --- the provided signals are triggered. The mixed signal is --- also triggered in the integration time points if there is --- at least one provider without signal.-experimentMixedSignal :: ExperimentData -> [SeriesProvider] -> Signal ()-experimentMixedSignal expdata providers =-  let xs0 = map providerSignal providers-      xs1 = filter isJust xs0-      xs2 = filter isNothing xs0-      signal1 = mconcat $ map fromJust xs1-      signal2 = if null xs2 -                then signal3 <> signal4-                else signal5-      signal3 = void $ experimentSignalInStartTime expdata-      signal4 = void $ experimentSignalInStopTime expdata-      signal5 = void $ experimentSignalInIntegTimes expdata-  in signal1 <> signal2---- | Return the 'SeriesProvider' values from the experiment data by the specified labels.-experimentSeriesProviders :: ExperimentData -> [String] -> [SeriesProvider]-experimentSeriesProviders expdata labels =-  join $ flip map labels $ \label ->-  case M.lookup label (experimentSeries expdata) of-    Nothing -> -      error $ -      "There is no series with label " ++ label ++ -      ": experimentSeriesProviders"-    Just entity -> -      seriesProviders entity---- | Defines what creates the simulation reports.-data ExperimentReporter =+-- | Defines what creates the simulation reports by the specified renderer.+data ExperimentReporter a =   ExperimentReporter { reporterInitialise :: IO (),                        -- ^ Initialise the reporting before                         -- the simulation runs are started.                        reporterFinalise   :: IO (),                        -- ^ Finalise the reporting after                        -- all simulation runs are finished.-                       reporterSimulate   :: ExperimentData -> Event (Event ()),+                       reporterSimulate   :: ExperimentData -> Event DisposableEvent,                        -- ^ Start the simulation run in the start time                        -- and return a finalizer that will be called                         -- in the stop time after the last signal is                         -- triggered and processed.-                       reporterTOCHtml :: Int -> HtmlWriter (),-                       -- ^ Return a TOC (Table of Contents) item for -                       -- the HTML index file after the finalisation -                       -- function is called, i.e. in the very end. -                       -- The agument specifies the ordered number of -                       -- the item.-                       ---                       -- You should wrap your HTML in 'writeHtmlListItem'.-                       reporterHtml :: Int -> HtmlWriter ()-                       -- ^ Return an HTML code for the index file-                       -- after the finalisation function is called,-                       -- i.e. in the very end. The agument specifies-                       -- the ordered number of the item.+                       reporterRequest    :: a+                       -- ^ Return data requested by the renderer.                      }  -- | Run the simulation experiment sequentially. For example,  -- it can be a Monte-Carlo simulation dependentent on the external -- 'Parameter' values.-runExperiment :: Experiment r+runExperiment :: ExperimentRendering r a+                 => Experiment                  -- ^ the simulation experiment to run+                 -> [ExperimentGenerator r a]+                 -- ^ generators used for rendering                  -> r                  -- ^ the rendering backend-                 -> Simulation ExperimentData+                 -> Simulation Results                  -- ^ the simulation results received from the model                  -> IO () runExperiment = runExperimentWithExecutor sequence_@@ -295,11 +169,14 @@ -- threads directly with help of 'experimentNumCapabilities', -- although the real number of parallel threads can depend on many -- factors.-runExperimentParallel :: Experiment r+runExperimentParallel :: ExperimentRendering r a+                         => Experiment                          -- ^ the simulation experiment to run+                         -> [ExperimentGenerator r a]+                         -- ^ generators used for rendering                          -> r                          -- ^ the rendering backend-                         -> Simulation ExperimentData+                         -> Simulation Results                          -- ^ the simulation results received from the model                          -> IO () runExperimentParallel e = runExperimentWithExecutor executor e @@ -309,23 +186,25 @@                parallel_ pool tasks                          -- | Run the simulation experiment with the specified executor.-runExperimentWithExecutor :: ([IO ()] -> IO ())+runExperimentWithExecutor :: ExperimentRendering r a +                             => ([IO ()] -> IO ())                              -- ^ an executor that allows parallelizing the simulation if required-                             -> Experiment r+                             -> Experiment                              -- ^ the simulation experiment to run+                             -> [ExperimentGenerator r a]+                             -- ^ generators used for rendering                              -> r                              -- ^ the rendering backend-                             -> Simulation ExperimentData+                             -> Simulation Results                              -- ^ the simulation results received from the model                              -> IO ()-runExperimentWithExecutor executor e r simulation = +runExperimentWithExecutor executor e generators r simulation =    do let specs      = experimentSpecs e          runCount   = experimentRunCount e          dirName    = experimentDirectoryName e-         generators = experimentGenerators e      path <- resolveFilePath "" dirName      when (experimentVerbose e) $-       do putStr "Using directory " +       do putStr "Updating directory "            putStrLn path      createDirectoryIfMissing True path      reporters <- mapM (\x -> generateReporter x e r path)@@ -333,40 +212,72 @@      forM_ reporters reporterInitialise      let simulate :: Simulation ()          simulate =-           do d  <- simulation+           do signals <- newResultPredefinedSignals+              results <- simulation+              let d = ExperimentData { experimentResults = experimentTransform e results,+                                       experimentPredefinedSignals = signals }               fs <- runDynamicsInStartTime $                     runEventWith EarlierEvents $                     forM reporters $ \reporter ->                     reporterSimulate reporter d               runEventInStopTime $-                sequence_ fs+                disposeEvent $ mconcat fs      executor $ runSimulations simulate specs runCount      forM_ reporters reporterFinalise-     experimentIndexHtml e e reporters path+     renderExperiment e r reporters path      return ()-     --- | Create an index HTML file.     -createIndexHtml :: Experiment r -> [ExperimentReporter] -> FilePath -> IO ()-createIndexHtml e reporters path = -  do let html :: HtmlWriter ()-         html = -           writeHtmlDocumentWithTitle (experimentTitle e) $++-- | It defines the web page renderer for simulation 'Experiment'. +data WebPageRenderer = WebPageRenderer++-- | It replies to the requests made by the web page renderer.+data WebPageWriter =+  WebPageWriter { reporterWriteTOCHtml :: Int -> HtmlWriter (),+                  -- ^ Return a TOC (Table of Contents) item for +                  -- the HTML index file after the finalisation +                  -- function is called, i.e. in the very end. +                  -- The agument specifies the ordered number of +                  -- the item.+                  --+                  -- You should wrap your HTML in 'writeHtmlListItem'.+                  reporterWriteHtml :: Int -> HtmlWriter ()+                  -- ^ Return an HTML code for the index file+                  -- after the finalisation function is called,+                  -- i.e. in the very end. The agument specifies+                  -- the ordered number of the item.+                }++-- | A subclass of renderers that know how to save the @index.html@ file+-- when rendering the simulation experiment.+class ExperimentRendering r WebPageWriter => WebPageRendering r++-- | A convenient type synonym for describing the web page generators.+type WebPageGenerator r = ExperimentGenerator r WebPageWriter++instance WebPageRendering WebPageRenderer++instance ExperimentRendering WebPageRenderer WebPageWriter where++  renderExperiment e r reporters path = +    do let html :: HtmlWriter ()+           html = +             writeHtmlDocumentWithTitle (experimentTitle e) $              do writeHtmlList $                   forM_ (zip [1..] reporters) $ \(i, reporter) -> -                  reporterTOCHtml reporter i+                  reporterWriteTOCHtml (reporterRequest reporter) i                 writeHtmlBreak                 unless (null $ experimentDescription e) $                   writeHtmlParagraph $                   writeHtmlText $ experimentDescription e                 forM_ (zip [1..] reporters) $ \(i, reporter) ->-                  reporterHtml reporter i-         file = combine path "index.html"-     ((), contents) <- runHtmlWriter html id-     UTF8.writeFile file (contents [])-     when (experimentVerbose e) $-       do putStr "Generated file "-          putStrLn file-+                  reporterWriteHtml (reporterRequest reporter) i+           file = combine path "index.html"+       ((), contents) <- runHtmlWriter html id+       UTF8.writeFile file (contents [])+       when (experimentVerbose e) $+         do putStr "Generated file "+            putStrLn file+   -- | Specifies the file name, unique or writable, which can be appended with extension if required. data ExperimentFilePath = WritableFilePath FilePath                           -- ^ The file which is overwritten in @@ -409,553 +320,3 @@ mapFilePath :: (FilePath -> FilePath) -> ExperimentFilePath -> ExperimentFilePath mapFilePath f (WritableFilePath path) = WritableFilePath (f path) mapFilePath f (UniqueFilePath path) = UniqueFilePath (f path) ---- | Represent a container for simulation data.-class SeriesContainer c where--  -- | Extract data from the container.-  containerData :: c a -> Event a--  -- | Get the signal for the container.-  containerSignal :: c a -> Maybe (Signal ())--instance SeriesContainer Parameter where--  containerData = liftParameter--  containerSignal = const Nothing--instance SeriesContainer Simulation where--  containerData = liftSimulation--  containerSignal = const Nothing--instance SeriesContainer Dynamics where--  containerData = liftDynamics--  containerSignal = const Nothing--instance SeriesContainer Event where--  containerData = id--  containerSignal = const Nothing--instance SeriesContainer Ref where--  containerData = readRef--  containerSignal = Just . refChanged_--instance SeriesContainer LR.Ref where--  containerData = LR.readRef--  containerSignal = const Nothing--instance SeriesContainer Var where--  containerData = readVar--  containerSignal = Just . varChanged_--instance SeriesContainer Signalable where--  containerData = readSignalable--  containerSignal = Just . signalableChanged_--instance SeriesContainer c => Series (c Double) where-  -  seriesEntity name s =-    SeriesEntity { seriesProviders =-                      [SeriesProvider { providerName = name,-                                        providerToDouble =-                                          Just $-                                          containerData s,-                                        providerToDoubleStats =-                                          Just $-                                          fmap returnSamplingStats $-                                          containerData s,-                                        providerToDoubleList =-                                          Just $-                                          fmap return $-                                          containerData s,-                                        providerToInt = Nothing,-                                        providerToIntStats = Nothing,-                                        providerToIntList = Nothing,-                                        providerToString =-                                          Just $-                                          fmap show $-                                          containerData s,-                                        providerSignal =-                                          containerSignal s }] }--instance SeriesContainer c => Series (c Int) where-  -  seriesEntity name s =-    SeriesEntity { seriesProviders =-                      [SeriesProvider { providerName = name,-                                        providerToDouble =-                                          Just $-                                          fmap fromIntegral $-                                          containerData s,-                                        providerToDoubleStats =-                                          Just $-                                          fmap returnSamplingStats $-                                          fmap fromIntegral $-                                          containerData s,-                                        providerToDoubleList =-                                          Just $-                                          fmap return $-                                          fmap fromIntegral $-                                          containerData s,-                                        providerToInt =-                                          Just $-                                          containerData s,-                                        providerToIntStats =-                                          Just $-                                          fmap returnSamplingStats $-                                          containerData s,-                                        providerToIntList =-                                          Just $-                                          fmap return $-                                          containerData s,-                                        providerToString =-                                          Just $-                                          fmap show $-                                          containerData s,-                                        providerSignal =-                                          containerSignal s }] }--instance SeriesContainer c => Series (c String) where-  -  seriesEntity name s =-    SeriesEntity { seriesProviders =-                      [SeriesProvider { providerName = name,-                                        providerToDouble = Nothing,-                                        providerToDoubleStats = Nothing,-                                        providerToDoubleList = Nothing,-                                        providerToInt = Nothing,-                                        providerToIntStats = Nothing,-                                        providerToIntList = Nothing,-                                        providerToString =-                                          Just $-                                          containerData s,-                                        providerSignal =-                                          containerSignal s }] }--instance Series s => Series [s] where-  -  seriesEntity name s = -    SeriesEntity { seriesProviders = -                      join $ forM (zip [0..] s) $ \(i, s) ->-                      let name' = name ++ "[" ++ show i ++ "]"-                      in seriesProviders $ seriesEntity name' s }-    -instance (Show i, Ix i, Series s) => Series (Array i s) where-  -  seriesEntity name s =-    SeriesEntity { seriesProviders =-                      join $ forM (A.assocs s) $ \(i, s) ->-                      let name' = name ++ "[" ++ show i ++ "]"-                      in seriesProviders $ seriesEntity name' s }--instance Series s => Series (V.Vector s) where-  -  seriesEntity name s =-    SeriesEntity { seriesProviders =-                      join $ forM (zip [0..] (V.toList s)) $ \(i, s) ->-                      let name' = name ++ "[" ++ show i ++ "]"-                      in seriesProviders $ seriesEntity name' s }---- | Represents a list with the specified subscript.-data SeriesListWithSubscript s =-  SeriesListWithSubscript { seriesList          :: [s],-                            seriesListSubscript :: [String] }---- | Represents an array with the specified subscript.-data SeriesArrayWithSubscript i s =-  SeriesArrayWithSubscript { seriesArray          :: Array i s,-                             seriesArraySubscript :: Array i String }---- | Represents a vector with the specified subscript.-data SeriesVectorWithSubscript s =-  SeriesVectorWithSubscript { seriesVector          :: V.Vector s,-                              seriesVectorSubscript :: V.Vector String }---- | Add the specified subscript to the list.-seriesListWithSubscript :: Series s-                           => [s]-                           -- ^ the list to subscript-                           -> [String]-                           -- ^ the list of subscripts-                           -> SeriesListWithSubscript s-                           -- ^ the subscripted list-seriesListWithSubscript = SeriesListWithSubscript---- | Add the specified subscript to the array.-seriesArrayWithSubscript :: (Ix i, Series s)-                            => Array i s-                            -- ^ the array to subscript-                            -> Array i String-                            -- ^ the array of subscripts-                            -> SeriesArrayWithSubscript i s-                            -- ^ the subscripted array-seriesArrayWithSubscript = SeriesArrayWithSubscript---- | Add the specified subscript to the vector.-seriesVectorWithSubscript :: Series s-                             => V.Vector s-                             -- ^ the vector to subscript-                             -> V.Vector String-                             -- ^ the vector of subscripts-                             -> SeriesVectorWithSubscript s-                             -- ^ the subscripted vector-seriesVectorWithSubscript = SeriesVectorWithSubscript--instance Series s => Series (SeriesListWithSubscript s) where-  -  seriesEntity name s = -    SeriesEntity { seriesProviders = do-                      let xs = seriesList s-                          ns = seriesListSubscript s-                      join $ forM (zip3 [1..] xs ns) $ \(i, s, n) ->-                        let name' = name ++ n-                        in seriesProviders $ seriesEntity name' s }-    -instance (Ix i, Series s) => Series (SeriesArrayWithSubscript i s) where-  -  seriesEntity name s =-    SeriesEntity { seriesProviders = do-                      let xs = seriesArray s-                          ns = seriesArraySubscript s-                      join $ forM (zip (A.assocs xs) (A.elems ns)) $ \((i, s), n) ->-                        let name' = name ++ n-                        in seriesProviders $ seriesEntity name' s }--instance Series s => Series (SeriesVectorWithSubscript s) where-  -  seriesEntity name s =-    SeriesEntity { seriesProviders = do-                      let xs = seriesVector s-                          ns = seriesVectorSubscript s-                      join $ forM (zip (V.toList xs) (V.toList ns)) $ \(x, n) ->-                        let name' = name ++ n-                        in seriesProviders $ seriesEntity name' x }--instance SeriesContainer c => Series (c (SamplingStats Double)) where-  -  seriesEntity name s =-    SeriesEntity { seriesProviders =-                      [SeriesProvider { providerName = name,-                                        providerToDouble = Nothing,-                                        providerToDoubleStats =-                                          Just $-                                          containerData s,-                                        providerToDoubleList = Nothing,-                                        providerToInt = Nothing,-                                        providerToIntStats = Nothing,-                                        providerToIntList = Nothing,-                                        providerToString = Nothing,-                                        providerSignal =-                                          containerSignal s } ] }--instance SeriesContainer c => Series (c (SamplingStats Int)) where-  -  seriesEntity name s =-    SeriesEntity { seriesProviders =-                      [SeriesProvider { providerName     = name,-                                        providerToDouble = Nothing,-                                        providerToDoubleStats =-                                          Just $-                                          fmap fromIntSamplingStats $-                                          containerData s,-                                        providerToDoubleList = Nothing,-                                        providerToInt    = Nothing,-                                        providerToIntStats =-                                          Just $-                                          containerData s,-                                        providerToIntList = Nothing,-                                        providerToString = Nothing,-                                        providerSignal =-                                          containerSignal s } ] }--instance SeriesContainer c => Series (c [Double]) where-  -  seriesEntity name s =-    SeriesEntity { seriesProviders =-                      [SeriesProvider { providerName = name,-                                        providerToDouble = Nothing,-                                        providerToDoubleStats =-                                          Just $-                                          fmap listSamplingStats $-                                          containerData s,-                                        providerToDoubleList =-                                          Just $-                                          containerData s,-                                        providerToInt = Nothing,-                                        providerToIntStats = Nothing,-                                        providerToIntList = Nothing,-                                        providerToString =-                                          Just $-                                          fmap show $-                                          containerData s,-                                        providerSignal =-                                          containerSignal s } ] }--instance SeriesContainer c => Series (c [Int]) where-  -  seriesEntity name s =-    SeriesEntity { seriesProviders =-                      [SeriesProvider { providerName = name,-                                        providerToDouble = Nothing,-                                        providerToDoubleStats =-                                          Just $-                                          fmap fromIntSamplingStats $-                                          fmap listSamplingStats $-                                          containerData s,-                                        providerToDoubleList =-                                          Just $-                                          fmap (map fromIntegral) $-                                          containerData s,-                                        providerToInt = Nothing,-                                        providerToIntStats =-                                          Just $-                                          fmap listSamplingStats $-                                          containerData s,-                                        providerToIntList =-                                          Just $-                                          containerData s,-                                        providerToString =-                                          Just $-                                          fmap show $-                                          containerData s,-                                        providerSignal =-                                          containerSignal s } ] }--instance (Ix i, SeriesContainer c) => Series (c (Array i Double)) where--   seriesEntity name s =-    SeriesEntity { seriesProviders =-                      [SeriesProvider { providerName = name,-                                        providerToDouble = Nothing,-                                        providerToDoubleStats =-                                          Just $-                                          fmap listSamplingStats $-                                          fmap A.elems $-                                          containerData s,-                                        providerToDoubleList =-                                          Just $-                                          fmap A.elems $-                                          containerData s,-                                        providerToInt = Nothing,-                                        providerToIntStats = Nothing,-                                        providerToIntList = Nothing,-                                        providerToString = Nothing,-                                        providerSignal =-                                          containerSignal s } ] }--instance (Ix i, SeriesContainer c) => Series (c (Array i Int)) where--   seriesEntity name s =-    SeriesEntity { seriesProviders =-                      [SeriesProvider { providerName = name,-                                        providerToDouble = Nothing,-                                        providerToDoubleStats =-                                          Just $-                                          fmap fromIntSamplingStats $-                                          fmap listSamplingStats $-                                          fmap A.elems $-                                          containerData s,-                                        providerToDoubleList =-                                          Just $-                                          fmap (map fromIntegral) $-                                          fmap A.elems $-                                          containerData s,-                                        providerToInt = Nothing,-                                        providerToIntStats =-                                          Just $-                                          fmap listSamplingStats $-                                          fmap A.elems $-                                          containerData s,-                                        providerToIntList =-                                          Just $-                                          fmap A.elems $-                                          containerData s,-                                        providerToString = Nothing,-                                        providerSignal =-                                          containerSignal s } ] }--instance (Ix i, SeriesContainer c) => Series (c (UArray i Double)) where--   seriesEntity name s =-    SeriesEntity { seriesProviders =-                      [SeriesProvider { providerName = name,-                                        providerToDouble = Nothing,-                                        providerToDoubleStats =-                                          Just $-                                          fmap listSamplingStats $-                                          fmap UA.elems $-                                          containerData s,-                                        providerToDoubleList =-                                          Just $-                                          fmap UA.elems $-                                          containerData s,-                                        providerToInt = Nothing,-                                        providerToIntStats = Nothing,-                                        providerToIntList = Nothing,-                                        providerToString = Nothing,-                                        providerSignal =-                                          containerSignal s } ] }--instance (Ix i, SeriesContainer c) => Series (c (UArray i Int)) where--   seriesEntity name s =-    SeriesEntity { seriesProviders =-                      [SeriesProvider { providerName = name,-                                        providerToDouble = Nothing,-                                        providerToDoubleStats =-                                          Just $-                                          fmap fromIntSamplingStats $-                                          fmap listSamplingStats $-                                          fmap UA.elems $-                                          containerData s,-                                        providerToDoubleList =-                                          Just $-                                          fmap (map fromIntegral) $-                                          fmap UA.elems $-                                          containerData s,-                                        providerToInt = Nothing,-                                        providerToIntStats =-                                          Just $-                                          fmap listSamplingStats $-                                          fmap UA.elems $-                                          containerData s,-                                        providerToIntList =-                                          Just $-                                          fmap UA.elems $-                                          containerData s,-                                        providerToString = Nothing,-                                        providerSignal =-                                          containerSignal s } ] }--instance SeriesContainer c => Series (c (V.Vector Double)) where--   seriesEntity name s =-    SeriesEntity { seriesProviders =-                      [SeriesProvider { providerName     = name,-                                        providerToDouble = Nothing,-                                        providerToDoubleStats =-                                          Just $-                                          fmap listSamplingStats $-                                          fmap V.toList $-                                          containerData s,-                                        providerToDoubleList =-                                          Just $-                                          fmap V.toList $-                                          containerData s,-                                        providerToInt = Nothing,-                                        providerToIntStats = Nothing,-                                        providerToIntList = Nothing,-                                        providerToString =-                                          Just $-                                          fmap show $-                                          containerData s,-                                        providerSignal =-                                          containerSignal s } ] }--instance SeriesContainer c => Series (c (V.Vector Int)) where--   seriesEntity name s =-    SeriesEntity { seriesProviders =-                      [SeriesProvider { providerName     = name,-                                        providerToDouble = Nothing,-                                        providerToDoubleStats =-                                          Just $-                                          fmap fromIntSamplingStats $-                                          fmap listSamplingStats $-                                          fmap V.toList $-                                          containerData s,-                                        providerToDoubleList =-                                          Just $-                                          fmap (map fromIntegral) $-                                          fmap V.toList $-                                          containerData s,-                                        providerToInt = Nothing,-                                        providerToIntStats =-                                          Just $-                                          fmap listSamplingStats $-                                          fmap V.toList $-                                          containerData s,-                                        providerToIntList =-                                          Just $-                                          fmap V.toList $-                                          containerData s,-                                        providerToString =-                                          Just $-                                          fmap show $-                                          containerData s,-                                        providerSignal =-                                          containerSignal s }] }--instance SeriesContainer c => Series (c (UV.Vector Double)) where--   seriesEntity name s =-    SeriesEntity { seriesProviders =-                      [SeriesProvider { providerName = name,-                                        providerToDouble = Nothing,-                                        providerToDoubleStats =-                                          Just $-                                          fmap listSamplingStats $-                                          fmap UV.toList $-                                          containerData s,-                                        providerToDoubleList =-                                          Just $-                                          fmap UV.toList $-                                          containerData s,-                                        providerToInt = Nothing,-                                        providerToIntStats = Nothing,-                                        providerToIntList = Nothing,-                                        providerToString =-                                          Just $-                                          fmap show $-                                          containerData s,-                                        providerSignal =-                                          containerSignal s } ] }--instance SeriesContainer c => Series (c (UV.Vector Int)) where--   seriesEntity name s =-    SeriesEntity { seriesProviders =-                      [SeriesProvider { providerName = name,-                                        providerToDouble = Nothing,-                                        providerToDoubleStats =-                                          Just $-                                          fmap fromIntSamplingStats $-                                          fmap listSamplingStats $-                                          fmap UV.toList $-                                          containerData s,-                                        providerToDoubleList =-                                          Just $-                                          fmap (map fromIntegral) $-                                          fmap UV.toList $-                                          containerData s,-                                        providerToInt = Nothing,-                                        providerToIntStats =-                                          Just $-                                          fmap listSamplingStats $-                                          fmap UV.toList $-                                          containerData s,-                                        providerToIntList =-                                          Just $-                                          fmap UV.toList $-                                          containerData s,-                                        providerToString =-                                          Just $-                                          fmap show $-                                          containerData s,-                                        providerSignal =-                                          containerSignal s } ] }

@@ -1,11 +1,11 @@  -- | -- Module     : Simulation.Aivika.Experiment.Utils--- Copyright  : Copyright (c) 2012, David Sorokin <david.sorokin@gmail.com>+-- Copyright  : Copyright (c) 2012-2014, David Sorokin <david.sorokin@gmail.com> -- License    : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability  : experimental--- Tested with: GHC 7.4.1+-- Tested with: GHC 7.6.3 -- -- It defines utility functions missed in the standard library. --

@@ -1,5 +1,5 @@ name:            aivika-experiment-version:         1.3.1+version:         1.4 synopsis:        Simulation experiments for the Aivika library description:     This package allows defining simulation experiments for the Aivika@@ -18,7 +18,7 @@ homepage:        http://github.com/dsorokin/aivika-experiment cabal-version:   >= 1.6 build-type:      Simple-tested-with:     GHC == 7.6.3+tested-with:     GHC == 7.8.3  extra-source-files:  examples/MachRep3.hs                      examples/LinearArray.hs@@ -27,38 +27,35 @@      exposed-modules: Simulation.Aivika.Experiment                      Simulation.Aivika.Experiment.Types-                     Simulation.Aivika.Experiment.FileRenderer                      Simulation.Aivika.Experiment.HtmlWriter                      Simulation.Aivika.Experiment.LastValueView                      Simulation.Aivika.Experiment.TableView                      Simulation.Aivika.Experiment.TimingStatsView                      Simulation.Aivika.Experiment.TimingStatsWriter                      Simulation.Aivika.Experiment.SamplingStatsWriter-                     Simulation.Aivika.Experiment.SamplingStatsSource                      Simulation.Aivika.Experiment.FinalStatsView                      Simulation.Aivika.Experiment.Histogram                      Simulation.Aivika.Experiment.ExperimentSpecsView                      Simulation.Aivika.Experiment.ExperimentSpecsWriter                      Simulation.Aivika.Experiment.FinalTableView-                     Simulation.Aivika.Experiment.ListSource                      Simulation.Aivika.Experiment.Utils+                     Simulation.Aivika.Experiment.MRef                           build-depends:   base >= 3 && < 6,                      mtl >= 1.1.0.2,-                     array >= 0.3.0.0,-                     vector >= 0.9,                      containers >= 0.4.0.0,                      directory >= 1.1.0.2,                      filepath >= 1.3.0.0,                      utf8-string >= 0.3.7,                      split >= 0.2.2,-                     network >= 2.3.0.13,+                     network-uri >= 2.6,                      parallel-io >= 0.3.2.1,-                     aivika >= 1.3+                     aivika >= 1.4      extensions:      FlexibleInstances,+                     FlexibleContexts,                      MultiParamTypeClasses,-                     RankNTypes+                     FunctionalDependencies                           ghc-options:     -O2 

@@ -9,6 +9,8 @@ {-# LANGUAGE RecursiveDo #-}  import Data.Array+import Data.Monoid+ import Control.Monad import Control.Monad.Trans @@ -32,7 +34,7 @@           return (i, x)      return $ array bnds ps -model :: Int -> Simulation ExperimentData+model :: Int -> Simulation Results model n =   mdo m <- generateArray (1, n) $ \i ->         integ (q + k * (c!(i - 1) - c!i) + k * (c!(i + 1) - c!i)) 0@@ -43,30 +45,45 @@           q = 1           k = 2           v = 0.75-      experimentDataInStartTime-        [("t", seriesEntity "time" time),-         ("m", seriesEntity "M" m),-         ("c", seriesEntity "C" c)]+      return $ results+        [resultSource "t" "time" time,+         resultSource "m" "M" m,+         resultSource "c" "C" c] -experiment :: FileRenderer r => Experiment r+experiment :: Experiment experiment =   defaultExperiment {     experimentSpecs = specs,     experimentRunCount = 1,     experimentTitle = "Linear Array",     experimentDescription = "Model Linear Array as described in " ++-                            "the examples included in Berkeley-Madonna.",-    experimentGenerators = -      [outputView defaultExperimentSpecsView,-       outputView $ defaultTableView {-         tableSeries = ["t", "m", "c"] },-       outputView $ defaultFinalTableView {-         finalTableSeries = ["m", "c"] }, -       outputView $ defaultLastValueView {-         lastValueSeries = ["t", "m", "c"] },-       outputView $ defaultTimingStatsView {-         timingStatsSeries = ["t", "m", "c"] },-       outputView $ defaultFinalStatsView {-         finalStatsSeries = ["m", "c"] } ] } +                            "the examples included in Berkeley-Madonna." } -main = runExperiment experiment HtmlRenderer (model 51)+generators :: WebPageRendering r => [WebPageGenerator r]+generators =+  [outputView defaultExperimentSpecsView,+   outputView $ defaultTableView {+     tableSeries =+        resultByName "t" <>+        resultByName "m" <>+        resultByName "c" },+   outputView $ defaultFinalTableView {+     finalTableSeries =+        resultByName "m" <>+        resultByName "c" },+   outputView $ defaultLastValueView {+     lastValueSeries =+        resultByName "t" <>+        resultByName "m" <>+        resultByName "c" },+   outputView $ defaultTimingStatsView {+     timingStatsSeries =+        resultByName "t" <>+        resultByName "m" <>+        resultByName "c" },+   outputView $ defaultFinalStatsView {+     finalStatsSeries =+        resultByName "m" <>+        resultByName "c" } ]++main = runExperiment experiment generators WebPageRenderer (model 51)

@@ -36,26 +36,28 @@   "until both machines are down. We find the proportion of up time. It " ++   "should come out to about 0.45." -experiment :: FileRenderer r => Experiment r+experiment :: Experiment experiment =   defaultExperiment {     experimentSpecs = specs,     experimentRunCount = 3,-    experimentDescription = description,-    experimentGenerators =-      [outputView defaultExperimentSpecsView,-       outputView $ defaultLastValueView {-         lastValueSeries = ["x"] },-       outputView $ defaultTimingStatsView {-         timingStatsSeries = ["x"] },-       outputView $ defaultFinalStatsView {-         finalStatsSeries = ["x"] },-       outputView $ defaultTableView {-         tableSeries = ["x"] }, -       outputView $ defaultFinalTableView {-         finalTableSeries = ["x"] } ] }+    experimentDescription = description } -model :: Simulation ExperimentData+generators :: WebPageRendering r => [WebPageGenerator r]+generators =+  [outputView defaultExperimentSpecsView,+   outputView $ defaultLastValueView {+     lastValueSeries = resultByName "x" },+   outputView $ defaultTimingStatsView {+     timingStatsSeries = resultByName "x" },+   outputView $ defaultFinalStatsView {+     finalStatsSeries = resultByName "x" },+   outputView $ defaultTableView {+     tableSeries = resultByName "x" }, +   outputView $ defaultFinalTableView {+     finalTableSeries = resultByName "x" } ]++model :: Simulation Results model =   do -- number of machines currently up      nUp <- newRef 2@@ -104,13 +106,13 @@      runProcessInStartTimeUsingId        pid2 (machine pid1)      -     let result = +     let prop =             do x <- readRef totalUpTime               y <- liftDynamics time               return $ x / (2 * y)                         -     experimentDataInStartTime-       [("x", seriesEntity "The proportion of up time" result),-        ("t", seriesEntity "Simulation time" time)]+     return $ results+       [resultSource "x" "The proportion of up time" prop,+        resultSource "t" "Simulation time" time] -main = runExperiment experiment HtmlRenderer model+main = runExperiment experiment generators WebPageRenderer model