Readable code poc@main (#778)

POC for readable code.

the `unwrap` arguments in run allow the display of the function of the
`chevron_tlg` object.

sibling PR in dunlin:
insightsengineering/dunlin#162

thank you for the review

---------

Signed-off-by: b_falquet <[email protected]>

DESCRIPTION

@@ -133,6 +133,7 @@ Collate:
     'rtables_utils.R'
     'standard_rules.R'
     'ttet01.R'
+    'unwrap.R'
     'vst01.R'
     'vst02.R'
     'zzz.R'

NAMESPACE

@@ -128,6 +128,7 @@ export(fstg01_pre)
 export(fstg02)
 export(fstg02_main)
 export(fstg02_pre)
+export(get_arg)
 export(get_grade_rule)
 export(get_section_div)
 export(gg_list)
@@ -217,6 +218,7 @@ export(ttet01)
 export(ttet01_main)
 export(ttet01_post)
 export(ttet01_pre)
+export(unwrap_layout)
 export(var_labels_for)
 export(vst01)
 export(vst01_main)
@@ -249,6 +251,7 @@ import(methods)
 import(rtables)
 import(tern)
 importFrom(dunlin,assert_all_tablenames)
+importFrom(dunlin,get_arg)
 importFrom(dunlin,reformat)
 importFrom(dunlin,render_safe)
 importFrom(dunlin,rule)

NEWS.md

@@ -1,5 +1,8 @@
 # chevron 0.2.7.9002
 
+* New `unwrap` argument prints `preprocessing`, `main`, `postprocessing` and `layout` function upon execution of the `run` method.
+* The `chevron.run.verbose` option and `R_CHEVRON_RUN_VERBOSE` environment variable control the `verbose` argument of the `run` method, while the `chevron.run.unwrap` option and `R_CHEVRON_RUN_UNWRAP` environment variable control the `unwrap` argument.
+
 # chevron 0.2.7
 
 * Add the `AEL02`, `AEL03` and `CML02A_gl` templates.

R/chevron_tlg-S4methods.R

@@ -2,14 +2,26 @@
 
 # run ----
 
-#' Run the pipeline
+#' Run the TLG-generating pipeline
 #'
-#' Execute the pre-processing, main and post-processing functions in a single run.
+#' Execute sequential the pre-processing, main and post-processing functions.
+#'
+#' @details
+#' The functions stored in the `preprocess`, `main` and `postprocess` slots of the `chevron_tlg` objects are called
+#' respectively, `preprocessing`, `main` and `postprocessing` functions.
+#'
+#' When executing the `run` method on a `chevron_tlg` object, if `auto_pre` is `TRUE`, the `adam_bd` list is first
+#' passed to the `preprocessing` function. The resulting list is then passed to the `main` function which produces a
+#' table, graph or listings or a list of these objects. This output is then passed to the `postprocessing` function
+#' which performed the final modifications before returning the output. Additional arguments specified in `...` or
+#' `user_args` are passed to each of the three functions.
 #'
 #' @inheritParams gen_args
 #' @param object (`chevron_tlg`) input.
 #' @param auto_pre (`flag`) whether to perform the default pre processing step.
 #' @param verbose (`flag`) whether to print argument information.
+#' @param unwrap (`flag`)  whether to print the preprocessing postprocessing and main function together with the
+#'   associated layout function.
 #' @param ... extra arguments to pass to the pre-processing, main and post-processing functions.
 #' @param user_args (`list`) arguments from `...`.
 #' @returns an `rtables` (for `chevron_t`), `rlistings` (for `chevron_l`), `grob` (for `chevron_g`) or `ElementaryTable`
@@ -19,21 +31,32 @@
 #' @export
 setGeneric(
   "run",
-  function(object, adam_db, auto_pre = TRUE, verbose = FALSE, ..., user_args = list(...)) standardGeneric("run")
+  function(object, adam_db, auto_pre = TRUE, verbose = FALSE, unwrap = FALSE, ..., user_args = list(...)) {
+    standardGeneric("run")
+  }
 )
 
-#' Run the pipeline
+#' Run the TLG-generating pipeline
 #' @rdname run
 #' @export
 #' @examples
 #' run(mng01, syn_data, auto_pre = TRUE, dataset = "adlb")
 setMethod(
   f = "run",
   signature = "chevron_tlg",
-  definition = function(object, adam_db, auto_pre = TRUE, verbose = FALSE, ..., user_args = list(...)) {
+  definition = function(object,
+                        adam_db,
+                        auto_pre = TRUE,
+                        verbose = get_arg("chevron.run.verbose", "R_CHEVRON_RUN_VERBOSE", FALSE),
+                        unwrap = get_arg("chevron.run.unwrap", "R_CHEVRON_RUN_UNWRAP", verbose),
+                        ...,
+                        user_args = list(...)) {
     assert_list(adam_db, types = "data.frame", names = "unique")
     assert_flag(auto_pre)
+    verbose <- as.logical(verbose)
     assert_flag(verbose)
+    unwrap <- as.logical(unwrap)
+    assert_flag(unwrap)
     assert_list(user_args, names = "unique")
     args <- list(...)
     assert_list(args, names = "unique", .var.name = "...")
@@ -49,6 +72,25 @@ setMethod(
         auto_pre = auto_pre
       )
     }
+
+    if (unwrap) {
+      if (auto_pre) {
+        cat("Preprocessing function:\n")
+        cat(paste(deparse(preprocess(object)), collapse = "\n"), "\n")
+        cat("\n")
+      }
+
+      cat("Main function:\n")
+      cat(paste(deparse(main(object)), collapse = "\n"), "\n")
+      cat("\n")
+
+      # Show layout function from main if it exists.
+      unwrap_layout(main(object))
+
+      cat("Postprocessing function:\n")
+      cat(paste(deparse(postprocess(object)), collapse = "\n"), "\n")
+    }
+
     proc_data <- if (auto_pre) {
       list(adam_db = do_call(object@preprocess, c(list(adam_db), user_args)))
     } else {
@@ -71,7 +113,7 @@ print_args <- function(run_call, additional_args, args, auto_pre = TRUE) {
   run_call[[1]] <- NULL
   run_call <- as.list(run_call)
 
-  run_call[c("auto_pre", "verbose", "user_args")] <- NULL
+  run_call[c("auto_pre", "verbose", "user_args", "unwrap")] <- NULL
   if (!is.null(additional_args)) {
     run_call <- c(run_call, additional_args)
   }

R/mng01.R

@@ -164,6 +164,9 @@ mng01_main <- function(adam_db,
 #' @export
 #'
 mng01_pre <- function(adam_db, dataset, x_var = "AVISIT", ...) {
+  assert_character(dataset)
+  dunlin::assert_all_tablenames(adam_db, dataset)
+
   adam_db[[dataset]] <- adam_db[[dataset]] %>%
     filter(.data$ANL01FL == "Y") %>%
     mutate(

R/package.R

@@ -6,7 +6,7 @@
 #' @import tern
 #' @import checkmate
 #' @importFrom formatters with_label propose_column_widths fmt_config
-#' @importFrom dunlin rule reformat render_safe assert_all_tablenames
+#' @importFrom dunlin rule reformat render_safe assert_all_tablenames get_arg
 #' @importFrom forcats fct_relevel
 #' @importFrom ggplot2 theme
 #' @importFrom grid stringWidth unit

R/reexports.R

@@ -2,3 +2,5 @@
 formatters::with_label
 #' @export
 dunlin::reformat
+#' @export
+dunlin::get_arg

R/unwrap.R

@@ -0,0 +1,72 @@
+#' Helper Function Extracting Layout Functions
+#' @keywords internal
+#'
+h_unwrap_layout <- function(x, pattern) {
+  assert_string(pattern)
+
+  # If x is a list or a call, apply the function on each element
+  if (inherits(x, c("list", "call", "<-", "if"))) {
+    lapply(x, \(x) h_unwrap_layout(x, pattern))
+  } else if (is(x, "name")) {
+    # Return if name match pattern.
+
+    if (grepl(pattern, x)) {
+      res <- list(x)
+      names(res) <- as.character(x)
+      res
+    } else {
+      NULL
+    }
+  } else {
+    NULL
+  }
+}
+
+#' Extracting Layout Function.
+#'
+#' @param x (`function`) containing a call to a layout function.
+#' @param pattern (`string`) identifying layout functions
+#'
+#' @returns invisible `NULL` and print the content of the layout functions found in the body of `x`.
+#'
+#' @export
+#' @keywords internal
+#' @examples
+#' unwrap_layout(aet01_main)
+#'
+unwrap_layout <- function(x, pattern = "_lyt$") {
+  checkmate::assert_function(x)
+  checkmate::assert_string(pattern)
+
+  # Identify environment of the parent function.
+  env_x <- tryCatch(
+    rlang::get_env(x),
+    error = function(e) NULL
+  )
+
+  # Get the associated layout functions as name objects
+  res <- unlist(h_unwrap_layout(body(x)[-1], pattern))
+
+  if (length(res) > 0L) {
+    cat("Layout function:")
+    purrr::lmap(
+      res,
+      function(x) {
+        # Evaluate layout function symbol in the environment of the parent function.
+        tryCatch(
+          {
+            cat("\n")
+            layout_code <- paste(deparse(eval(x[[1]], envir = env_x)), collapse = "\n")
+            cat(sprintf("  %s:\n", names(x)))
+            cat(layout_code)
+          },
+          error = function(e) cat("\n  Unable to print layout function!")
+        )
+
+        list()
+      }
+    )
+  }
+  cat("\n")
+  invisible(NULL)
+}