Merge branch 'main' into 382_fix_lbt07@main

.github/workflows/check.yaml

@@ -24,6 +24,10 @@ jobs:
     uses: insightsengineering/r.pkg.template/.github/workflows/build-check-install.yaml@main
     secrets:
       REPO_GITHUB_TOKEN: ${{ secrets.REPO_GITHUB_TOKEN }}
+    with:
+      additional-env-vars: |
+        _R_CHECK_CRAN_INCOMING_REMOTE_=false
+      additional-r-cmd-check-params: --as-cran
   coverage:
     if: github.event_name != 'push'
     name: Coverage 📔

.github/workflows/docs.yaml

@@ -33,7 +33,9 @@ on:
 
 jobs:
   docs:
-    name: Pkgdown Docs 📚 
+    name: Pkgdown Docs 📚
     uses: insightsengineering/r.pkg.template/.github/workflows/pkgdown.yaml@main
     secrets:
       REPO_GITHUB_TOKEN: ${{ secrets.REPO_GITHUB_TOKEN }}
+    with:
+      default-landing-page: latest-tag

.github/workflows/release.yaml

@@ -23,6 +23,8 @@ jobs:
     uses: insightsengineering/r.pkg.template/.github/workflows/pkgdown.yaml@main
     secrets:
       REPO_GITHUB_TOKEN: ${{ secrets.REPO_GITHUB_TOKEN }}
+    with:
+      default-landing-page: latest-tag
   validation:
     name: R Package Validation report 📃
     needs: release

DESCRIPTION

@@ -1,8 +1,8 @@
 Type: Package
 Package: chevron
 Title: Standard TLGs For Clinical Trials Reporting
-Version: 0.1.1.9035
-Date: 2023-02-08
+Version: 0.1.1.9037
+Date: 2023-02-15
 Authors@R: c(
     person("Benoit", "Falquet", , "[email protected]", role = c("aut", "cre")),
     person("Adrian", "Waddell", , "[email protected]", role = "aut"),
@@ -19,7 +19,7 @@ Imports:
     dm (>= 1.0),
     dplyr,
     dunlin (> 0.1.1),
-    forcats,
+    forcats (>= 1.0.0),
     formatters (> 0.3.4),
     ggplot2,
     magrittr,

NAMESPACE

@@ -43,6 +43,7 @@ export(aet04_1_lyt)
 export(aet04_1_main)
 export(aet04_1_post)
 export(aet04_1_pre)
+export(args_ls)
 export(chevron_g)
 export(chevron_l)
 export(chevron_t)
@@ -186,6 +187,8 @@ export(postprocess)
 export(preprocess)
 export(report_null)
 export(run)
+export(script_args)
+export(script_funs)
 export(std_deco)
 export(syn_data)
 export(syn_test_data)
@@ -213,6 +216,7 @@ exportMethods("datasets<-")
 exportMethods("main<-")
 exportMethods("postprocess<-")
 exportMethods("preprocess<-")
+exportMethods(args_ls)
 exportMethods(datasets)
 exportMethods(get_adam_datasets)
 exportMethods(get_main)
@@ -222,6 +226,8 @@ exportMethods(main)
 exportMethods(postprocess)
 exportMethods(preprocess)
 exportMethods(run)
+exportMethods(script_args)
+exportMethods(script_funs)
 import(dm)
 import(dplyr)
 import(methods)

NEWS.md

@@ -1,3 +1,3 @@
-# chevron 0.1.1.9035
+# chevron 0.1.1.9037
 
 * First release with implementation of: `AET01`, `AET02`, `AET03`, `AET04`, `CMT01A`, `CMT02_PT`, `DMT01`, `DST01`, `DTHT01`, `EGT01`, `EGT02`, `EXT01`, `LBT01`, `MHT01`, `MNG01`, `VST01`, `VST02`.

R/chevron_tlg-S4methods.R

@@ -8,32 +8,79 @@
 #'
 #' @inheritParams gen_args
 #' @param object (`chevron_tlg`) input.
-#' @param ... extra arguments to pass to the check, pre-processing or `tlg` functions.
+#' @param auto_pre (`flag`) whether to perform the default pre processing step.
+#' @param ... extra arguments to pass to the pre-processing, main and post-processing functions.
 #'
 #' @name run
 #' @export
-setGeneric("run", function(object, adam_db, ...) standardGeneric("run"))
+setGeneric("run", function(object, adam_db, auto_pre = TRUE, ...) standardGeneric("run"))
 
 #' Run the pipeline
 #' @rdname run
 #' @export
 #' @examples
-#' run(mng01_1, syn_data, dataset = "adlb")
+#' run(mng01_1, syn_data, auto_pre = TRUE, dataset = "adlb")
 setMethod(
   f = "run",
   signature = "chevron_tlg",
-  definition = function(object, adam_db, ...) {
+  definition = function(object, adam_db, auto_pre = TRUE, ...) {
     checkmate::assert_class(adam_db, "dm")
+    checkmate::assert_flag(auto_pre)
 
     optional_arg <- list(...)
 
-    proc_data <- list(adam_db = do.call(object@preprocess, c(list(adam_db), optional_arg)))
+    proc_data <- if (auto_pre) {
+      list(adam_db = do.call(object@preprocess, c(list(adam_db), optional_arg)))
+    } else {
+      list(adam_db = adam_db)
+    }
+
     res_tlg <- list(tlg = do.call(object@main, c(proc_data, optional_arg)))
 
     do.call(object@postprocess, c(res_tlg, optional_arg))
   }
 )
 
+# args_ls ----
+
+#' Get Arguments List
+#'
+#' @param x (`chevron_tlg`) input.
+#' @param simplify (`flag`) whether to simplify the output, coalescing the values of the parameters. The order of
+#'   priority for the value of the parameters is: `main`, `preprocess` and `postprocess`.
+#' @param omit (`character`) the names of the argument to omit from the output.
+#'
+#' @rdname args_ls
+#' @export
+setGeneric("args_ls", function(x, simplify = FALSE, omit = NULL) standardGeneric("args_ls"))
+
+#' @rdname args_ls
+#' @export
+setMethod(
+  f = "args_ls",
+  signature = "chevron_tlg",
+  definition = function(x, simplify = FALSE, omit = NULL) {
+    checkmate::assert_flag(simplify)
+    checkmate::assert_character(omit, null.ok = TRUE)
+
+    x_ls <- list(
+      main = formals(x@main),
+      preprocess = formals(x@preprocess),
+      postprocess = formals(x@postprocess)
+    )
+
+    x_sel <- lapply(x_ls, function(y) y[!names(y) %in% omit])
+
+    res <- if (simplify) {
+      Reduce(fuse_sequentially, x_sel)
+    } else {
+      x_sel
+    }
+
+    res
+  }
+)
+
 # main ----
 
 #' Main
@@ -207,6 +254,137 @@ setMethod(
   }
 )
 
+# script ----
+
+#' Create Script for Parameters Assignment
+#'
+#' @param x (`chevron_tlg`) input.
+#' @param dict (`list`) with the name and value of custom arguments.
+#' @param details (`flag`) whether to show the code of all function. By default, only the detail of the code of the
+#'   prepossessing step is printed.
+#'
+#' @name script
+#' @rdname script
+NULL
+
+#' @rdname script
+#' @export
+setGeneric("script_args", function(x, dict = NULL) standardGeneric("script_args"))
+
+#' @rdname script
+#' @export
+#'
+#' @examples
+#' script_args(aet04_1)
+#'
+setMethod(
+  f = "script_args",
+  signature = "chevron_tlg",
+  definition = function(x, dict = NULL) {
+    checkmate::assert_list(dict, null.ok = TRUE)
+
+    # Construct call for attribution of all arguments
+    simple_arg <- args_ls(x, omit = c("tlg", "..."), simplify = TRUE)
+    simple_arg <- fuse_sequentially(dict, simple_arg)
+    names_args <- names(simple_arg)
+    val_args <- unname(simple_arg)
+
+    res <- alist()
+    for (i in seq_along(simple_arg)) {
+      val <- val_args[[i]]
+      id <- names_args[[i]]
+
+      if (missing(val)) {
+        res[[id]] <- rlang::call2("stop", "enter dataset")
+      } else {
+        res[[id]] <- val
+      }
+    }
+
+    arg_calls <- mapply(function(x, y) rlang::call2("<-", sym(x), y), as.list(names(res)), res)
+
+    c(
+      "\n# Arguments definition ----\n",
+      unlist(lapply(arg_calls, deparse))
+    )
+  }
+)
+
+#' Create Script for `TLG` Generation
+#'
+#' @rdname script
+#' @export
+setGeneric("script_funs", function(x, details = FALSE) standardGeneric("script_funs"))
+
+#' @rdname script
+#' @export
+#'
+#' @examples
+#' script_funs(aet04_1)
+#'
+setMethod(
+  f = "script_funs",
+  signature = "chevron_tlg",
+  definition = function(x, details = FALSE) {
+    checkmate::assert_flag(details)
+
+    # Construct argument list for each function.
+    all_arg <- args_ls(x, omit = c("...", "tlg"), simplify = FALSE)
+
+    arg_pre <- lapply(names(all_arg$preprocess), sym)
+    names(arg_pre) <- arg_pre
+
+    arg_main <- lapply(names(all_arg$main), sym)
+    names(arg_main) <- arg_main
+    arg_main$adam_db <- sym("proc_data")
+
+    arg_post <- lapply(names(all_arg$post), sym)
+    names(arg_post) <- arg_post
+
+    # Construct the call for the main and post process function.
+    fun_def <- if (details) {
+      c(
+        deparse(rlang::call2("<-", sym("main_fun"), x@main)),
+        deparse(rlang::call2("<-", sym("postprocess_fun"), x@postprocess))
+      )
+    } else {
+      NULL
+    }
+
+    # Execute either the main and post function separately or together using `run`.
+    fun_exec <- if (details) {
+      arg_post$tlg <- sym("tlg")
+      c(
+        deparse(rlang::call2("<-", sym("tlg"), rlang::call2("main_fun", !!!arg_main))),
+        deparse(rlang::call2("<-", sym("final_tlg"), rlang::call2("postprocess_fun", !!!arg_post)))
+      )
+    } else {
+      main_post_arg <- fuse_sequentially(arg_main, arg_post)
+      deparse(
+        rlang::call2(
+          "<-",
+          sym("final_tlg"),
+          rlang::call2("run", substitute(x), auto_pre = FALSE, !!!main_post_arg)
+        )
+      )
+    }
+
+    # Generate the script.
+    spt <- c(
+      "\n# Functions definition ----\n",
+      deparse(rlang::call2("<-", sym("preprocess_fun"), x@preprocess)),
+      fun_def,
+      "\n# Functions execution ----\n",
+      deparse(rlang::call2("<-", sym("proc_data"), rlang::call2("preprocess_fun", !!!arg_pre))),
+      fun_exec
+    )
+
+    unlist(spt)
+  }
+)
+
+
+
 # get_main ----
 
 #' Retrieve Main Function

R/utils.R

@@ -103,7 +103,7 @@ syn_test_data <- function() {
   attr(sd$adsl$AAGE, "label") <- "Age (yr)"
   sd$adsl$AGEGR1 <- cut(sd$adsl$AGE, c(0, 65, 200), c("<65", ">=65"))
   attr(sd$adsl$AGEGR1, "label") <- "Age Group"
-  sd$adex$AVALCAT1 <- tern::explicit_na(factor(sd$adex$AVALCAT1), label = "<Missing>")
+  sd$adex$AVALCAT1 <- forcats::fct_na_value_to_level(sd$adex$AVALCAT1, level = "<Missing>") # nolint
 
   # useful for dmt01
   adsub <- sd$adsub
@@ -367,3 +367,21 @@ h_format_dec <- function(digits = NA, format = NA) {
     }
   }
 }
+
+#' Fuse list elements
+#'
+#' @param x (`list`) to fuse.
+#' @param y (`list`) to fuse. Elements with names already existing in `x` are discarded.
+#'
+#' @keywords internal
+#'
+fuse_sequentially <- function(x, y) {
+  if (missing(y)) {
+    return(x)
+  }
+
+  names_x <- names(x)
+  sel_names_y <- setdiff(names(y), names_x)
+
+  c(x, y[sel_names_y])
+}

_pkgdown.yaml

@@ -16,6 +16,7 @@ articles:
       - adam_db_argument
       - layouts
       - Adding_new_TLGs_to_Chevron
+      - Script_Generator
 
 reference:
   - title: Package Overview
@@ -28,11 +29,13 @@ reference:
 
   - title: Methods
     contents:
+      - args_ls
       - run
       - main
       - preprocess
       - postprocess
       - datasets
+      - script
       - get_main
       - get_preprocess
       - get_postprocess