diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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. diff --git a/experimenter.cabal b/experimenter.cabal --- a/experimenter.cabal +++ b/experimenter.cabal @@ -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 category: Experiment diff --git a/src/Experimenter/Eval/Latex.hs b/src/Experimenter/Eval/Latex.hs --- a/src/Experimenter/Eval/Latex.hs +++ b/src/Experimenter/Eval/Latex.hs @@ -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 diff --git a/src/Experimenter/Eval/Ops.hs b/src/Experimenter/Eval/Ops.hs --- a/src/Experimenter/Eval/Ops.hs +++ b/src/Experimenter/Eval/Ops.hs @@ -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)) diff --git a/src/Experimenter/Eval/Table.hs b/src/Experimenter/Eval/Table.hs --- a/src/Experimenter/Eval/Table.hs +++ b/src/Experimenter/Eval/Table.hs @@ -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