experimenter 0.1.0.2 → 0.1.0.4

raw patch · 6 files changed

+61/−36 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• README.md +1/−1
• experimenter.cabal +2/−2
• src/Experimenter/Eval/Latex.hs +17/−8
• src/Experimenter/Eval/Ops.hs +20/−16
• src/Experimenter/Eval/Table.hs +17/−9

@@ -1,3 +1,7 @@ # Changelog for experimenter +Release 0.1.0.3 on 31.12.2020:+  - Using username for LaTeX output+  - Parameter tables are rendered using the tabularX to ensure the textwidth is not exceeded+  - Nicer output for running the evaluations ## Unreleased changes

@@ -85,7 +85,7 @@ the preparation steps are changed, all consecutive data, including warm-up and all evaluations, are deleted and rerun. -See [Dice.hs](https://github.com/schnecki/experimenter/examples/Dice.hs) for a full implementation,+See [Dice.hs](https://github.com/schnecki/experimenter/blob/master/examples/Dice.hs) for a full implementation, where the sides of the dices are variable over the experiment. An example report of this experiment can be found in the same folder. 

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 65a21babb6664fc85d1c1d35f1aabed01dbdf6b1603323eb13e2b77dae22c6e7+-- hash: 2dfd476c8b0f4da0340c035c0501e8087c0808ea9fba7aaec32f5527c7114c37  name:           experimenter-version:        0.1.0.2+version:        0.1.0.4 synopsis:       Perform scientific experiments stored in a DB, and generate reports. description:    Please see the README on GitHub at <https://github.com/schnecki/experimenter#readme> category:       Experiment

@@ -16,6 +16,7 @@ import           Control.DeepSeq import           Control.Lens                 hiding ((&)) import           Control.Monad                (forM, unless, void)+import           Control.Monad.IO.Class import           Control.Monad.Logger import           Data.List                    as L (find, foldl') import qualified Data.Map.Strict              as M@@ -24,11 +25,13 @@ import           GHC.Generics import           System.Directory import           System.FilePath.Posix+import           System.Posix.User import           System.Process import           Text.LaTeX import           Text.LaTeX.Packages.AMSMath import           Text.LaTeX.Packages.Hyperref import           Text.LaTeX.Packages.Inputenc+import           Text.LaTeX.Packages.TabularX  import           Experimenter.Availability import           Experimenter.DatabaseSetting@@ -43,6 +46,8 @@ import           Experimenter.Util  +import           Debug.Trace+ writeAndCompileLatex :: DatabaseSetting -> Evals a -> IO () writeAndCompileLatex dbSetup evals = writeLatex dbSetup evals >> compileLatex evals @@ -73,17 +78,19 @@   -- Preamble with some basic info.-thePreamble :: (MonadLogger m) => Evals a -> LaTeXT m ()+thePreamble :: (MonadIO m) => Evals a -> LaTeXT m () thePreamble evals = do   let n = evals ^. evalsExperiments . experimentsName   documentclass [] article-  author "Manuel Schneckenreither"+  user <- liftIO getLoginName+  author ("Username: " <> fromString user)   title $ "Evaluation for ``" <> raw n <> "''"   usepackage [utf8] inputenc   usepackage [] "fullpage"   usepackage [] "array"   usepackage [] amsmath   usepackage [pdftex] hyperref+  usepackage [] tabularxp  -- Body with a section. theBody :: Evals a -> LaTeXT SimpleDB ()@@ -108,12 +115,14 @@     , Row ["Experiment Evaluation Replications:",         CellT (tshow $ exps ^. experimentsSetup . expsSetupEvaluationReplications)]     ] -  let infoParams = exps ^. experimentsInfoParameters-  unless (null infoParams) $ do-    part "Experiment Information Parameters"-    printTable $ Table (Row ["Parameter", "Value"])-      (map mkInfoParam infoParams)+  let infoParams = trace( "Info Params: " ++ show (length $ exps ^. experimentsInfoParameters)) $ exps ^. experimentsInfoParameters ++  part "Experiment Information Parameters"+  if null infoParams+    then center $ text "No Information Parameters were defined in the experiment setup"+    else printTextwidthTable $ Table (Row ["Parameter", "Value"]) (map mkInfoParam infoParams)+   where mkInfoParam (ExperimentInfoParameter n v) = Row [CellT n, CellT (tshow v)]  @@ -174,7 +183,7 @@         let tblsFiltered = filter  (( == k) . fst) tbls         unless (null tblsFiltered) $ do           subsection $ "Experiment No. " <> raw (tshow k)-          maybe "There are no configured parameters!" printTable (M.findWithDefault Nothing k params)+          maybe "There are no configured parameters!" printTextwidthTable (M.findWithDefault Nothing k params)           mapM_ (\(_, tbls') -> forM tbls' $ \statsDefTbl -> printTableWithName statsDefTbl) tblsFiltered  

@@ -60,9 +60,13 @@  mkEvals :: (ExperimentDef a ) => [StatsDef a] -> Experiment a -> DB (ExpM a) (ExperimentEval a) mkEvals evals e = do-  xs <- mkTime "All Experiment Evaluations" $ mapMRnf (fmap Available . genExperiment e) evals+  liftIO $ putStrLn $ "Evaluating Experiment " ++ show (e ^. experimentNumber)+  xs <- mkTime "All Experiment Evaluations" $ mapMRnf evalStatsDef evals   return $ force $ ExperimentEval (e ^. experimentNumber) xs (e {_experimentResults = []})-+  where+    evalStatsDef statsDef = do+      -- liftIO $ putStrLn $ "Evaluating " ++ show statsDef+      Available <$> genExperiment e statsDef  mapMRnf :: (NFData b, Monad m) => (a -> m b) -> [a] -> m [b] mapMRnf _ [] = return []@@ -80,12 +84,12 @@   where addName res = res { _evalType = Named (res ^. evalType) name } genExperiment exp eval =   case eval of-    Mean OverExperimentRepetitions (Stats eval') -> reduce (Stats eval') <$!> genExpRes id eval'-    Mean OverExperimentRepetitions eval' -> reduce eval' <$!> genExpRes id (Id eval')-    Sum OverExperimentRepetitions (Stats eval') -> reduce (Stats eval') <$!> genExpRes id eval'-    Sum OverExperimentRepetitions eval' -> reduce eval' <$!> genExpRes id (Id eval')+    Mean OverExperimentRepetitions (Stats eval')   -> reduce (Stats eval') <$!> genExpRes id eval'+    Mean OverExperimentRepetitions eval'           -> reduce eval' <$!> genExpRes id (Id eval')+    Sum OverExperimentRepetitions (Stats eval')    -> reduce (Stats eval') <$!> genExpRes id eval'+    Sum OverExperimentRepetitions eval'            -> reduce eval' <$!> genExpRes id (Id eval')     StdDev OverExperimentRepetitions (Stats eval') -> reduce (Stats eval') <$!> genExpRes id eval'-    StdDev OverExperimentRepetitions eval' -> reduce eval' <$!> genExpRes id (Id eval')+    StdDev OverExperimentRepetitions eval'         -> reduce eval' <$!> genExpRes id (Id eval')     -- Mean (OverBestXExperimentRepetitions nr cmp) eval' -> reduce eval' <$> genExpRes (take nr . sortBy (cmp `on` id)) (Id eval')     -- Sum (OverBestXExperimentRepetitions nr cmp) eval' -> reduce eval' <$> genExpRes (take nr . sortBy (cmp `on` id)) (Id eval')     -- StdDev (OverBestXExperimentRepetitions nr cmp) eval' -> reduce eval' <$> genExpRes (take nr . sortBy (cmp `on` id)) (Id eval')@@ -101,14 +105,14 @@ genExperimentResult _ (Named _ n) _ = error $ "An evaluation may only be named on the outermost function in evaluation " <> T.unpack (E.decodeUtf8 n) genExperimentResult _ (Name n _) _ = error $ "An evaluation may only be named on the outermost function in evaluation " <> T.unpack (E.decodeUtf8 n) genExperimentResult exp eval expRes =-    case eval of-      Mean OverReplications (Stats eval')   -> reduce <$!> genRepl eval'-      Mean OverReplications eval'           -> reduce <$!> genRepl (Id eval')-      StdDev OverReplications (Stats eval') -> reduce <$!> genRepl eval'-      StdDev OverReplications eval'         -> reduce <$!> genRepl (Id eval')-      Sum OverReplications (Stats eval')    -> reduce <$!> genRepl eval'-      Sum OverReplications eval'            -> reduce <$!> genRepl (Id eval')-      _                                     -> packGenRes <$!> genRepl eval+  case eval of+    Mean OverReplications (Stats eval')   -> reduce <$!> genRepl eval'+    Mean OverReplications eval'           -> reduce <$!> genRepl (Id eval')+    StdDev OverReplications (Stats eval') -> reduce <$!> genRepl eval'+    StdDev OverReplications eval'         -> reduce <$!> genRepl (Id eval')+    Sum OverReplications (Stats eval')    -> reduce <$!> genRepl eval'+    Sum OverReplications eval'            -> reduce <$!> genRepl (Id eval')+    _                                     -> packGenRes <$!> genRepl eval   where     packGenRes = EvalVector eval UnitReplications     -- genRepl e = mapMRnf (fmap force . genReplication exp e) (expRes ^. evaluationResults)@@ -122,7 +126,7 @@  genReplication :: (ExperimentDef a) => Experiment a -> StatsDef a -> Int -> ReplicationResult a -> DB (ExpM a) (EvalResults a) genReplication exp eval repNr repl =-  mkTime ("Experiment " <> show (exp ^. experimentNumber) <> " Repetition " <> show repNr <> " Replication" <> show (repl ^. replicationNumber)) $+  mkTime ("\tExperiment " <> show (exp ^. experimentNumber) <> " Repetition " <> show repNr <> " Replication" <> show (repl ^. replicationNumber)) $   fromMaybe (error "Evaluation data is incomplete!") <$!> sequence (genResultData exp eval <$!> (repl ^. evalResults))  

@@ -7,14 +7,15 @@ module Experimenter.Eval.Table where  import           Control.DeepSeq-import           Control.Monad         (forM_)+import           Control.Monad                (forM_) import           Control.Monad.Logger-import           Data.List             (foldl')-import qualified Data.Text             as T+import           Data.List                    (foldl')+import qualified Data.Text                    as T import           GHC.Generics  import           Text.LaTeX import           Text.LaTeX.Base.Class+import           Text.LaTeX.Packages.TabularX import           Text.Printf  data Table =@@ -47,14 +48,21 @@ dereferLatex :: T.Text -> T.Text dereferLatex = protectText . T.replace "{" "\\{" . T.replace "}" "\\}" . T.replace "_" "\\_" +printTextwidthTable :: (MonadLogger m) => Table -> LaTeXT m ()+printTextwidthTable = printTableTabularX True  printTable :: (MonadLogger m) => Table -> LaTeXT m ()-printTable tbl@Table{} = forM_ (splitTable tbl) printTable'+printTable = printTableTabularX False+++printTableTabularX :: (MonadLogger m) => Bool -> Table -> LaTeXT m ()+printTableTabularX tabX tbl@Table {} = forM_ (splitTable tbl) printTable'   where-    printTable' (Table headerInput rowsInput) =-      center $-      tabular Nothing (replicate colLen LeftColumn) $ hline <> printRow textbf header <> hline <> mconcat (map (printRow id) rows) <> hline+    printTable' (Table headerInput rowsInput)+      | tabX = center $ tabularx (CustomMeasure textwidth) Nothing (LeftColumn : replicate (cols - 1) (NameColumn "X")) content+      | otherwise = center $ tabular Nothing (replicate cols LeftColumn) content       where+        content = hline <> printRow textbf header <> hline <> mconcat (map (printRow id) rows) <> hline         printRow :: (LaTeXC l) => (l -> l) -> Row -> l         printRow _ (Row []) = mempty         printRow f (Row (c:cs)) = foldl' (&) (f $ printCell c) (map (f . printCell) cs) <> lnbk@@ -63,9 +71,9 @@         printCell (CellD nr)  = raw $ printDouble nr         printCell (CellL l)   = fromLaTeX l         printCell CellEmpty   = mempty-        colLen = maximum $ map cellCount (headerInput : rowsInput)+        cols = maximum $ map cellCount (headerInput : rowsInput)         cellCount (Row xs) = length xs-        extendRow (Row xs) = Row $ xs ++ replicate (colLen - length xs) CellEmpty+        extendRow (Row xs) = Row $ xs ++ replicate (cols - length xs) CellEmpty         header = extendRow headerInput         rows = map extendRow rowsInput