refine templates

NAMESPACE

@@ -24,6 +24,7 @@ export(aet01_main)
 export(aet01_post)
 export(aet01_pre)
 export(aet02)
+export(aet02_label)
 export(aet02_main)
 export(aet02_post)
 export(aet02_pre)
@@ -57,6 +58,7 @@ export(cfbt01_pre)
 export(chevron_g)
 export(chevron_l)
 export(chevron_t)
+export(cmt01_label)
 export(cmt01a)
 export(cmt01a_main)
 export(cmt01a_post)
@@ -216,11 +218,11 @@ exportMethods(preprocess)
 exportMethods(run)
 exportMethods(script_args)
 exportMethods(script_funs)
+import(checkmate)
 import(dplyr)
 import(methods)
 import(rtables)
 import(tern)
-importFrom(checkmate,check_class)
 importFrom(dunlin,reformat)
 importFrom(dunlin,render_safe)
 importFrom(dunlin,rule)
@@ -240,7 +242,6 @@ importFrom(rlang,.env)
 importFrom(rlang,abort)
 importFrom(rlang,sym)
 importFrom(rlistings,as_listing)
-importFrom(rtables,drop_split_levels)
 importFrom(stats,median)
 importFrom(stats,quantile)
 importFrom(stats,reorder)

NEWS.md

@@ -1,5 +1,10 @@
 # chevron 0.2.1.9000
 
+* Allow `EGT03` to include multiple parameters.
+* Allow `KMG01` to include stratified variables.
+* Allow `LBT06` and `LBT14` split by page.
+* Allow `AET02`, `CMT01A` to change the summary statistics with `summary_labels` argument.
+
 # chevron 0.2.1
 
 * Placeholder strings are now replaced during layout creation using `dunlin::render_safe` function.

R/ael01_nollt.R

@@ -30,8 +30,8 @@ ael01_nollt_main <- function(adam_db,
                              ...) {
   assert_all_tablenames(adam_db, dataset)
   assert_valid_variable(adam_db[[dataset]], c(key_cols, disp_cols), label = paste0("adam_db$", dataset))
-  checkmate::assert_list(default_formatting)
-  checkmate::assert_list(col_formatting, null.ok = TRUE)
+  assert_list(default_formatting)
+  assert_list(col_formatting, null.ok = TRUE)
 
   as_listing(
     adam_db[[dataset]],

R/aet01.R

@@ -27,11 +27,11 @@ aet01_main <- function(adam_db,
                        anl_lbls = "Total number of {patient_label} with at least one",
                        ...) {
   assert_all_tablenames(adam_db, "adsl", "adae")
-  checkmate::assert_string(arm_var)
-  checkmate::assert_list(anl_vars, types = "character", names = "unique")
-  checkmate::assert_character(anl_lbls, min.chars = 1L)
+  assert_string(arm_var)
+  assert_list(anl_vars, types = "character", names = "unique")
+  assert_character(anl_lbls, min.chars = 1L)
   lbl_overall <- render_safe(lbl_overall)
-  checkmate::assert_string(lbl_overall, null.ok = TRUE)
+  assert_string(lbl_overall, null.ok = TRUE)
   assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
   assert_valid_variable(adam_db$adsl, c("DTHFL", "DCSREAS"), types = list(c("character", "factor")), min_chars = 0L)
   assert_valid_variable(adam_db$adae, c(arm_var), types = list(c("character", "factor")))

R/aet01_aesi.R

@@ -37,10 +37,10 @@ aet01_aesi_main <- function(adam_db,
                             lbl_overall = NULL,
                             ...) {
   assert_all_tablenames(adam_db, "adsl", "adae")
-  checkmate::assert_string(arm_var)
-  checkmate::assert_character(aesi_vars, null.ok = TRUE)
-  checkmate::assert_list(grade_groups, null.ok = TRUE)
-  checkmate::assert_string(lbl_overall, null.ok = TRUE)
+  assert_string(arm_var)
+  assert_character(aesi_vars, null.ok = TRUE)
+  assert_list(grade_groups, null.ok = TRUE)
+  assert_string(lbl_overall, null.ok = TRUE)
   assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var))
   assert_valid_variable(adam_db$adae, c(arm_var))
   assert_valid_variable(adam_db$adae, "USUBJID", empty_ok = TRUE)

R/aet02.R

@@ -1,8 +1,16 @@
 # aet02 ----
 
+#' @describeIn aet02 Default labels
+#' @export
+aet02_label <- c(
+  unique = "Total number of {patient_label} with at least one adverse event",
+  nonunique = "Total number of events"
+)
+
 #' @describeIn aet02 Main TLG function
 #'
 #' @inheritParams gen_args
+#' @param summary_labels (`list`) of summarize labels. See details.
 #'
 #' @details
 #'  * Numbers represent absolute numbers of subject and fraction of `N`, or absolute number of event when specified.
@@ -11,6 +19,8 @@
 #'  * Does not include a total column by default.
 #'  * Sort Dictionary-Derived Code (`AEDECOD`) by highest overall frequencies.
 #'  * Missing values in `AEBODSYS`, and `AEDECOD` are labeled by `No Coding Available`.
+#'  `summary_labels` is used to control the summary for each level. If "all" is used, then each split will have that
+#'  summary statistic with the labels. One special case is "TOTAL", this is for the overall population.
 #'
 #' @note
 #'  * `adam_db` object must contain an `adae` table with the columns `"AEBODSYS"` and `"AEDECOD"`.
@@ -22,74 +32,52 @@ aet02_main <- function(adam_db,
                        arm_var = "ACTARM",
                        row_split_var = "AEBODSYS",
                        lbl_overall = NULL,
+                       summary_labels = list(
+                         all = aet02_label,
+                         TOTAL = c(nonunique = "Overall total number of events")
+                       ),
                        ...) {
   assert_all_tablenames(adam_db, "adsl", "adae")
-  checkmate::assert_character(row_split_var, null.ok = TRUE)
-  checkmate::assert_string(lbl_overall, null.ok = TRUE)
-  checkmate::assert_string(arm_var)
+  assert_character(row_split_var, null.ok = TRUE)
+  assert_string(lbl_overall, null.ok = TRUE)
+  assert_string(arm_var)
   assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
   assert_valid_variable(adam_db$adae, c(arm_var, row_split_var, "AEDECOD"), types = list(c("character", "factor")))
   assert_valid_variable(adam_db$adae, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))
   assert_valid_var_pair(adam_db$adsl, adam_db$adae, arm_var)
-
+  assert_list(summary_labels, null.ok = TRUE)
+  assert_subset(names(summary_labels), c("all", "TOTAL", row_split_var))
+  assert_subset(
+    unique(unlist(lapply(summary_labels, names))),
+    c("unique", "nonunique", "unique_count")
+  )
+  if ("all" %in% names(summary_labels)) {
+    summary_labels <- lapply(
+      c(TOTAL = "TOTAL", setNames(row_split_var, row_split_var)),
+      function(x) {
+        modify_character(summary_labels$all, summary_labels[[x]])
+      }
+    )
+  }
   lbl_row_split <- var_labels_for(adam_db$adae, row_split_var)
   lbl_aedecod <- var_labels_for(adam_db$adae, "AEDECOD")
   lbl_overall <- render_safe(lbl_overall)
-  lyt <- aet02_lyt(
+  lyt <- occurrence_lyt(
     arm_var = arm_var,
     lbl_overall = lbl_overall,
     row_split_var = row_split_var,
     lbl_row_split = lbl_row_split,
-    lbl_aedecod = lbl_aedecod
+    medname_var = "AEDECOD",
+    lbl_medname_var = lbl_aedecod,
+    summary_labels = summary_labels,
+    count_by = NULL
   )
 
   tbl <- build_table(lyt, adam_db$adae, alt_counts_df = adam_db$adsl)
 
   tbl
 }
 
-#' `aet02` Layout
-#'
-#' @inheritParams aet02_main
-#' @param lbl_row_split (`character`) label for `row_split_var`.
-#' @param lbl_aedecod (`string`) text label for `AEDECOD`.
-#'
-#' @keywords internal
-#'
-aet02_lyt <- function(arm_var,
-                      lbl_overall,
-                      row_split_var,
-                      lbl_row_split,
-                      lbl_aedecod) {
-  lyt <- basic_table(show_colcounts = TRUE) %>%
-    split_cols_by(var = arm_var) %>%
-    ifneeded_add_overall_col(lbl_overall) %>%
-    analyze_num_patients(
-      vars = "USUBJID",
-      .stats = c("unique", "nonunique"),
-      show_labels = "hidden",
-      .labels = c(
-        unique = render_safe("Total number of {patient_label} with at least one adverse event"),
-        nonunique = "Overall total number of events"
-      )
-    )
-  for (k in seq_len(length(row_split_var))) {
-    lyt <- split_and_summ_num_patients(lyt, row_split_var[k], lbl_row_split[k],
-      stats = c("unique", "nonunique"),
-      summarize_labels = render_safe(
-        c("Total number of {patient_label} with at least one adverse event", "Total number of events")
-      )
-    )
-  }
-  lyt %>%
-    count_occurrences(
-      vars = "AEDECOD",
-      drop = length(row_split_var) > 0,
-      .indent_mods = -1L
-    ) %>%
-    append_topleft(paste0(stringr::str_dup(" ", 2 * length(row_split_var)), lbl_aedecod))
-}
-
 #' @describeIn aet02 Preprocessing
 #'
 #' @inheritParams gen_args

R/aet03.R

@@ -22,8 +22,8 @@ aet03_main <- function(adam_db,
                        lbl_overall = NULL,
                        ...) {
   assert_all_tablenames(adam_db, "adsl", "adae")
-  checkmate::assert_string(lbl_overall, null.ok = TRUE)
-  checkmate::assert_string(arm_var)
+  assert_string(lbl_overall, null.ok = TRUE)
+  assert_string(arm_var)
   assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
   assert_valid_variable(adam_db$adae, c(arm_var, "AEBODSYS", "AEDECOD", "ASEV"), types = list(c("character", "factor")))
   assert_valid_variable(adam_db$adae, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))

R/aet04.R

@@ -25,8 +25,8 @@ aet04_main <- function(adam_db,
                        grade_groups = NULL,
                        ...) {
   assert_all_tablenames(adam_db, "adsl", "adae")
-  checkmate::assert_string(lbl_overall, null.ok = TRUE)
-  checkmate::assert_string(arm_var)
+  assert_string(lbl_overall, null.ok = TRUE)
+  assert_string(arm_var)
   assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
   assert_valid_variable(adam_db$adae, c(arm_var, "AEBODSYS", "AEDECOD"), types = list(c("character", "factor")))
   assert_valid_variable(adam_db$adae, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))
@@ -36,7 +36,7 @@ aet04_main <- function(adam_db,
   lbl_aebodsys <- var_labels_for(adam_db$adae, "AEBODSYS")
   lbl_aedecod <- var_labels_for(adam_db$adae, "AEDECOD")
   lbl_overall <- render_safe(lbl_overall)
-  checkmate::assert_list(grade_groups, types = "character", null.ok = TRUE)
+  assert_list(grade_groups, types = "character", null.ok = TRUE)
   if (is.null(grade_groups)) {
     grade_groups <- list(
       "Grade 1-2" = c("1", "2"),

R/aet05.R

@@ -25,7 +25,7 @@ aet05_main <- function(adam_db,
                        arm_var = "ACTARM",
                        ...) {
   assert_all_tablenames(adam_db, c("adsl", "adaette"))
-  checkmate::assert_string(arm_var)
+  assert_string(arm_var)
   assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
   assert_valid_variable(adam_db$adaette, c("USUBJID", arm_var, "PARAMCD", "PARAM"),
     types = list(c("character", "factor"))

R/aet10.R

@@ -22,8 +22,8 @@ aet10_main <- function(adam_db,
                        lbl_overall = NULL,
                        ...) {
   assert_all_tablenames(adam_db, "adsl", "adae")
-  checkmate::assert_string(lbl_overall, null.ok = TRUE)
-  checkmate::assert_string(arm_var)
+  assert_string(lbl_overall, null.ok = TRUE)
+  assert_string(arm_var)
   assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
   assert_valid_variable(adam_db$adae, c(arm_var, "AEBODSYS", "AEDECOD"), types = list(c("character", "factor")))
   assert_valid_variable(adam_db$adae, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))
@@ -82,7 +82,7 @@ aet10_pre <- function(adam_db, ...) {
 #' @export
 #'
 aet10_post <- function(tlg, atleast = 0.05, ...) {
-  checkmate::assert_number(atleast, lower = 0, upper = 1)
+  assert_number(atleast, lower = 0, upper = 1)
   tbl_sorted <- tlg %>%
     sort_at_path(
       path = c("AEDECOD"),
@@ -114,7 +114,6 @@ aet10_post <- function(tlg, atleast = 0.05, ...) {
 #' run(aet10, syn_data)
 aet10 <- chevron_t(
   main = aet10_main,
-  lyt = aet10_lyt,
   preprocess = aet10_pre,
   postprocess = aet10_post
 )

R/assertions.R

@@ -20,9 +20,9 @@
 #' assert_all_tablenames(lsd, c("mtcars", "iris", "x"), qualifier = "first test:")
 #' }
 assert_all_tablenames <- function(db, tab, null_ok = TRUE, qualifier = NULL) {
-  checkmate::assert_list(db, types = "data.frame", names = "unique")
-  checkmate::assert_character(tab, null.ok = null_ok)
-  checkmate::assert_string(qualifier, null.ok = TRUE)
+  assert_list(db, types = "data.frame", names = "unique")
+  assert_character(tab, null.ok = null_ok)
+  assert_string(qualifier, null.ok = TRUE)
 
   diff <- setdiff(tab, names(db))
 
@@ -57,9 +57,9 @@ assert_all_tablenames <- function(db, tab, null_ok = TRUE, qualifier = NULL) {
 #' assert_one_tablenames(lsd, c("mtcars", "x", "y"), qualifier = "first test:")
 #' }
 assert_one_tablenames <- function(db, tab, null_ok = TRUE, qualifier = NULL) {
-  checkmate::assert_list(db, types = "data.frame", names = "unique")
-  checkmate::assert_character(tab, null.ok = null_ok)
-  checkmate::assert_string(qualifier, null.ok = TRUE)
+  assert_list(db, types = "data.frame", names = "unique")
+  assert_character(tab, null.ok = null_ok)
+  assert_string(qualifier, null.ok = TRUE)
 
   diff <- setdiff(tab, names(db))
 
@@ -115,7 +115,7 @@ assert_valid_var.character <- function(
     x, label = deparse(substitute(x)),
     na_ok = FALSE, empty_ok = FALSE,
     min_chars = 1L, ...) {
-  checkmate::assert_character(
+  assert_character(
     x,
     min.chars = min_chars,
     min.len = as.integer(!empty_ok),
@@ -131,12 +131,12 @@ assert_valid_var.factor <- function(
     x, label = deparse(substitute(x)),
     na_ok = FALSE, empty_ok = FALSE,
     min_chars = 1L, ...) {
-  checkmate::assert_character(
+  assert_character(
     levels(x),
     min.chars = min_chars,
     .var.name = paste("level of", label)
   )
-  checkmate::assert_factor(
+  assert_factor(
     x,
     min.levels = as.integer(!empty_ok),
     any.missing = na_ok,
@@ -148,7 +148,7 @@ assert_valid_var.factor <- function(
 #' @rdname assert_valid_var
 #' @export
 assert_valid_var.logical <- function(x, label = deparse(substitute(x)), na_ok = TRUE, empty_ok = FALSE, ...) {
-  checkmate::assert_logical(
+  assert_logical(
     x,
     min.len = as.integer(!empty_ok),
     any.missing = na_ok,
@@ -162,7 +162,7 @@ assert_valid_var.logical <- function(x, label = deparse(substitute(x)), na_ok =
 assert_valid_var.numeric <- function(
     x, label = deparse(substitute(x)),
     na_ok = TRUE, empty_ok = FALSE, integerish = FALSE, ...) {
-  check_fun <- if (integerish) checkmate::assert_integerish else checkmate::assert_numeric
+  check_fun <- if (integerish) assert_integerish else assert_numeric
   check_fun(
     x,
     min.len = as.integer(!empty_ok),
@@ -189,7 +189,7 @@ assert_valid_var.default <- function(x, label = deparse(substitute(x)), na_ok =
 #'
 #' @export
 assert_valid_variable <- function(df, vars, label = deparse(substitute(df)), types = NULL, ...) {
-  checkmate::assert_names(colnames(df), must.include = vars, what = "colnames")
+  assert_names(colnames(df), must.include = vars, what = "colnames")
 
   labels <- sprintf("%s$%s", label, vars)
   if (length(types) == 1 && is.null(names(types))) {
@@ -204,9 +204,9 @@ assert_valid_variable <- function(df, vars, label = deparse(substitute(df)), typ
       label = labels[vars_to_check]
     )
   }
-  collection <- checkmate::makeAssertCollection()
+  collection <- makeAssertCollection()
   mapply(assert_valid_var, df[vars], labels, MoreArgs = list(..., add = collection), SIMPLIFY = FALSE)
-  checkmate::reportAssertions(collection)
+  reportAssertions(collection)
 }
 
 # assert_valid_type ----
@@ -236,9 +236,9 @@ assert_valid_type <- function(x, types, label = deparse(substitute(x))) {
 #' @param lab1 (`string`) label hint for `df1`.
 #' @param lab2 (`string`) label hint for `df2`.
 assert_valid_var_pair <- function(df1, df2, var, lab1 = deparse(substitute(df1)), lab2 = deparse(substitute(df2))) {
-  checkmate::assert_data_frame(df1)
-  checkmate::assert_data_frame(df2)
-  checkmate::assert_string(var)
+  assert_data_frame(df1)
+  assert_data_frame(df2)
+  assert_string(var)
   lvl_x <- lvls(df1[[var]])
   lvl_y <- lvls(df2[[var]])
   if (!identical(lvl_x, lvl_y)) {