aivika-experiment 1.1 → 1.3
raw patch · 14 files changed
+222/−175 lines, 14 filesdep ~aivika
Dependency ranges changed: aivika
Files
- Simulation/Aivika/Experiment.hs +2/−0
- Simulation/Aivika/Experiment/ExperimentSpecsView.hs +10/−8
- Simulation/Aivika/Experiment/ExperimentSpecsWriter.hs +6/−2
- Simulation/Aivika/Experiment/FileRenderer.hs +24/−0
- Simulation/Aivika/Experiment/FinalStatsView.hs +12/−10
- Simulation/Aivika/Experiment/FinalTableView.hs +20/−17
- Simulation/Aivika/Experiment/LastValueView.hs +13/−11
- Simulation/Aivika/Experiment/TableView.hs +21/−16
- Simulation/Aivika/Experiment/TimingStatsView.hs +13/−11
- Simulation/Aivika/Experiment/Types.hs +85/−86
- aivika-experiment.cabal +12/−5
- examples/LinearArray.hs +2/−2
- examples/MachRep3.hs +2/−2
- examples/README +0/−5
Simulation/Aivika/Experiment.hs view
@@ -13,6 +13,7 @@ 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,@@ -29,6 +30,7 @@ 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
Simulation/Aivika/Experiment/ExperimentSpecsView.hs view
@@ -1,4 +1,6 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+ -- | -- Module : Simulation.Aivika.Experiment.ExperimentSpecsView -- Copyright : Copyright (c) 2012, David Sorokin <david.sorokin@gmail.com>@@ -39,10 +41,10 @@ experimentSpecsDescription = "It shows the experiment specs.", experimentSpecsWriter = defaultExperimentSpecsWriter } -instance ExperimentView ExperimentSpecsView where +instance ExperimentView ExperimentSpecsView r where outputView v = - let reporter exp dir =+ let reporter exp renderer dir = do st <- newExperimentSpecs v exp return ExperimentReporter { reporterInitialise = return (), reporterFinalise = return (),@@ -52,18 +54,18 @@ in ExperimentGenerator { generateReporter = reporter } -- | The state of the view.-data ExperimentSpecsViewState =+data ExperimentSpecsViewState r = ExperimentSpecsViewState { experimentSpecsView :: ExperimentSpecsView,- experimentSpecsExperiment :: Experiment }+ experimentSpecsExperiment :: Experiment r } -- | Create a new state of the view.-newExperimentSpecs :: ExperimentSpecsView -> Experiment -> IO ExperimentSpecsViewState+newExperimentSpecs :: ExperimentSpecsView -> Experiment r -> IO (ExperimentSpecsViewState r) newExperimentSpecs view exp = return ExperimentSpecsViewState { experimentSpecsView = view, experimentSpecsExperiment = exp } -- | Get the HTML code. -experimentSpecsHtml :: ExperimentSpecsViewState -> Int -> HtmlWriter () +experimentSpecsHtml :: ExperimentSpecsViewState r -> Int -> HtmlWriter () experimentSpecsHtml st index = do header st index let writer = experimentSpecsWriter (experimentSpecsView st)@@ -71,7 +73,7 @@ exp = experimentSpecsExperiment st write writer exp -header :: ExperimentSpecsViewState -> Int -> HtmlWriter ()+header :: ExperimentSpecsViewState r -> Int -> HtmlWriter () header st index = do writeHtmlHeader3WithId ("id" ++ show index) $ writeHtmlText (experimentSpecsTitle $ experimentSpecsView st)@@ -81,7 +83,7 @@ writeHtmlText description -- | Get the TOC item -experimentSpecsTOCHtml :: ExperimentSpecsViewState -> Int -> HtmlWriter ()+experimentSpecsTOCHtml :: ExperimentSpecsViewState r -> Int -> HtmlWriter () experimentSpecsTOCHtml st index = writeHtmlListItem $ writeHtmlLink ("#id" ++ show index) $
Simulation/Aivika/Experiment/ExperimentSpecsWriter.hs view
@@ -1,4 +1,6 @@ +{-# LANGUAGE RankNTypes #-}+ -- | -- Module : Simulation.Aivika.Experiment.ExperimentSpecsWriter -- Copyright : Copyright (c) 2012, David Sorokin <david.sorokin@gmail.com>@@ -46,8 +48,10 @@ -- ^ Translated text \"the 4-th order Runge-Kutta\". experimentSpecsFormatter :: ShowS, -- ^ The formatter of numbers.- experimentSpecsWrite :: ExperimentSpecsWriter -> - Experiment -> HtmlWriter ()+ experimentSpecsWrite :: forall r.+ ExperimentSpecsWriter+ -> Experiment r+ -> HtmlWriter () -- ^ This function creates HTML. }
+ Simulation/Aivika/Experiment/FileRenderer.hs view
@@ -0,0 +1,24 @@++-- |+-- 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
Simulation/Aivika/Experiment/FinalStatsView.hs view
@@ -1,4 +1,6 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+ -- | -- Module : Simulation.Aivika.Experiment.FinalStatsView -- Copyright : Copyright (c) 2012, David Sorokin <david.sorokin@gmail.com>@@ -59,10 +61,10 @@ finalStatsPredicate = return True, finalStatsSeries = [] } -instance ExperimentView FinalStatsView where+instance ExperimentView FinalStatsView r where outputView v = - let reporter exp dir =+ let reporter exp renderer dir = do st <- newFinalStats v exp dir return ExperimentReporter { reporterInitialise = return (), reporterFinalise = return (),@@ -72,9 +74,9 @@ in ExperimentGenerator { generateReporter = reporter } -- | The state of the view.-data FinalStatsViewState =+data FinalStatsViewState r = FinalStatsViewState { finalStatsView :: FinalStatsView,- finalStatsExperiment :: Experiment,+ finalStatsExperiment :: Experiment r, finalStatsLock :: MVar (), finalStatsResults :: IORef (Maybe FinalStatsResults) } @@ -84,7 +86,7 @@ finalStatsValues :: [IORef (SamplingStats Double)] } -- | Create a new state of the view.-newFinalStats :: FinalStatsView -> Experiment -> FilePath -> IO FinalStatsViewState+newFinalStats :: FinalStatsView -> Experiment r -> FilePath -> IO (FinalStatsViewState r) newFinalStats view exp dir = do l <- newMVar () r <- newIORef Nothing@@ -94,14 +96,14 @@ finalStatsResults = r } -- | Create new statistics results.-newFinalStatsResults :: [String] -> Experiment -> IO FinalStatsResults+newFinalStatsResults :: [String] -> Experiment r -> 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 -> Event (Event ())+simulateFinalStats :: FinalStatsViewState r -> ExperimentData -> Event (Event ()) simulateFinalStats st expdata = do let protolabels = finalStatsSeries $ finalStatsView st protoproviders = flip map protolabels $ \protolabel ->@@ -142,7 +144,7 @@ return $ return () -- | Get the HTML code. -finalStatsHtml :: FinalStatsViewState -> Int -> HtmlWriter ()+finalStatsHtml :: FinalStatsViewState r -> Int -> HtmlWriter () finalStatsHtml st index = do header st index results <- liftIO $ readIORef (finalStatsResults st)@@ -157,7 +159,7 @@ do stats <- liftIO $ readIORef value write writer name stats -header :: FinalStatsViewState -> Int -> HtmlWriter ()+header :: FinalStatsViewState r -> Int -> HtmlWriter () header st index = do writeHtmlHeader3WithId ("id" ++ show index) $ writeHtmlText (finalStatsTitle $ finalStatsView st)@@ -167,7 +169,7 @@ writeHtmlText description -- | Get the TOC item.-finalStatsTOCHtml :: FinalStatsViewState -> Int -> HtmlWriter ()+finalStatsTOCHtml :: FinalStatsViewState r -> Int -> HtmlWriter () finalStatsTOCHtml st index = writeHtmlListItem $ writeHtmlLink ("#id" ++ show index) $
Simulation/Aivika/Experiment/FinalTableView.hs view
@@ -1,4 +1,6 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+ -- | -- Module : Simulation.Aivika.Experiment.FinalTableView -- Copyright : Copyright (c) 2012, David Sorokin <david.sorokin@gmail.com>@@ -28,6 +30,7 @@ import System.FilePath import Simulation.Aivika.Experiment.Types+import Simulation.Aivika.Experiment.FileRenderer import Simulation.Aivika.Experiment.HtmlWriter import Simulation.Aivika.Specs@@ -57,14 +60,14 @@ -- @ -- finalTableLinkText = \"Download the CSV file\" -- @- finalTableFileName :: FileName,+ finalTableFileName :: ExperimentFilePath, -- ^ It defines the file name for the CSV file. -- It may include special variable @$TITLE@. -- -- An example is -- -- @- -- finalTableFileName = UniqueFileName \"$TITLE\" \".csv\"+ -- finalTableFileName = UniqueFilePath \"$TITLE.csv\" -- @ finalTableSeparator :: String, -- ^ It defines the separator for the view. @@ -88,16 +91,16 @@ 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",+ finalTableFileName = UniqueFilePath "$TITLE.csv", finalTableSeparator = ",", finalTableFormatter = id, finalTablePredicate = return True, finalTableSeries = [] } -instance ExperimentView FinalTableView where+instance FileRenderer r => ExperimentView FinalTableView r where outputView v = - let reporter exp dir =+ let reporter exp renderer dir = do st <- newFinalTable v exp dir return ExperimentReporter { reporterInitialise = return (), reporterFinalise = finaliseFinalTable st,@@ -107,9 +110,9 @@ in ExperimentGenerator { generateReporter = reporter } -- | The state of the view.-data FinalTableViewState =+data FinalTableViewState r = FinalTableViewState { finalTableView :: FinalTableView,- finalTableExperiment :: Experiment,+ finalTableExperiment :: Experiment r, finalTableDir :: FilePath, finalTableFile :: IORef (Maybe FilePath), finalTableLock :: MVar (),@@ -121,7 +124,7 @@ finalTableValues :: IORef (M.Map Int [String]) } -- | Create a new state of the view.-newFinalTable :: FinalTableView -> Experiment -> FilePath -> IO FinalTableViewState+newFinalTable :: FinalTableView -> Experiment r -> FilePath -> IO (FinalTableViewState r) newFinalTable view exp dir = do f <- newIORef Nothing l <- newMVar () @@ -134,14 +137,14 @@ finalTableResults = r } -- | Create new table results.-newFinalTableResults :: [String] -> Experiment -> IO FinalTableResults+newFinalTableResults :: [String] -> Experiment r -> IO FinalTableResults newFinalTableResults names exp = do values <- newIORef M.empty return FinalTableResults { finalTableNames = names, finalTableValues = values } -- | Simulation of the specified series.-simulateFinalTable :: FinalTableViewState -> ExperimentData -> Event (Event ())+simulateFinalTable :: FinalTableViewState r -> ExperimentData -> Event (Event ()) simulateFinalTable st expdata = do let labels = finalTableSeries $ finalTableView st providers = experimentSeriesProviders expdata labels@@ -178,7 +181,7 @@ return $ return () -- | Save the results in the CSV file after the simulation is complete.-finaliseFinalTable :: FinalTableViewState -> IO ()+finaliseFinalTable :: FinalTableViewState r -> IO () finaliseFinalTable st = do let run = finalTableRunText $ finalTableView st formatter = finalTableFormatter $ finalTableView st@@ -191,9 +194,9 @@ do let names = finalTableNames results values = finalTableValues results m <- readIORef values - file <- resolveFileName - (Just $ finalTableDir st)- (finalTableFileName $ finalTableView st) $+ file <- resolveFilePath (finalTableDir st) $+ mapFilePath (flip replaceExtension ".csv") $+ expandFilePath (finalTableFileName $ finalTableView st) $ M.fromList [("$TITLE", title)] -- create a new file h <- liftIO $ openFile file WriteMode@@ -217,7 +220,7 @@ writeIORef (finalTableFile st) $ Just file -- | Get the HTML code. -finalTableHtml :: FinalTableViewState -> Int -> HtmlWriter ()+finalTableHtml :: FinalTableViewState r -> Int -> HtmlWriter () finalTableHtml st index = do header st index file <- liftIO $ readIORef (finalTableFile st)@@ -228,7 +231,7 @@ writeHtmlLink (makeRelative (finalTableDir st) f) $ writeHtmlText (finalTableLinkText $ finalTableView st) -header :: FinalTableViewState -> Int -> HtmlWriter ()+header :: FinalTableViewState r -> Int -> HtmlWriter () header st index = do writeHtmlHeader3WithId ("id" ++ show index) $ writeHtmlText (finalTableTitle $ finalTableView st)@@ -238,7 +241,7 @@ writeHtmlText description -- | Get the TOC item.-finalTableTOCHtml :: FinalTableViewState -> Int -> HtmlWriter ()+finalTableTOCHtml :: FinalTableViewState r -> Int -> HtmlWriter () finalTableTOCHtml st index = writeHtmlListItem $ writeHtmlLink ("#id" ++ show index) $
Simulation/Aivika/Experiment/LastValueView.hs view
@@ -1,4 +1,6 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+ -- | -- Module : Simulation.Aivika.Experiment.LastValueView -- Copyright : Copyright (c) 2012, David Sorokin <david.sorokin@gmail.com>@@ -64,10 +66,10 @@ lastValueFormatter = id, lastValueSeries = [] } -instance ExperimentView LastValueView where +instance ExperimentView LastValueView r where outputView v = - let reporter exp dir =+ let reporter exp renderer dir = do st <- newLastValues v exp return ExperimentReporter { reporterInitialise = return (), reporterFinalise = return (),@@ -77,13 +79,13 @@ in ExperimentGenerator { generateReporter = reporter } -- | The state of the view.-data LastValueViewState =+data LastValueViewState r = LastValueViewState { lastValueView :: LastValueView,- lastValueExperiment :: Experiment,+ lastValueExperiment :: Experiment r, lastValueMap :: M.Map Int (IORef [(String, String)]) } -- | Create a new state of the view.-newLastValues :: LastValueView -> Experiment -> IO LastValueViewState+newLastValues :: LastValueView -> Experiment r -> IO (LastValueViewState r) newLastValues view exp = do let n = experimentRunCount exp rs <- forM [0..(n - 1)] $ \i -> newIORef [] @@ -93,7 +95,7 @@ lastValueMap = m } -- | Get the last values during the simulation.-simulateLastValues :: LastValueViewState -> ExperimentData -> Event (Event ())+simulateLastValues :: LastValueViewState r -> ExperimentData -> Event (Event ()) simulateLastValues st expdata = do let labels = lastValueSeries $ lastValueView st input =@@ -114,7 +116,7 @@ return $ return () -- | Get the HTML code. -lastValueHtml :: LastValueViewState -> Int -> HtmlWriter () +lastValueHtml :: LastValueViewState r -> Int -> HtmlWriter () lastValueHtml st index = let n = experimentRunCount $ lastValueExperiment st in if n == 1@@ -122,7 +124,7 @@ else lastValueHtmlMultiple st index -- | Get the HTML code for a single run.-lastValueHtmlSingle :: LastValueViewState -> Int -> HtmlWriter ()+lastValueHtmlSingle :: LastValueViewState r -> Int -> HtmlWriter () lastValueHtmlSingle st index = do header st index let r = fromJust $ M.lookup 0 (lastValueMap st)@@ -131,7 +133,7 @@ formatPair pair (lastValueFormatter $ lastValueView st) -- | Get the HTML code for multiple runs-lastValueHtmlMultiple :: LastValueViewState -> Int -> HtmlWriter ()+lastValueHtmlMultiple :: LastValueViewState r -> Int -> HtmlWriter () lastValueHtmlMultiple st index = do header st index let n = experimentRunCount $ lastValueExperiment st@@ -148,7 +150,7 @@ forM_ pairs $ \pair -> formatPair pair (lastValueFormatter $ lastValueView st) -header :: LastValueViewState -> Int -> HtmlWriter ()+header :: LastValueViewState r -> Int -> HtmlWriter () header st index = do writeHtmlHeader3WithId ("id" ++ show index) $ writeHtmlText (lastValueTitle $ lastValueView st)@@ -165,7 +167,7 @@ writeHtmlText $ formatter value -- | Get the TOC item -lastValueTOCHtml :: LastValueViewState -> Int -> HtmlWriter ()+lastValueTOCHtml :: LastValueViewState r -> Int -> HtmlWriter () lastValueTOCHtml st index = writeHtmlListItem $ writeHtmlLink ("#id" ++ show index) $
Simulation/Aivika/Experiment/TableView.hs view
@@ -1,4 +1,6 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+ -- | -- Module : Simulation.Aivika.Experiment.TableView -- Copyright : Copyright (c) 2012, David Sorokin <david.sorokin@gmail.com>@@ -26,6 +28,7 @@ import System.FilePath import Simulation.Aivika.Experiment.Types+import Simulation.Aivika.Experiment.FileRenderer import Simulation.Aivika.Experiment.HtmlWriter import Simulation.Aivika.Experiment.Utils (replace) @@ -74,7 +77,7 @@ -- this kind is not displayed. Instead, only one -- link is shown, which text is defined by the -- 'tableLinkText' field.- tableFileName :: FileName,+ tableFileName :: ExperimentFilePath, -- ^ It defines the file name for each CSV file. -- It may include special variables @$TITLE@, -- @$RUN_INDEX@ and @$RUN_COUNT@.@@ -82,7 +85,7 @@ -- An example is -- -- @- -- tableFileName = UniqueFileName \"$TITLE - $RUN_INDEX\" \".csv\"+ -- tableFileName = UniqueFilePath \"$TITLE - $RUN_INDEX.csv\" -- @ tableSeparator :: String, -- ^ It defines the separator for the view. @@ -106,16 +109,16 @@ 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",+ tableFileName = UniqueFilePath "$TITLE - $RUN_INDEX.csv", tableSeparator = ",", tableFormatter = id, tablePredicate = return True, tableSeries = [] } -instance ExperimentView TableView where+instance FileRenderer r => ExperimentView TableView r where outputView v = - let reporter exp dir =+ let reporter exp renderer dir = do st <- newTable v exp dir return ExperimentReporter { reporterInitialise = return (), reporterFinalise = return (),@@ -125,18 +128,20 @@ in ExperimentGenerator { generateReporter = reporter } -- | The state of the view.-data TableViewState =+data TableViewState r = TableViewState { tableView :: TableView,- tableExperiment :: Experiment,+ tableExperiment :: Experiment r, tableDir :: FilePath, tableMap :: M.Map Int FilePath } -- | Create a new state of the view.-newTable :: TableView -> Experiment -> FilePath -> IO TableViewState+newTable :: TableView -> Experiment r -> FilePath -> IO (TableViewState r) newTable view exp dir = do let n = experimentRunCount exp- fs <- forM [0..(n - 1)] $ \i -> - resolveFileName (Just dir) (tableFileName view) $+ fs <- forM [0..(n - 1)] $ \i ->+ resolveFilePath dir $+ mapFilePath (flip replaceExtension ".csv") $+ expandFilePath (tableFileName view) $ M.fromList [("$TITLE", tableTitle view), ("$RUN_INDEX", show $ i + 1), ("$RUN_COUNT", show n)]@@ -148,7 +153,7 @@ tableMap = m } -- | Write the tables during the simulation.-simulateTable :: TableViewState -> ExperimentData -> Event (Event ())+simulateTable :: TableViewState r -> ExperimentData -> Event (Event ()) simulateTable st expdata = do let labels = tableSeries $ tableView st providers = experimentSeriesProviders expdata labels@@ -191,7 +196,7 @@ hClose h -- close the file -- | Get the HTML code. -tableHtml :: TableViewState -> Int -> HtmlWriter () +tableHtml :: TableViewState r -> Int -> HtmlWriter () tableHtml st index = let n = experimentRunCount $ tableExperiment st in if n == 1@@ -199,7 +204,7 @@ else tableHtmlMultiple st index -- | Get the HTML code for a single run.-tableHtmlSingle :: TableViewState -> Int -> HtmlWriter ()+tableHtmlSingle :: TableViewState r -> Int -> HtmlWriter () tableHtmlSingle st index = do header st index let f = fromJust $ M.lookup 0 (tableMap st)@@ -208,7 +213,7 @@ writeHtmlText (tableLinkText $ tableView st) -- | Get the HTML code for multiple runs-tableHtmlMultiple :: TableViewState -> Int -> HtmlWriter ()+tableHtmlMultiple :: TableViewState r -> Int -> HtmlWriter () tableHtmlMultiple st index = do header st index let n = experimentRunCount $ tableExperiment st@@ -223,7 +228,7 @@ writeHtmlLink (makeRelative (tableDir st) f) $ writeHtmlText sublink -header :: TableViewState -> Int -> HtmlWriter ()+header :: TableViewState r -> Int -> HtmlWriter () header st index = do writeHtmlHeader3WithId ("id" ++ show index) $ writeHtmlText (tableTitle $ tableView st)@@ -233,7 +238,7 @@ writeHtmlText description -- | Get the TOC item -tableTOCHtml :: TableViewState -> Int -> HtmlWriter ()+tableTOCHtml :: TableViewState r -> Int -> HtmlWriter () tableTOCHtml st index = writeHtmlListItem $ writeHtmlLink ("#id" ++ show index) $
Simulation/Aivika/Experiment/TimingStatsView.hs view
@@ -1,4 +1,6 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+ -- | -- Module : Simulation.Aivika.Experiment.TimingStatsView -- Copyright : Copyright (c) 2012, David Sorokin <david.sorokin@gmail.com>@@ -70,10 +72,10 @@ timingStatsPredicate = return True, timingStatsSeries = [] } -instance ExperimentView TimingStatsView where +instance ExperimentView TimingStatsView r where outputView v = - let reporter exp dir =+ let reporter exp renderer dir = do st <- newTimingStats v exp return ExperimentReporter { reporterInitialise = return (), reporterFinalise = return (),@@ -83,13 +85,13 @@ in ExperimentGenerator { generateReporter = reporter } -- | The state of the view.-data TimingStatsViewState =+data TimingStatsViewState r = TimingStatsViewState { timingStatsView :: TimingStatsView,- timingStatsExperiment :: Experiment,+ timingStatsExperiment :: Experiment r, timingStatsMap :: M.Map Int (IORef [(String, IORef (TimingStats Double))]) } -- | Create a new state of the view.-newTimingStats :: TimingStatsView -> Experiment -> IO TimingStatsViewState+newTimingStats :: TimingStatsView -> Experiment r -> IO (TimingStatsViewState r) newTimingStats view exp = do let n = experimentRunCount exp rs <- forM [0..(n - 1)] $ \i -> newIORef [] @@ -99,7 +101,7 @@ timingStatsMap = m } -- | Get the timing statistics during the simulation.-simulateTimingStats :: TimingStatsViewState -> ExperimentData -> Event (Event ())+simulateTimingStats :: TimingStatsViewState r -> ExperimentData -> Event (Event ()) simulateTimingStats st expdata = do let labels = timingStatsSeries $ timingStatsView st input providers =@@ -132,7 +134,7 @@ return $ return () -- | Get the HTML code. -timingStatsHtml :: TimingStatsViewState -> Int -> HtmlWriter () +timingStatsHtml :: TimingStatsViewState r -> Int -> HtmlWriter () timingStatsHtml st index = let n = experimentRunCount $ timingStatsExperiment st in if n == 1@@ -140,7 +142,7 @@ else timingStatsHtmlMultiple st index -- | Get the HTML code for a single run.-timingStatsHtmlSingle :: TimingStatsViewState -> Int -> HtmlWriter ()+timingStatsHtmlSingle :: TimingStatsViewState r -> Int -> HtmlWriter () timingStatsHtmlSingle st index = do header st index let r = fromJust $ M.lookup 0 (timingStatsMap st)@@ -152,7 +154,7 @@ write writer name stats -- | Get the HTML code for multiple runs-timingStatsHtmlMultiple :: TimingStatsViewState -> Int -> HtmlWriter ()+timingStatsHtmlMultiple :: TimingStatsViewState r -> Int -> HtmlWriter () timingStatsHtmlMultiple st index = do header st index let n = experimentRunCount $ timingStatsExperiment st@@ -172,7 +174,7 @@ write = timingStatsWrite writer write writer name stats -header :: TimingStatsViewState -> Int -> HtmlWriter ()+header :: TimingStatsViewState r -> Int -> HtmlWriter () header st index = do writeHtmlHeader3WithId ("id" ++ show index) $ writeHtmlText (timingStatsTitle $ timingStatsView st)@@ -182,7 +184,7 @@ writeHtmlText description -- | Get the TOC item -timingStatsTOCHtml :: TimingStatsViewState -> Int -> HtmlWriter ()+timingStatsTOCHtml :: TimingStatsViewState r -> Int -> HtmlWriter () timingStatsTOCHtml st index = writeHtmlListItem $ writeHtmlLink ("#id" ++ show index) $
Simulation/Aivika/Experiment/Types.hs view
@@ -1,5 +1,5 @@ -{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} -- | -- Module : Simulation.Aivika.Experiment.Types@@ -41,10 +41,10 @@ ExperimentView(..), ExperimentGenerator(..), ExperimentReporter(..),- DirectoryName(..),- resolveDirectoryName,- FileName(..),- resolveFileName) where+ ExperimentFilePath(..),+ resolveFilePath,+ expandFilePath,+ mapFilePath) where import Control.Monad import Control.Monad.State@@ -66,23 +66,24 @@ import qualified System.IO.UTF8 as UTF8 import System.Directory-import System.FilePath (combine)+import System.FilePath 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.Experiment.HtmlWriter import Simulation.Aivika.Experiment.Utils (replace) --- | It defines the simulation experiment.-data Experiment = +-- | It defines the simulation experiment with the specified rendering backend.+data Experiment r = Experiment { experimentSpecs :: Specs, -- ^ The simulation specs for the experiment. experimentRunCount :: Int, -- ^ How many simulation runs should be launched.- experimentDirectoryName :: DirectoryName,+ experimentDirectoryName :: ExperimentFilePath, -- ^ The directory in which the output results should be saved. experimentTitle :: String, -- ^ The experiment title.@@ -90,9 +91,9 @@ -- ^ The experiment description. experimentVerbose :: Bool, -- ^ Whether the process of generating the results is verbose.- experimentGenerators :: [ExperimentGenerator], + experimentGenerators :: [ExperimentGenerator r], -- ^ The experiment generators.- experimentIndexHtml :: Experiment -> [ExperimentReporter] -> FilePath -> IO (),+ experimentIndexHtml :: Experiment r -> [ExperimentReporter] -> FilePath -> IO (), -- ^ Create the @index.html@ file after the simulation is finished -- in the specified directory. experimentNumCapabilities :: IO Int@@ -101,11 +102,11 @@ } -- | The default experiment.-defaultExperiment :: Experiment+defaultExperiment :: Experiment r defaultExperiment = Experiment { experimentSpecs = Specs 0 10 0.01 RungeKutta4 SimpleGenerator, experimentRunCount = 1,- experimentDirectoryName = UniqueDirectoryName "experiment",+ experimentDirectoryName = UniqueFilePath "experiment", experimentTitle = "Simulation Experiment", experimentDescription = "", experimentVerbose = True,@@ -113,9 +114,9 @@ experimentIndexHtml = createIndexHtml, experimentNumCapabilities = getNumCapabilities } --- | This is a generator of the reporter. -data ExperimentGenerator = - ExperimentGenerator { generateReporter :: Experiment -> FilePath -> IO ExperimentReporter +-- | 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.@@ -124,10 +125,10 @@ -- | 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 where+class ExperimentView v r where -- | Create a generator of the reporter.- outputView :: v -> ExperimentGenerator+ outputView :: v -> ExperimentGenerator r -- | Represents the series. It is usually something, or -- an array of something, or a list of such values which@@ -273,10 +274,16 @@ -- | Run the simulation experiment sequentially. For example, -- it can be a Monte-Carlo simulation dependentent on the external -- 'Parameter' values.-runExperiment :: Experiment -> Simulation ExperimentData -> IO ()+runExperiment :: Experiment r+ -- ^ the simulation experiment to run+ -> r+ -- ^ the rendering backend+ -> Simulation ExperimentData+ -- ^ the simulation results received from the model+ -> IO () runExperiment = runExperimentWithExecutor sequence_ --- | Run the simulation experiment parallelly. +-- | Run the simulation experiment in parallel. -- -- Make sure that you compile with @-threaded@ and supply @+RTS -N2 -RTS@ -- to the generated Haskell executable on dual core processor, @@ -288,7 +295,13 @@ -- threads directly with help of 'experimentNumCapabilities', -- although the real number of parallel threads can depend on many -- factors.-runExperimentParallel :: Experiment -> Simulation ExperimentData -> IO ()+runExperimentParallel :: Experiment r+ -- ^ the simulation experiment to run+ -> r+ -- ^ the rendering backend+ -> Simulation ExperimentData+ -- ^ the simulation results received from the model+ -> IO () runExperimentParallel e = runExperimentWithExecutor executor e where executor tasks = do n <- experimentNumCapabilities e@@ -296,20 +309,26 @@ parallel_ pool tasks -- | Run the simulation experiment with the specified executor.-runExperimentWithExecutor :: ([IO ()] -> IO ()) ->- Experiment -> - Simulation ExperimentData -> IO ()-runExperimentWithExecutor executor e simulation = +runExperimentWithExecutor :: ([IO ()] -> IO ())+ -- ^ an executor that allows parallelizing the simulation if required+ -> Experiment r+ -- ^ the simulation experiment to run+ -> r+ -- ^ the rendering backend+ -> Simulation ExperimentData+ -- ^ the simulation results received from the model+ -> IO ()+runExperimentWithExecutor executor e r simulation = do let specs = experimentSpecs e runCount = experimentRunCount e dirName = experimentDirectoryName e generators = experimentGenerators e- path <- resolveDirectoryName Nothing dirName M.empty+ path <- resolveFilePath "" dirName when (experimentVerbose e) $ do putStr "Using directory " putStrLn path createDirectoryIfMissing True path- reporters <- mapM (\x -> generateReporter x e path)+ reporters <- mapM (\x -> generateReporter x e r path) generators forM_ reporters reporterInitialise let simulate :: Simulation ()@@ -327,7 +346,7 @@ return () -- | Create an index HTML file. -createIndexHtml :: Experiment -> [ExperimentReporter] -> FilePath -> IO ()+createIndexHtml :: Experiment r -> [ExperimentReporter] -> FilePath -> IO () createIndexHtml e reporters path = do let html :: HtmlWriter () html = @@ -348,75 +367,49 @@ do putStr "Generated file " putStrLn file --- | Specifies the directory name, unique or writable.-data DirectoryName = WritableDirectoryName String- -- ^ The directory which is overwritten in - -- case if it existed before.- | UniqueDirectoryName String- -- ^ The directory which is always unique,- -- when a prefix is added to the name- -- in case of need.- --- | Specifies the file name, unique or writable.-data FileName = WritableFileName String String- -- ^ The file which is overwritten in - -- case if it existed before. The first- -- field defines a name or its prototype.- -- The second field is the file extension.- | UniqueFileName String String- -- ^ The file which is always unique,- -- when a prefix is added to the name- -- in case of need. The first field- -- defines a name or its prototype.- -- The second field is the file exension.+-- | 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 + -- case if it existed before.+ | UniqueFilePath FilePath+ -- ^ The file which is always unique,+ -- when an automatically generated suffix+ -- is added to the name in case of need. --- | Resolve the directory name relative to the passed in directory --- as the first argument, replacing the specified strings according the map. -resolveDirectoryName :: Maybe FilePath -> DirectoryName -> M.Map String String -> IO String-resolveDirectoryName dir (WritableDirectoryName name) map = - return $ replaceName (combineName dir name) map-resolveDirectoryName dir (UniqueDirectoryName name) map =- let x = replaceName name map- loop y i =- do let n = combineName dir y- f1 <- doesFileExist n- f2 <- doesDirectoryExist n- if f1 || f2- then loop (x ++ "(" ++ show i ++ ")") (i + 1)- else return n- in loop x 2- --- | Resolve the file name relative to the passed in directory --- as the first argument, replacing the specified strings according the map. -resolveFileName :: Maybe FilePath -> FileName -> M.Map String String -> IO String-resolveFileName dir (WritableFileName name ext) map = - return $ replaceName (combineName dir name ++ ext) map-resolveFileName dir (UniqueFileName name ext) map =- let x = replaceName name map+-- | Resolve the file path relative to the specified directory passed in the first argument+-- and taking into account a possible requirement to have an unique file name.+resolveFilePath :: FilePath -> ExperimentFilePath -> IO FilePath+resolveFilePath dir (WritableFilePath path) =+ return $ dir </> path+resolveFilePath dir (UniqueFilePath path) =+ let (name, ext) = splitExtension path loop y i =- do let n = combineName dir y ++ ext+ do let n = dir </> addExtension y ext f1 <- doesFileExist n f2 <- doesDirectoryExist n if f1 || f2- then loop (x ++ "(" ++ show i ++ ")") (i + 1)+ then loop (name ++ "(" ++ show i ++ ")") (i + 1) else return n- in loop x 2- --- | Replace the name according the specified table.-replaceName :: String -> M.Map String String -> String -replaceName name map = name' where+ in loop name 2++-- | Expand the file path using the specified table of substitutions.+expandFilePath :: ExperimentFilePath -> M.Map String String -> ExperimentFilePath+expandFilePath (WritableFilePath path) map = WritableFilePath (expandTemplates path map)+expandFilePath (UniqueFilePath path) map = UniqueFilePath (expandTemplates path map)++-- | Expand the string templates using the specified table of substitutions.+expandTemplates :: String -> M.Map String String -> String +expandTemplates name map = name' where ((), name') = flip runState name $ forM_ (M.assocs map) $ \(k, v) -> do a <- get put $ replace k v a- --- | Combine the file name with the directory name.-combineName :: Maybe String -> String -> String -combineName dir name =- case dir of- Nothing -> name- Just dir -> combine dir name +-- | Transform the file path using the specified function.+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 @@ -455,6 +448,12 @@ containerData = readRef containerSignal = Just . refChanged_++instance SeriesContainer LR.Ref where++ containerData = LR.readRef++ containerSignal = const Nothing instance SeriesContainer Var where
aivika-experiment.cabal view
@@ -1,5 +1,5 @@ name: aivika-experiment-version: 1.1+version: 1.3 synopsis: Simulation experiments for the Aivika library description: This package allows defining simulation experiments for the Aivika@@ -16,18 +16,18 @@ author: David Sorokin maintainer: David Sorokin <david.sorokin@gmail.com> homepage: http://github.com/dsorokin/aivika-experiment-cabal-version: >= 1.2.0+cabal-version: >= 1.6 build-type: Simple tested-with: GHC == 7.6.3 extra-source-files: examples/MachRep3.hs examples/LinearArray.hs- examples/README library 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@@ -54,8 +54,15 @@ split >= 0.2.2, network >= 2.3.0.13, parallel-io >= 0.3.2.1,- aivika >= 1.1+ aivika >= 1.3 - extensions: FlexibleInstances+ extensions: FlexibleInstances,+ MultiParamTypeClasses,+ RankNTypes ghc-options: -O2++source-repository head++ type: git+ location: https://github.com/dsorokin/aivika-experiment
examples/LinearArray.hs view
@@ -48,7 +48,7 @@ ("m", seriesEntity "M" m), ("c", seriesEntity "C" c)] -experiment :: Experiment+experiment :: FileRenderer r => Experiment r experiment = defaultExperiment { experimentSpecs = specs,@@ -69,4 +69,4 @@ outputView $ defaultFinalStatsView { finalStatsSeries = ["m", "c"] } ] } -main = runExperiment experiment (model 51)+main = runExperiment experiment HtmlRenderer (model 51)
examples/MachRep3.hs view
@@ -36,7 +36,7 @@ "until both machines are down. We find the proportion of up time. It " ++ "should come out to about 0.45." -experiment :: Experiment+experiment :: FileRenderer r => Experiment r experiment = defaultExperiment { experimentSpecs = specs,@@ -113,4 +113,4 @@ [("x", seriesEntity "The proportion of up time" result), ("t", seriesEntity "Simulation time" time)] -main = runExperiment experiment model+main = runExperiment experiment HtmlRenderer model
− examples/README
@@ -1,5 +0,0 @@-You may find more examples on GitHub by the following link:--https://github.com/dsorokin/aivika-models--July 18, 2013