aivika-experiment 0.1.2 → 0.2

raw patch · 14 files changed

+1111/−21 lines, 14 filesdep +utf8-stringdep ~aivikaPVP ok

version bump matches the API change (PVP)

Dependencies added: utf8-string

Dependency ranges changed: aivika

API changes (from Hackage documentation)

Files

• Simulation/Aivika/Experiment.hs +2/−2
• Simulation/Aivika/Experiment/ExperimentSpecsView.hs +88/−0
• Simulation/Aivika/Experiment/ExperimentSpecsWriter.hs +131/−0
• Simulation/Aivika/Experiment/FinalStatsView.hs +177/−0
• Simulation/Aivika/Experiment/FinalTableView.hs +250/−0
• Simulation/Aivika/Experiment/Histogram.hs +0/−4
• Simulation/Aivika/Experiment/HtmlWriter.hs +1/−0
• Simulation/Aivika/Experiment/LastValueView.hs +1/−1
• Simulation/Aivika/Experiment/SamplingStatsWriter.hs +112/−0
• Simulation/Aivika/Experiment/TableView.hs +1/−1
• Simulation/Aivika/Experiment/TimingStatsView.hs +191/−0
• Simulation/Aivika/Experiment/TimingStatsWriter.hs +130/−0
• aivika-experiment.cabal +10/−2
• examples/MachRep3.hs +17/−11

@@ -49,7 +49,7 @@ import Data.Monoid import Data.String.Utils (replace) -import System.IO+import qualified System.IO.UTF8 as UTF8 import System.Directory import System.FilePath (combine) @@ -308,7 +308,7 @@                   reporterHtml reporter i          file = combine path "index.html"      ((), contents) <- runHtmlWriter html id-     writeFile file (contents [])+     UTF8.writeFile file (contents [])      when (experimentVerbose e) $        do putStr "Generated file "           putStrLn file

@@ -0,0 +1,88 @@++-- |+-- Module     : Simulation.Aivika.Experiment.ExperimentSpecsView+-- 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+--+-- The module defines 'ExperimentSpecsView' that shows the +-- experiment specs.+--++module Simulation.Aivika.Experiment.ExperimentSpecsView +       (ExperimentSpecsView(..),+        defaultExperimentSpecsView) where++import Control.Monad+import Control.Monad.Trans++import Simulation.Aivika.Experiment+import Simulation.Aivika.Experiment.HtmlWriter+import Simulation.Aivika.Experiment.ExperimentSpecsWriter++-- | Defines the 'View' that shows the experiment specs.+data ExperimentSpecsView =+  ExperimentSpecsView { experimentSpecsTitle       :: String,+                        -- ^ The title for the view.+                        experimentSpecsDescription :: String,+                        -- ^ The description for the view.+                        experimentSpecsWriter      :: ExperimentSpecsWriter+                        -- ^ It shows the specs.+                      }+  +-- | This is the default view.+defaultExperimentSpecsView :: ExperimentSpecsView+defaultExperimentSpecsView =  +  ExperimentSpecsView { experimentSpecsTitle       = "Experiment Specs",+                        experimentSpecsDescription = "It shows the experiment specs.",+                        experimentSpecsWriter      = defaultExperimentSpecsWriter }++instance View ExperimentSpecsView where  +  +  outputView v = +    let reporter exp dir =+          do st <- newExperimentSpecs v exp+             return Reporter { reporterInitialise = return (),+                               reporterFinalise   = return (),+                               reporterSimulate   = const $ return $ return (),+                               reporterTOCHtml    = experimentSpecsTOCHtml st,+                               reporterHtml       = experimentSpecsHtml st }+    in Generator { generateReporter = reporter }+  +-- | The state of the view.+data ExperimentSpecsViewState =+  ExperimentSpecsViewState { experimentSpecsView       :: ExperimentSpecsView,+                             experimentSpecsExperiment :: Experiment }+  +-- | Create a new state of the view.+newExperimentSpecs :: ExperimentSpecsView -> Experiment -> IO ExperimentSpecsViewState+newExperimentSpecs view exp =+  return ExperimentSpecsViewState { experimentSpecsView       = view,+                                    experimentSpecsExperiment = exp }+       +-- | Get the HTML code.     +experimentSpecsHtml :: ExperimentSpecsViewState -> Int -> HtmlWriter ()     +experimentSpecsHtml st index =+  do header st index+     let writer = experimentSpecsWriter (experimentSpecsView st)+         write  = experimentSpecsWrite writer+         exp    = experimentSpecsExperiment st+     write writer exp++header :: ExperimentSpecsViewState -> Int -> HtmlWriter ()+header st index =+  do writeHtmlHeader3WithId ("id" ++ show index) $+       writeHtmlText (experimentSpecsTitle $ experimentSpecsView st)+     let description = experimentSpecsDescription $ experimentSpecsView st+     unless (null description) $+       writeHtmlParagraph $+       writeHtmlText description++-- | Get the TOC item     +experimentSpecsTOCHtml :: ExperimentSpecsViewState -> Int -> HtmlWriter ()+experimentSpecsTOCHtml st index =+  writeHtmlListItem $+  writeHtmlLink ("#id" ++ show index) $+  writeHtmlText (experimentSpecsTitle $ experimentSpecsView st)

@@ -0,0 +1,131 @@++-- |+-- Module     : Simulation.Aivika.Experiment.ExperimentSpecsWriter+-- 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+--+-- The module defines 'ExperimentSpecsWriter' that knows how to write+-- in HTML the experiment specs which include the simulation specs and +-- the number of simulation runs.+--++module Simulation.Aivika.Experiment.ExperimentSpecsWriter +       (ExperimentSpecsWriter(..),+        defaultExperimentSpecsWriter) where++import Simulation.Aivika.Experiment+import Simulation.Aivika.Experiment.HtmlWriter++import Simulation.Aivika.Dynamics.Simulation++-- | Defines a writer that knows how to represent the+-- experiment specs as the HTML table.+data ExperimentSpecsWriter =+  ExperimentSpecsWriter { experimentSpecsWidth         :: Int,+                          -- ^ The width of the HTML table.+                          experimentSpecsNameText     :: String,+                          -- ^ Translated text \"Experiment Specs\".+                          experimentSpecsStartTimeText :: String,+                          -- ^ Translated text \"start time\".+                          experimentSpecsStopTimeText  :: String,+                          -- ^ Translated text \"stop time\".+                          experimentSpecsDTText        :: String,+                          -- ^ Translated text \"time step\".+                          experimentSpecsRunCountText  :: String,+                          -- ^ Translated text \"run count\".+                          experimentSpecsIntegMethodText    :: String,+                          -- ^ Translated text \"integration method\".+                          experimentSpecsEulerText     :: String,+                          -- ^ Translated text \"Euler's\".+                          experimentSpecsRungeKutta2Text :: String,+                          -- ^ Translated text \"the 2-nd order Runge-Kutta\".+                          experimentSpecsRungeKutta4Text :: String,+                          -- ^ Translated text \"the 4-th order Runge-Kutta\".+                          experimentSpecsFormatter     :: ShowS,+                          -- ^ The formatter of numbers.+                          experimentSpecsWrite :: ExperimentSpecsWriter ->  +                                                  Experiment -> HtmlWriter ()+                          -- ^ This function creates HTML.+                        }++-- | The default writer.+defaultExperimentSpecsWriter :: ExperimentSpecsWriter+defaultExperimentSpecsWriter =+  ExperimentSpecsWriter { +    experimentSpecsWidth = 400,+    experimentSpecsNameText = "Experiment Specs",+    experimentSpecsStartTimeText = "start time",+    experimentSpecsStopTimeText = "stop time",+    experimentSpecsDTText = "time step",+    experimentSpecsRunCountText = "run count",+    experimentSpecsIntegMethodText = "integration method",+    experimentSpecsEulerText = "Euler's",+    experimentSpecsRungeKutta2Text = "the 2-nd order Runge-Kutta",+    experimentSpecsRungeKutta4Text = "the 4-th order Runge-Kutta",+    experimentSpecsFormatter = id,+    experimentSpecsWrite = \writer exp ->+      do let format x = experimentSpecsFormatter writer (show x)+         writeHtml "<p>"+         writeHtml "<table frame='border' cellspacing='4' width='"+         writeHtml $ show $ experimentSpecsWidth writer+         writeHtml "'>"+         writeHtml "<tr>"+         writeHtml "<td colspan='2'>"+         writeHtml "<p align='center'>"+         writeHtmlText $ experimentSpecsNameText writer+         writeHtml "</h4>"+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "<tr>"+         writeHtml "<td>"+         writeHtmlText $ experimentSpecsStartTimeText writer +         writeHtml "</td>"+         writeHtml "<td>"+         writeHtmlText $ format $ spcStartTime $ experimentSpecs exp+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "<tr>"+         writeHtml "<td>"+         writeHtmlText $ experimentSpecsStopTimeText writer+         writeHtml "</td>"+         writeHtml "<td>"+         writeHtmlText $ format $ spcStopTime $ experimentSpecs exp+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "<tr>"+         writeHtml "<td>"+         writeHtmlText $ experimentSpecsDTText writer+         writeHtml "</td>"+         writeHtml "<td>"+         writeHtmlText $ format $ spcDT $ experimentSpecs exp+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "<tr>"+         writeHtml "<td>"+         writeHtmlText $ experimentSpecsRunCountText writer+         writeHtml "</td>"+         writeHtml "<td>"+         writeHtmlText $ format $ experimentRunCount exp+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "<tr>"+         writeHtml "<td>"+         writeHtmlText $ experimentSpecsIntegMethodText writer+         writeHtml "</td>"+         writeHtml "<td>"+         let method = spcMethod $ experimentSpecs exp+         writeHtml $ methodName method writer+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "</table>" +         writeHtml "</p>"+    }++-- | Return the method name.+methodName :: Method -> ExperimentSpecsWriter -> String+methodName Euler       = experimentSpecsEulerText+methodName RungeKutta2 = experimentSpecsRungeKutta2Text+methodName RungeKutta4 = experimentSpecsRungeKutta4Text

@@ -0,0 +1,177 @@++-- |+-- Module     : Simulation.Aivika.Experiment.FinalStatsView+-- 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+--+-- The module defines 'FinalStatsView' gathers the statistics+-- in the final time points for different simulation runs.+--++module Simulation.Aivika.Experiment.FinalStatsView+       (FinalStatsView(..), +        defaultFinalStatsView) where++import Control.Monad+import Control.Monad.Trans+import Control.Concurrent.MVar++import Data.IORef+import Data.Maybe++import Simulation.Aivika.Experiment+import Simulation.Aivika.Experiment.HtmlWriter+import Simulation.Aivika.Experiment.SamplingStatsWriter++import Simulation.Aivika.Dynamics+import Simulation.Aivika.Dynamics.Simulation+import Simulation.Aivika.Dynamics.Signal+import Simulation.Aivika.Dynamics.EventQueue+import Simulation.Aivika.Dynamics.Base+import Simulation.Aivika.Statistics++-- | Defines the 'View' that gathers the statistics+-- in the final time points.+data FinalStatsView =+  FinalStatsView { finalStatsTitle       :: String,+                   -- ^ This is a title for the view.+                   finalStatsDescription :: String,+                   -- ^ This is a description used in HTML.+                   finalStatsWriter      :: SamplingStatsWriter Double,+                   -- ^ It shows the sampling statistics.+                   finalStatsPredicate   :: Dynamics 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.+                 }+  +-- | 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.",+                   finalStatsWriter      = defaultSamplingStatsWriter,+                   finalStatsPredicate   = return True,+                   finalStatsSeries      = [] }++instance View FinalStatsView where+  +  outputView v = +    let reporter exp dir =+          do st <- newFinalStats v exp dir+             return Reporter { reporterInitialise = return (),+                               reporterFinalise   = return (),+                               reporterSimulate   = simulateFinalStats st,+                               reporterTOCHtml    = finalStatsTOCHtml st,+                               reporterHtml       = finalStatsHtml st }+    in Generator { generateReporter = reporter }+  +-- | The state of the view.+data FinalStatsViewState =+  FinalStatsViewState { finalStatsView       :: FinalStatsView,+                        finalStatsExperiment :: Experiment,+                        finalStatsLock       :: MVar (),+                        finalStatsResults    :: IORef (Maybe FinalStatsResults) }++-- | The statistics results.+data FinalStatsResults =+  FinalStatsResults { finalStatsNames  :: [String],+                      finalStatsValues :: [IORef (SamplingStats Double)] }+  +-- | Create a new state of the view.+newFinalStats :: FinalStatsView -> Experiment -> FilePath -> IO FinalStatsViewState+newFinalStats view exp dir =+  do l <- newMVar () +     r <- newIORef Nothing+     return FinalStatsViewState { finalStatsView       = view,+                                  finalStatsExperiment = exp,+                                  finalStatsLock       = l, +                                  finalStatsResults    = r }+       +-- | Create new statistics results.+newFinalStatsResults :: [String] -> Experiment -> IO FinalStatsResults+newFinalStatsResults names exp =+  do values <- forM names $ \_ -> liftIO $ newIORef emptySamplingStats+     return FinalStatsResults { finalStatsNames  = names,+                                finalStatsValues = values }+       +-- | Simulation the specified series.+simulateFinalStats :: FinalStatsViewState -> ExperimentData -> Dynamics (Dynamics ())+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 providerToDouble provider of+             Nothing -> error $+                        "Cannot represent series " +++                        providerName provider ++ +                        " as double values: simulateFinalStats"+             Just input -> 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+     t0 <- starttime+     enqueue (experimentQueue expdata) t0 $+       do let h = filterSignalM (const predicate) $+                  experimentSignalInStopTime expdata+          -- we must subscribe through the event queue;+          -- otherwise, we will loose a signal in the start time,+          -- because the handleSignal_ function checks the event queue+          handleSignal_ h $ \_ ->+            do xs <- sequence input+               liftIO $ withMVar lock $ \() ->+                 forM_ (zip xs values) $ \(x, values) ->+                 modifyIORef values $ addSamplingStats x+     return $ return ()++-- | Get the HTML code.     +finalStatsHtml :: FinalStatsViewState -> Int -> HtmlWriter ()+finalStatsHtml st index =+  do header st index+     results <- liftIO $ readIORef (finalStatsResults st)+     case results of+       Nothing -> return ()+       Just results ->+         do let names  = finalStatsNames results+                values = finalStatsValues results+                writer = finalStatsWriter (finalStatsView st)+                write  = samplingStatsWrite writer+            forM_ (zip names values) $ \(name, value) ->+              do stats <- liftIO $ readIORef value+                 write writer name stats++header :: FinalStatsViewState -> Int -> HtmlWriter ()+header st index =+  do writeHtmlHeader3WithId ("id" ++ show index) $ +       writeHtmlText (finalStatsTitle $ finalStatsView st)+     let description = finalStatsDescription $ finalStatsView st+     unless (null description) $+       writeHtmlParagraph $ +       writeHtmlText description++-- | Get the TOC item.+finalStatsTOCHtml :: FinalStatsViewState -> Int -> HtmlWriter ()+finalStatsTOCHtml st index =+  writeHtmlListItem $+  writeHtmlLink ("#id" ++ show index) $+  writeHtmlText (finalStatsTitle $ finalStatsView st)

@@ -0,0 +1,250 @@++-- |+-- Module     : Simulation.Aivika.Experiment.FinalTableView+-- 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+--+-- The module defines 'FinalTableView' that saves the simulation+-- results in the final time points for all simulation runs in+-- the CSV file.+--++module Simulation.Aivika.Experiment.FinalTableView+       (FinalTableView(..), +        defaultFinalTableView) where++import Control.Monad+import Control.Monad.Trans+import Control.Concurrent.MVar++import qualified Data.Map as M+import Data.IORef+import Data.Maybe++import System.IO+import System.FilePath++import Simulation.Aivika.Experiment+import Simulation.Aivika.Experiment.HtmlWriter++import Simulation.Aivika.Dynamics+import Simulation.Aivika.Dynamics.Simulation+import Simulation.Aivika.Dynamics.Signal+import Simulation.Aivika.Dynamics.EventQueue+import Simulation.Aivika.Dynamics.Base++-- | Defines the 'View' that saves the simulation +-- results in the final time points for all +-- simulation runs in the CSV file.+data FinalTableView =+  FinalTableView { finalTableTitle       :: String,+                   -- ^ This is a title used in HTML.+                   finalTableDescription :: String,+                   -- ^ This is a description used in HTML.+                   finalTableRunText     :: String,+                   -- ^ Translated text \"Run\".+                   finalTableLinkText    :: String,+                   -- ^ It specifies the text for the link +                   -- which is displayed in the HTML page. +                   -- The link downloads the corresponded +                   -- CSV file in the browser. +                   --+                   -- An example is+                   --+                   -- @+                   --   finalTableLinkText = \"Download the CSV file\"+                   -- @+                   finalTableFileName    :: FileName,+                   -- ^ It defines the file name for the CSV file. +                   -- It may include special variable @$TITLE@.+                   --+                   -- An example is+                   --+                   -- @+                   --   finalTableFileName = UniqueFileName \"$TITLE\", \".csv\"+                   -- @+                   finalTableSeparator   :: String,+                   -- ^ It defines the separator for the view. +                   -- It delimits the cells in the rows of the CSV file.+                   finalTableFormatter   :: ShowS,+                   -- ^ It defines the formatter which is applied+                   -- to all values before they will be written+                   -- in the CSV file.+                   finalTablePredicate   :: Dynamics 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.+                 }+  +-- | The default table view.  +defaultFinalTableView :: FinalTableView+defaultFinalTableView = +  FinalTableView { finalTableTitle       = "Final Table",+                   finalTableDescription = "It refers to the CSV file with the results in the final time points.",+                   finalTableRunText     = "Run",+                   finalTableLinkText    = "Download the CSV file",+                   finalTableFileName    = UniqueFileName "$TITLE" ".csv",+                   finalTableSeparator   = ",",+                   finalTableFormatter   = id,+                   finalTablePredicate   = return True,+                   finalTableSeries      = [] }++instance View FinalTableView where+  +  outputView v = +    let reporter exp dir =+          do st <- newFinalTable v exp dir+             return Reporter { reporterInitialise = return (),+                               reporterFinalise   = finaliseFinalTable st,+                               reporterSimulate   = simulateFinalTable st,+                               reporterTOCHtml    = finalTableTOCHtml st,+                               reporterHtml       = finalTableHtml st }+    in Generator { generateReporter = reporter }+  +-- | The state of the view.+data FinalTableViewState =+  FinalTableViewState { finalTableView       :: FinalTableView,+                        finalTableExperiment :: Experiment,+                        finalTableDir        :: FilePath, +                        finalTableFile       :: IORef (Maybe FilePath),+                        finalTableLock       :: MVar (),+                        finalTableResults    :: IORef (Maybe FinalTableResults) }++-- | The table results.+data FinalTableResults =+  FinalTableResults { finalTableNames  :: [String],+                      finalTableValues :: IORef (M.Map Int [String]) }+  +-- | Create a new state of the view.+newFinalTable :: FinalTableView -> Experiment -> FilePath -> IO FinalTableViewState+newFinalTable view exp dir =+  do f <- newIORef Nothing+     l <- newMVar () +     r <- newIORef Nothing+     return FinalTableViewState { finalTableView       = view,+                                  finalTableExperiment = exp,+                                  finalTableDir        = dir, +                                  finalTableFile       = f,+                                  finalTableLock       = l, +                                  finalTableResults    = r }+       +-- | Create new table results.+newFinalTableResults :: [String] -> Experiment -> IO FinalTableResults+newFinalTableResults names exp =+  do values <- newIORef M.empty +     return FinalTableResults { finalTableNames  = names,+                                finalTableValues = values }+       +-- | Simulation of the specified series.+simulateFinalTable :: FinalTableViewState -> ExperimentData -> Dynamics (Dynamics ())+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+     t <- time+     enqueue (experimentQueue expdata) t $+       do let h = filterSignalM (const predicate) $+                  experimentSignalInStopTime expdata+          -- we must subscribe through the event queue;+          -- otherwise, we will loose a signal in the start time,+          -- because the handleSignal_ function checks the event queue+          handleSignal_ h $ \_ ->+            do xs <- sequence input+               i  <- liftSimulation simulationIndex+               liftIO $ withMVar lock $ \() ->+                 modifyIORef values $ M.insert i xs+     return $ return ()+     +-- | Save the results in the CSV file after the simulation is complete.+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+     case results of+       Nothing -> return ()+       Just results ->+         do let names  = finalTableNames results+                values = finalTableValues results+            m <- readIORef values +            file <- resolveFileName +                    (Just $ finalTableDir st)+                    (finalTableFileName $ finalTableView st) $+                    M.fromList [("$TITLE", title)]+            -- create a new file+            h <- liftIO $ openFile file WriteMode+            -- write a header+            hPutStr h run+            forM_ names $ \name ->+              do hPutStr h separator+                 hPutStr h name+            hPutStrLn h ""+            -- write data+            forM_ (M.assocs m) $ \(i, xs) ->+              do hPutStr h $ show i+                 forM_ xs $ \x ->+                   do hPutStr h separator+                      hPutStr h $ formatter x+                 hPutStrLn h ""+            -- close file+            hClose h +            when (experimentVerbose $ finalTableExperiment st) $+              putStr "Generated file " >> putStrLn file+            writeIORef (finalTableFile st) $ Just file+     +-- | Get the HTML code.     +finalTableHtml :: FinalTableViewState -> Int -> HtmlWriter ()+finalTableHtml st index =+  do header st index+     file <- liftIO $ readIORef (finalTableFile st)+     case file of+       Nothing -> return ()+       Just f  ->+         writeHtmlParagraph $+         writeHtmlLink (makeRelative (finalTableDir st) f) $+         writeHtmlText (finalTableLinkText $ finalTableView st)++header :: FinalTableViewState -> Int -> HtmlWriter ()+header st index =+  do writeHtmlHeader3WithId ("id" ++ show index) $ +       writeHtmlText (finalTableTitle $ finalTableView st)+     let description = finalTableDescription $ finalTableView st+     unless (null description) $+       writeHtmlParagraph $ +       writeHtmlText description++-- | Get the TOC item.+finalTableTOCHtml :: FinalTableViewState -> Int -> HtmlWriter ()+finalTableTOCHtml st index =+  writeHtmlListItem $+  writeHtmlLink ("#id" ++ show index) $+  writeHtmlText (finalTableTitle $ finalTableView st)

@@ -27,10 +27,6 @@  import Numeric -----import System.IO.Unsafe----- -------------------------------------------------------------------------------  -- | Holds all the information needed to plot the histogram 

@@ -238,6 +238,7 @@ writeHtmlDocumentWithTitle title inner =   do writeHtml "<html>"      writeHtml "<head>"+     writeHtml "<meta http-equiv='Content-Type' content='text/html; charset=utf-8' />"      writeHtml "<title>"      writeHtmlText title      writeHtml "</title>"

@@ -61,7 +61,7 @@ defaultLastValueView =     LastValueView { lastValueTitle       = "The Last Values",                   lastValueRunTitle    = "$TITLE / Run $RUN_INDEX of $RUN_COUNT",-                  lastValueDescription = [],+                  lastValueDescription = "It shows the values in the final time points.",                   lastValueFormatter   = id,                   lastValueSeries      = [] }   

@@ -0,0 +1,112 @@++-- |+-- Module     : Simulation.Aivika.Experiment.SamplingStatsWriter+-- 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+--+-- The module defines 'SamplingStatsWriter' that knows how to write+-- the sampling statistics in HTML.+--++module Simulation.Aivika.Experiment.SamplingStatsWriter +       (SamplingStatsWriter(..),+        defaultSamplingStatsWriter) where++import Simulation.Aivika.Experiment+import Simulation.Aivika.Experiment.HtmlWriter++import Simulation.Aivika.Statistics++-- | Defines a writer that knows how to represent the 'SamplingStats'+-- as the HTML table.+data SamplingStatsWriter a =+  SamplingStatsWriter { samplingStatsWidth         :: Int,+                        -- ^ The width of the HTML table.+                        samplingStatsMeanText      :: String,+                        -- ^ Translated text \"mean\".+                        samplingStatsDeviationText :: String,+                        -- ^ Translated text \"deviation\".+                        samplingStatsMinText       :: String,+                        -- ^ Translated text \"minimum\".+                        samplingStatsMaxText       :: String,+                        -- ^ Translated text \"maximum\".+                        samplingStatsCountText       :: String,+                        -- ^ Translated text \"count\".+                        samplingStatsFormatter     :: ShowS,+                        -- ^ The formatter of numbers.+                        samplingStatsWrite         :: SamplingStatsWriter a -> String ->+                                                      SamplingStats a -> HtmlWriter ()+                        -- ^ This function reprensents the named statistics+                        -- as the HTML table.+                      }++-- | The default writer.+defaultSamplingStatsWriter :: Show a => SamplingStatsWriter a+defaultSamplingStatsWriter =+  SamplingStatsWriter { +    samplingStatsWidth = 400,+    samplingStatsMeanText = "mean",+    samplingStatsDeviationText = "deviation",+    samplingStatsMinText = "minimum",+    samplingStatsMaxText = "maximum",+    samplingStatsCountText = "count",+    samplingStatsFormatter = id,+    samplingStatsWrite = \writer name stats ->+      do let format x = samplingStatsFormatter writer (show x)+         writeHtml "<p>"+         writeHtml "<table frame='border' cellspacing='4' width='"+         writeHtml $ show $ samplingStatsWidth writer+         writeHtml "'>"+         writeHtml "<tr>"+         writeHtml "<td colspan='2'>"+         writeHtml "<p align='center'>"+         writeHtmlText name+         writeHtml "</h4>"+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "<tr>"+         writeHtml "<td>"+         writeHtmlText $ samplingStatsMeanText writer +         writeHtml "</td>"+         writeHtml "<td>"+         writeHtmlText $ format $ samplingStatsMean stats+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "<tr>"+         writeHtml "<td>"+         writeHtmlText $ samplingStatsDeviationText writer+         writeHtml "</td>"+         writeHtml "<td>"+         writeHtmlText $ format $ samplingStatsDeviation stats+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "<tr>"+         writeHtml "<td>"+         writeHtmlText $ samplingStatsMinText writer+         writeHtml "</td>"+         writeHtml "<td>"+         writeHtmlText $ format $ samplingStatsMin stats+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "<tr>"+         writeHtml "<td>"+         writeHtmlText $ samplingStatsMaxText writer+         writeHtml "</td>"+         writeHtml "<td>"+         writeHtmlText $ format $ samplingStatsMax stats+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "<tr>"+         writeHtml "<td>"+         writeHtmlText $ samplingStatsCountText writer+         writeHtml "</td>"+         writeHtml "<td>"+         writeHtml $ format $ samplingStatsCount stats+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "</table>" +         writeHtml "</p>"+    }

@@ -104,7 +104,7 @@ defaultTableView :: TableView defaultTableView =    TableView { tableTitle       = "Table",-              tableDescription = [],+              tableDescription = "This section contains the CSV file(s) with the simulation results.",               tableLinkText    = "Download the CSV file",               tableRunLinkText = "$LINK / Run $RUN_INDEX of $RUN_COUNT",               tableFileName    = UniqueFileName "$TITLE - $RUN_INDEX" ".csv",

@@ -0,0 +1,191 @@++-- |+-- Module     : Simulation.Aivika.Experiment.TimingStatsView+-- 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+--+-- The module defines 'TimingStatsView' that shows the timing statistics+-- for the variables for every simulation run separately.+--++module Simulation.Aivika.Experiment.TimingStatsView +       (TimingStatsView(..),+        defaultTimingStatsView) where++import Control.Monad+import Control.Monad.Trans++import qualified Data.Map as M+import Data.IORef+import Data.Maybe++import Data.String.Utils (replace)++import Simulation.Aivika.Experiment+import Simulation.Aivika.Experiment.HtmlWriter+import Simulation.Aivika.Experiment.TimingStatsWriter++import Simulation.Aivika.Dynamics+import Simulation.Aivika.Dynamics.Simulation+import Simulation.Aivika.Dynamics.Signal+import Simulation.Aivika.Dynamics.EventQueue+import Simulation.Aivika.Dynamics.Base+import Simulation.Aivika.Statistics++-- | Defines the 'View' that shows the timing statistics+-- for variables for every simulation run separately.+data TimingStatsView =+  TimingStatsView { timingStatsTitle       :: String,+                    -- ^ The title for the view.+                    timingStatsRunTitle    :: String,+                    -- ^ The run title for the view. It may include+                    -- special variables @$RUN_INDEX@, @$RUN_COUNT@ and +                    -- @$TITLE@.+                    --+                    -- An example is +                    --+                    -- @+                    --   timingStatsRunTitle = \"$TITLE / Run $RUN_INDEX of $RUN_COUNT\"+                    -- @+                    timingStatsDescription :: String,+                    -- ^ The description for the view.+                    timingStatsWriter      :: TimingStatsWriter Double,+                    -- ^ It shows the timing statistics.+                    timingStatsPredicate   :: Dynamics Bool,+                    -- ^ Specifies when gathering the statistics.+                    timingStatsSeries      :: [String] +                    -- ^ It contains the labels of the observed series.+                  }+  +-- | This is the default view.+defaultTimingStatsView :: TimingStatsView+defaultTimingStatsView =  +  TimingStatsView { timingStatsTitle       = "Timing Statistics",+                    timingStatsRunTitle    = "$TITLE / Run $RUN_INDEX of $RUN_COUNT",+                    timingStatsDescription = "The statistical data are gathered in the time points.",+                    timingStatsWriter      = defaultTimingStatsWriter,+                    timingStatsPredicate   = return True,+                    timingStatsSeries      = [] }++instance View TimingStatsView where  +  +  outputView v = +    let reporter exp dir =+          do st <- newTimingStats v exp+             return Reporter { reporterInitialise = return (),+                               reporterFinalise   = return (),+                               reporterSimulate   = simulateTimingStats st,+                               reporterTOCHtml    = timingStatsTOCHtml st,+                               reporterHtml       = timingStatsHtml st }+    in Generator { generateReporter = reporter }+  +-- | The state of the view.+data TimingStatsViewState =+  TimingStatsViewState { timingStatsView       :: TimingStatsView,+                         timingStatsExperiment :: Experiment,+                         timingStatsMap        :: M.Map Int (IORef [(String, IORef (TimingStats Double))]) }+  +-- | Create a new state of the view.+newTimingStats :: TimingStatsView -> Experiment -> IO TimingStatsViewState+newTimingStats view exp =+  do let n = experimentRunCount exp+     rs <- forM [0..(n - 1)] $ \i -> newIORef []    +     let m = M.fromList $ zip [0..(n - 1)] rs+     return TimingStatsViewState { timingStatsView       = view,+                                   timingStatsExperiment = exp,+                                   timingStatsMap        = m }+       +-- | Get the timing statistics during the simulation.+simulateTimingStats :: TimingStatsViewState -> ExperimentData -> Dynamics (Dynamics ())+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+     i <- liftSimulation simulationIndex+     let r = fromJust $ M.lookup (i - 1) $ timingStatsMap st+     t <- time+     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]+               enqueue (experimentQueue expdata) t $+                 -- we must subscribe through the event queue;+                 -- otherwise, we will loose a signal in the start time,+                 -- because the handleSignal_ function checks the event queue+                 handleSignal_ h $ \_ ->+                 do t <- time+                    x <- input+                    liftIO $ modifyIORef stats $ addTimingStats t x+     return $ return ()+     +-- | Get the HTML code.     +timingStatsHtml :: TimingStatsViewState -> Int -> HtmlWriter ()     +timingStatsHtml st index =+  let n = experimentRunCount $ timingStatsExperiment st+  in if n == 1+     then timingStatsHtmlSingle st index+     else timingStatsHtmlMultiple st index+     +-- | Get the HTML code for a single run.+timingStatsHtmlSingle :: TimingStatsViewState -> Int -> HtmlWriter ()+timingStatsHtmlSingle st index =+  do header st index+     let r = fromJust $ M.lookup 0 (timingStatsMap st)+     pairs <- liftIO $ readIORef r+     forM_ (reverse pairs) $ \(name, r) ->+       do stats <- liftIO $ readIORef r+          let writer = timingStatsWriter (timingStatsView st)+              write  = timingStatsWrite writer+          write writer name stats++-- | Get the HTML code for multiple runs+timingStatsHtmlMultiple :: TimingStatsViewState -> Int -> HtmlWriter ()+timingStatsHtmlMultiple st index =+  do header st index+     let n = experimentRunCount $ timingStatsExperiment st+     forM_ [0..(n - 1)] $ \i ->+       do let subtitle = +                replace "$RUN_INDEX" (show $ i + 1) $+                replace "$RUN_COUNT" (show n) $+                replace "$TITLE" (timingStatsTitle $ timingStatsView st)+                (timingStatsRunTitle $ timingStatsView st)+          writeHtmlHeader4 $+            writeHtmlText subtitle+          let r = fromJust $ M.lookup i (timingStatsMap st)+          pairs <- liftIO $ readIORef r+          forM_ (reverse pairs) $ \(name, r) ->+            do stats <- liftIO $ readIORef r+               let writer = timingStatsWriter (timingStatsView st)+                   write  = timingStatsWrite writer+               write writer name stats++header :: TimingStatsViewState -> Int -> HtmlWriter ()+header st index =+  do writeHtmlHeader3WithId ("id" ++ show index) $+       writeHtmlText (timingStatsTitle $ timingStatsView st)+     let description = timingStatsDescription $ timingStatsView st+     unless (null description) $+       writeHtmlParagraph $+       writeHtmlText description++-- | Get the TOC item     +timingStatsTOCHtml :: TimingStatsViewState -> Int -> HtmlWriter ()+timingStatsTOCHtml st index =+  writeHtmlListItem $+  writeHtmlLink ("#id" ++ show index) $+  writeHtmlText (timingStatsTitle $ timingStatsView st)

@@ -0,0 +1,130 @@++-- |+-- Module     : Simulation.Aivika.Experiment.TimingStatsWriter+-- 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+--+-- The module defines 'TimingStatsWriter' that knows how to write+-- the timing statistics in HTML.+--++module Simulation.Aivika.Experiment.TimingStatsWriter +       (TimingStatsWriter(..),+        defaultTimingStatsWriter) where++import Simulation.Aivika.Experiment+import Simulation.Aivika.Experiment.HtmlWriter++import Simulation.Aivika.Statistics++-- | Defines a writer that knows how to represent the 'TimingStats'+-- as the HTML table.+data TimingStatsWriter a =+  TimingStatsWriter { timingStatsWidth         :: Int,+                      -- ^ The width of the HTML table.+                      timingStatsTimeText      :: String,+                      -- ^ Translated text \"time\".+                      timingStatsMeanText      :: String,+                      -- ^ Translated text \"mean\".+                      timingStatsDeviationText :: String,+                      -- ^ Translated text \"deviation\".+                      timingStatsMinText       :: String,+                      -- ^ Translated text \"minimum\".+                      timingStatsMaxText       :: String,+                      -- ^ Translated text \"maximum\".+                      timingStatsFormatter     :: ShowS,+                      -- ^ The formatter of numbers.+                      timingStatsWrite         :: TimingStatsWriter a -> String ->+                                                  TimingStats a -> HtmlWriter ()+                      -- ^ This function reprensents the named statistics+                      -- as the HTML table.+                      }++-- | The default writer.+defaultTimingStatsWriter :: (Show a, TimingData a) => TimingStatsWriter a+defaultTimingStatsWriter =+  TimingStatsWriter { +    timingStatsWidth = 400,+    timingStatsMeanText = "mean",+    timingStatsTimeText = "time",+    timingStatsDeviationText = "deviation",+    timingStatsMinText = "minimum",+    timingStatsMaxText = "maximum",+    timingStatsFormatter = id,+    timingStatsWrite = \writer name stats ->+      do let format x = timingStatsFormatter writer (show x)+         writeHtml "<p>"+         writeHtml "<table frame='border' cellspacing='4' width='"+         writeHtml $ show $ timingStatsWidth writer+         writeHtml "'>"+         writeHtml "<tr>"+         writeHtml "<td colspan='3'>"+         writeHtml "<p align='center'>"+         writeHtmlText name+         writeHtml "</h4>"+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "<tr>"+         writeHtml "<td>"+         writeHtmlText $ timingStatsMeanText writer +         writeHtml "</td>"+         writeHtml "<td colspan='2'>"+         writeHtmlText $ format $ timingStatsMean stats+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "<tr>"+         writeHtml "<td>"+         writeHtmlText $ timingStatsDeviationText writer+         writeHtml "</td>"+         writeHtml "<td colspan='2'>"+         writeHtmlText $ format $ timingStatsDeviation stats+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "<tr>"+         writeHtml "<td>"+         writeHtmlText $ timingStatsMinText writer+         writeHtml "</td>"+         writeHtml "<td>"+         writeHtmlText $ format $ timingStatsMin stats+         writeHtml "</td>"+         writeHtml "<td>"+         writeHtmlText "("+         writeHtmlText $ timingStatsTimeText writer+         writeHtmlText " = "+         writeHtmlText $ format $ timingStatsMinTime stats+         writeHtmlText ")"+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "<tr>"+         writeHtml "<td>"+         writeHtmlText $ timingStatsMaxText writer+         writeHtml "</td>"+         writeHtml "<td>"+         writeHtmlText $ format $ timingStatsMax stats+         writeHtml "</td>"+         writeHtml "<td>"+         writeHtmlText "("+         writeHtmlText $ timingStatsTimeText writer+         writeHtmlText " = "+         writeHtmlText $ format $ timingStatsMaxTime stats+         writeHtmlText ")"+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "<tr>"+         writeHtml "<td>"+         writeHtmlText $ timingStatsTimeText writer+         writeHtml "</td>"+         writeHtml "<td colspan='2'>"+         writeHtml "["+         writeHtml $ format $ timingStatsStartTime stats+         writeHtml "; "+         writeHtml $ format $ timingStatsLastTime stats+         writeHtml "]"+         writeHtml "</td>"+         writeHtml "</tr>"+         writeHtml "</table>" +         writeHtml "</p>"+    }

@@ -1,5 +1,5 @@ name:            aivika-experiment-version:         0.1.2+version:         0.2 synopsis:        Simulation experiments for the Aivika library description:     This package allows defining simulation experiments for the Aivika@@ -28,7 +28,14 @@                      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.FinalStatsView                      Simulation.Aivika.Experiment.Histogram+                     Simulation.Aivika.Experiment.ExperimentSpecsView+                     Simulation.Aivika.Experiment.ExperimentSpecsWriter+                     Simulation.Aivika.Experiment.FinalTableView                      Simulation.Aivika.Experiment.Utils                           build-depends:   base >= 3 && < 6,@@ -37,10 +44,11 @@                      containers >= 0.4.0.0,                      directory >= 1.1.0.2,                      filepath >= 1.3.0.0,+                     utf8-string >= 0.3.7,                      MissingH >= 1.2.0.0,                      network >= 2.3.0.13,                      parallel-io >= 0.3.2.1,-                     aivika >= 0.4.3+                     aivika >= 0.5.1      extensions:      FlexibleInstances                      

@@ -13,7 +13,7 @@ -- until both machines are down. We find the proportion of up time. It -- should come out to about 0.45. -module MachRep3Model (model) where+-- module MachRep3Model (model) where  import System.Random import Control.Monad@@ -30,6 +30,10 @@ import Simulation.Aivika.Experiment import Simulation.Aivika.Experiment.LastValueView import Simulation.Aivika.Experiment.TableView+import Simulation.Aivika.Experiment.TimingStatsView+import Simulation.Aivika.Experiment.FinalStatsView+import Simulation.Aivika.Experiment.ExperimentSpecsView+import Simulation.Aivika.Experiment.FinalTableView  specs = Specs { spcStartTime = 0.0,                 spcStopTime = 1000.0,@@ -51,16 +55,17 @@     experimentRunCount = 3,     experimentDescription = description,     experimentGenerators =-      [outputView $ defaultLastValueView {-          lastValueDescription = -             "It shows the last value of " ++-             "the proportion of up time.",-          lastValueSeries = ["x"] },+      [outputView defaultExperimentSpecsView,+       outputView $ defaultLastValueView {+         lastValueSeries = ["x"] },+       outputView $ defaultTimingStatsView {+         timingStatsSeries = ["x"] },+       outputView $ defaultFinalStatsView {+         finalStatsSeries = ["x"] },        outputView $ defaultTableView {-         tableDescription = -            "These are tables for " ++-            "the proportion of up time.",-         tableSeries = ["x"] } ] }+         tableSeries = ["x"] }, +       outputView $ defaultFinalTableView {+         finalTableSeries = ["x"] } ] }  upRate = 1.0 / 1.0       -- reciprocal of mean up time repairRate = 1.0 / 0.5   -- reciprocal of mean repair time@@ -122,6 +127,7 @@               return $ x / (2 * y)                               experimentDataInStartTime queue-       [("x", seriesEntity "The proportion of up time" result)]+       [("x", seriesEntity "The proportion of up time" result),+        ("t", seriesEntity "Simulation time" time)]  main = runExperiment experiment model