221 new ard ard for tables 32 and 33

DESCRIPTION

@@ -32,7 +32,8 @@ Imports:
     rtables (>= 0.6.9),
     tfrmt (>= 0.1.1),
     tidyr (>= 0.8.3),
-    Tplyr (>= 1.2.1)
+    Tplyr (>= 1.2.1),
+    admiraldev (>= 1.1.0)
 Suggests:
     knitr (>= 1.42),
     random.cdisc.data (>= 0.3.15),

NAMESPACE

@@ -31,15 +31,17 @@ export(make_table_20)
 export(make_table_21)
 export(make_table_22)
 export(make_table_32)
-export(make_table_32_gtsum)
+export(make_table_32_rtables)
 export(make_table_33)
-export(make_table_33_gtsum)
+export(make_table_33_rtables)
 export(make_table_34)
 export(make_table_35)
 export(make_table_36)
 export(make_table_38)
 export(split_cols_by_arm)
 import(Tplyr)
+import(cards)
+import(cardx)
 import(checkmate)
 import(dplyr)
 import(ggplot2)
@@ -48,6 +50,7 @@ import(gtsummary)
 import(rtables)
 import(tern)
 import(tfrmt)
+importFrom(admiraldev,assert_filter_cond)
 importFrom(cowplot,get_legend)
 importFrom(cowplot,plot_grid)
 importFrom(formatters,var_labels)

R/argument_convention.R

@@ -38,6 +38,8 @@
 #' @param annotations (named `list` of `character`)\cr list of annotations to add to the table. Valid
 #'   annotation types are `title`, `subtitles`, `main_footer`, and `prov_footer`. Each name-value pair should
 #'   use the annotation type as name and the desired string as value.
+#' @param ard (`cards::card`)\cr an ARD.
+#' @param denominator (`data.frame`)\cr alternative dataset (typically ADSL) used only to calculate denominator counts.
 #' @param df (`data.frame`)\cr dataset required to build table.
 #' @param eosdy_var (`character`)\cr variable denoting last recorded (relative) study day.
 #' @param fmqsc_var (`character`)\cr FMQ scope variable to use in table.
@@ -54,6 +56,7 @@
 #'   in the table. Labels should be ordered according to the order of variables in `vars`.
 #' @param na_level (`character`)\cr string to represent missing values.
 #' @param na_rm (`flag`)\cr whether `NA` levels should be removed from the table.
+#' @param return_ard (`flag`)\cr whether an ARD should be returned. Defaults to `TRUE`.
 #' @param risk_diff (named `list`)\cr list of settings to apply to add one or more risk difference columns to the table.
 #'   Defaults to `NULL` (no risk difference column added). See [tern::add_riskdiff()] for more details. List should
 #'   contain the following elements:
@@ -66,6 +69,8 @@
 #'    * `pct`: (optional) whether the output should be returned as percentages. Defaults to `TRUE`.
 #' @param saffl_var (`character`)\cr flag variable used to indicate inclusion in safety population.
 #' @param sex_scope (`character`)\cr Level of `SEX` to output in table.
+#' @param table_engine (`string`)\cr table engine used to generate the table. If `NULL`, no table is returned. If the
+#'   given engine is not available for the table, no table is created and a warning is returned.
 #' @param trtedtm_var (`character`)\cr treatment end datetime variable.
 #' @param trtemfl_var (`character`)\cr flag variable used to identify Treatment-emergent AE.
 #' @param trtsdtm_var (`character`)\cr treatment start datetime variable.

R/cardinal.R

@@ -5,7 +5,7 @@
 #' @keywords internal
 "_PACKAGE"
 
-#' @import dplyr ggplot2 checkmate gt gtsummary rtables tern tfrmt Tplyr
+#' @import dplyr ggplot2 cards cardx checkmate gt gtsummary rtables tern tfrmt Tplyr
 #' @importFrom rlang .data :=
 #' @importFrom magrittr %>%
 #' @importFrom purrr walk
@@ -14,6 +14,7 @@
 #' @importFrom formatters with_label var_labels var_relabel
 #' @importFrom rlistings as_listing
 #' @importFrom cowplot plot_grid get_legend
+#' @importFrom admiraldev assert_filter_cond
 NULL
 
 # Fix R CMD check warning for missing global definitions
@@ -24,5 +25,6 @@ utils::globalVariables(c(
   "ITTFL", "PPROTFL", "RANDFL", "TRTEMFL", "TRTSDT", "USUBJID", "column", "median", "ord_layer_1", "ord_layer_2",
   "ord_layer_index", "param", "pct", "row_label1", "row_label2", "sd", "tbl_lbl", "value", "ENRLDT", "RANDDT",
   "G110", "G60", "G90", "GE120", "L60", "N", "val", "id_var", "PT_PCT", "arm", "x", "TLSTFU", "se", "lower_ci",
-  "upper_ci", "SBP90", "DBP60", "STATUS"
+  "upper_ci", "SBP90", "DBP60", "STATUS", "D_ANY", "D_LT1", "D_GT1", "D_GT3", "D_GT6", "D_GT12",
+  "MIN_DIABP", "MIN_SYSBP"
 ))

R/fda-table_32.R

@@ -2,169 +2,190 @@
 #'   Postbaseline, Safety Population, Pooled Analysis
 #'
 #' @details
-#' * `advs` must contain `AVISITN`, `PARAMCD`, `AVAL`, `AVALU`, and the variables specified by
-#'   `arm_var`, `id_var`, and `saffl_var`.
-#' * If specified, `alt_counts_df` must contain the variables specified by `arm_var`, `id_var`, and `saffl_var`.
-#' * Flag variables (i.e. `XXXFL`) are expected to have two levels: `"Y"` (true) and `"N"` (false). Missing values in
-#'   flag variables are treated as `"N"`.
-#' * Columns are split by arm. Overall population column is excluded by default (see `lbl_overall` argument).
-#' * Numbers in table represent the absolute numbers of patients and fraction of `N`.
-#' * All-zero rows are not removed by default (see `prune_0` argument).
+#' * `df` must contain `PARAMCD`, `AVAL`, `AVALU`, and the variables specified by `saffl_var`, `arm_var`, and `id_var`.
+#'   `saffl_var` must be a flag variable.
+#' * `return_ard` set to `TRUE` or `FALSE`; whether the intermediate ARD object should be returned.
 #'
 #' @inheritParams argument_convention
+#' @param subset (`string`)\cr selection of both PARAMCD and definition of baseline.
 #'
-#' @name make_table_32
-NULL
-
-#' @describeIn make_table_32 Create FDA table 32 using functions from `rtables` and `tern`.
+#' @return A `gtsummary` table and, if `return_ard = TRUE`, an ARD.
+#'   If `return_ard = TRUE`, they will be returned as a list with named elements `table` and `ard`.
+#'
+#' @seealso [`tbl_make_table_32`]
 #'
-#' @return
-#' * `make_table_32` returns an `rtables` table object.
 #' @examples
 #' adsl <- random.cdisc.data::cadsl
 #' advs <- random.cdisc.data::cadvs
 #'
-#' tbl <- make_table_32(advs = advs, alt_counts_df = adsl)
+#' tbl <- make_table_32(df = advs, denominator = adsl)
 #' tbl
 #'
 #' @export
-make_table_32 <- function(advs,
-                          alt_counts_df = NULL,
-                          show_colcounts = TRUE,
+make_table_32 <- function(df,
+                          denominator = NULL,
+                          return_ard = TRUE,
                           id_var = "USUBJID",
                           arm_var = "ARM",
                           saffl_var = "SAFFL",
                           lbl_overall = NULL,
-                          risk_diff = NULL,
-                          prune_0 = FALSE,
-                          annotations = NULL) {
-  assert_subset(c(
-    "AVISITN", "PARAMCD", "AVAL", "AVALU", arm_var, id_var, saffl_var
-  ), names(advs))
-  assert_flag_variables(advs, saffl_var)
-
-  advs <- advs %>%
-    filter(
-      .data[[saffl_var]] == "Y",
-      AVISITN >= 1,
-      PARAMCD == "DIABP"
-    ) %>%
-    df_explicit_na() %>%
-    group_by(.data[[id_var]], PARAMCD) %>%
-    mutate(MAX_DIABP = max(AVAL)) %>%
-    ungroup() %>%
-    mutate(
-      L60 = with_label(MAX_DIABP < 60, "<60"),
-      G60 = with_label(MAX_DIABP > 60, ">60"),
-      G90 = with_label(MAX_DIABP > 90, ">90"),
-      G110 = with_label(MAX_DIABP > 110, ">110"),
-      GE120 = with_label(MAX_DIABP >= 120, ">=120")
-    )
+                          subset = NULL) {
+  if (is.null(subset)) {
+    subset <- as.character(formals(preproc_df_table_32)$subset)
+  }
+  df <- preproc_df_table_32(df, denominator, id_var, arm_var, saffl_var, subset)
+  avalu <- unique(df$AVALU)[1]
 
-  alt_counts_df <- alt_counts_df_preproc(alt_counts_df, id_var, arm_var, saffl_var)
+  df <- df %>% select(-id_var, -AVALU)
 
-  lyt <- basic_table_annot(show_colcounts, annotations) %>%
-    split_cols_by_arm(arm_var, lbl_overall, risk_diff) %>%
-    count_patients_with_flags(
-      var = id_var,
-      flag_variables = c("L60", "G60", "G90", "G110", "GE120"),
-      riskdiff = !is.null(risk_diff)
+  tbl_gts <- df %>%
+    tbl_summary(
+      by = arm_var,
+      statistic = list(all_categorical() ~ "{n} ({p}%)"),
+      digits = list(all_continuous() ~ c(0, 1), all_categorical() ~ c(0, 1)),
+      missing = "no"
     ) %>%
-    append_topleft(c("Diastolic Blood Pressure", paste0("(", unique(advs$AVALU)[1], ")")))
+    modify_header(label ~ paste0("**Diastolic Blood Pressure (", avalu, ")**")) %>%
+    modify_header(all_stat_cols() ~ "**{level}**  \nN = {n}") %>%
+    gtsummary::modify_column_alignment(columns = all_stat_cols(), align = "right")
 
-  tbl <- build_table(lyt, df = advs, alt_counts_df = alt_counts_df)
-  if (prune_0) tbl <- prune_table(tbl)
+  if (!is.null(lbl_overall)) {
+    tbl_gts <- tbl_gts %>%
+      add_overall(last = TRUE, col_label = paste0("**", lbl_overall, "**  \n N = {n}"))
+  }
 
-  tbl
+  tbl <- gtsummary::with_gtsummary_theme(
+    x = gtsummary::theme_gtsummary_compact(),
+    expr = as_gt(tbl_gts)
+  )
+
+  if (return_ard) {
+    ard <- gtsummary::gather_ard(tbl_gts)
+    return(list(table = tbl, ard = ard))
+  } else {
+    return(tbl) # nocov
+  }
 }
 
-#' @describeIn make_table_32 Create FDA table 32 using functions from `gtsummary`.
-#'
-#' @return
-#' * `make_table_32_gtsum` returns a `gt` object
+#' Pre-Process Data for Table 32 Creation
 #'
-#' @examples
-#' tbl <- make_table_32_gtsum(advs = advs)
-#' tbl
+#' @param subset (`string`)\cr selection of both PARAMCD and definition of baseline.
 #'
-#' @export
-make_table_32_gtsum <- function(advs,
-                                alt_counts_df = NULL,
+#' @keywords internal
+preproc_df_table_32 <- function(df,
+                                denominator = NULL,
                                 id_var = "USUBJID",
                                 arm_var = "ARM",
                                 saffl_var = "SAFFL",
-                                lbl_overall = NULL) {
+                                subset = "PARAMCD == 'DIABP' & AVISITN >= 1") {
+  subset_c <-
+    sapply(
+      unlist(admiraldev::extract_vars(rlang::parse_exprs(subset))),
+      as.character
+    )
   assert_subset(c(
-    saffl_var, "AVISITN", "PARAMCD", "AVAL", "AVALU", arm_var, id_var
-  ), names(advs))
-  assert_flag_variables(advs, saffl_var)
-
-  advs <- advs %>%
-    filter(
-      .data[[saffl_var]] == "Y",
-      AVISITN >= 1,
-      PARAMCD == "DIABP"
-    ) %>%
-    df_explicit_na() %>%
-    group_by(.data[[id_var]], PARAMCD) %>%
-    mutate(MAX_DIABP = max(AVAL)) %>%
-    ungroup() %>%
-    distinct(.data[[id_var]], .keep_all = TRUE) %>%
+    saffl_var, "PARAMCD", "AVAL", "AVALU", arm_var, id_var, subset_c
+  ), names(df))
+  assert_flag_variables(df, saffl_var)
+
+  df <- df |>
+    filter(rlang::eval_tidy(rlang::parse_expr(subset))) |>
+    filter(.data[[saffl_var]] == "Y") |>
+    df_explicit_na() |>
+    group_by(.data[[id_var]], PARAMCD) |>
+    mutate(MAX_DIABP = max(AVAL)) |>
+    ungroup() |>
+    distinct(.data[[id_var]], .keep_all = TRUE) |>
     select(all_of(id_var), MAX_DIABP, AVALU, all_of(arm_var))
 
-  if (!is.null(alt_counts_df)) {
-    adsl <- alt_counts_df %>%
-      filter(.data[[saffl_var]] == "Y") %>%
+  if (!is.null(denominator)) {
+    adsl <- denominator |>
+      filter(.data[[saffl_var]] == "Y") |>
       select(all_of(id_var), all_of(arm_var), all_of(saffl_var))
 
-    advs <- advs %>% select(!all_of(arm_var))
-    advs <-
-      adsl %>%
-      left_join(advs, by = id_var)
-  } else {
-    advs <- advs
+    df <- df |> select(!all_of(arm_var))
+    df <- adsl |>
+      left_join(df, by = id_var)
   }
 
-  advs <- advs %>%
+  df <- df |>
     mutate(
       L60 = case_when(MAX_DIABP < 60 ~ "true", TRUE ~ "false"),
       G60 = case_when(MAX_DIABP > 60 ~ "true", TRUE ~ "false"),
       G90 = case_when(MAX_DIABP > 90 ~ "true", TRUE ~ "false"),
       G110 = case_when(MAX_DIABP > 110 ~ "true", TRUE ~ "false"),
       GE120 = case_when(MAX_DIABP >= 120 ~ "true", TRUE ~ "false")
-    ) %>%
+    ) |>
     mutate(
       L60 = with_label(L60 == "true", "<60"),
       G60 = with_label(G60 == "true", ">60"),
       G90 = with_label(G90 == "true", ">90"),
       G110 = with_label(G110 == "true", ">110"),
       GE120 = with_label(GE120 == "true", ">=120")
-    ) %>%
-    select(L60, G60, G90, G110, GE120, AVALU, arm_var)
+    ) |>
+    mutate(!!arm_var := as.character(.data[[arm_var]])) |>
+    select(L60, G60, G90, G110, GE120, AVALU, all_of(c(arm_var, id_var)))
 
-  avalu <- unique(advs$AVALU)[1]
-  advs <- advs %>% select(-AVALU)
+  df
+}
 
-  tbl <- advs %>%
-    tbl_summary(
-      by = arm_var,
-      statistic = list(all_categorical() ~ "{n} ({p}%)"),
-      digits = everything() ~ c(0, 1),
-      missing = "no"
-    ) %>%
-    modify_header(label ~ paste0("**Diastolic Blood Pressure (", avalu, ")**")) %>%
-    modify_header(all_stat_cols() ~ "**{level}**  \nN = {n}") %>%
-    gtsummary::modify_column_alignment(columns = all_stat_cols(), align = "right")
 
-  if (!is.null(lbl_overall)) {
-    tbl <- tbl %>%
-      add_overall(last = TRUE, col_label = paste0("**", lbl_overall, "**  \n N = {n}"))
+#' Engine-Specific Functions: Table 32
+#'
+#' The table engine used by each engine-specific function is identified by its suffix.
+#'
+#' @inheritParams argument_convention
+#' @param subset (`string`)\cr selection of both PARAMCD and definition of baseline.
+#'
+#' @details
+#' * Columns are split by arm. Overall population column is excluded by default (see `lbl_overall` argument).
+#' * Numbers in table "Patients Treated" section are the absolute numbers of patients and fraction of `N`.
+#' * All-zero rows are not removed by default (see `prune_0` argument).
+#' * Records with missing treatment start and/or end datetime are excluded from all calculations.
+#'
+#' @return
+#' * `make_table_32_gtsummary()` returns a `gtsummary` object.
+#' * `make_table_32_rtables()` returns an `rtable` object.
+#'
+#' @seealso [make_table_32()]
+#'
+#' @examples
+#' adsl <- random.cdisc.data::cadsl
+#' advs <- random.cdisc.data::cadvs
+#'
+#' # rtables table ----------------
+#' tbl_rtables <- cardinal::make_table_32_rtables(df = advs, alt_counts_df = adsl)
+#' tbl_rtables
+#' @export
+#' @name tbl_make_table_32
+make_table_32_rtables <- function(df,
+                                  alt_counts_df = NULL,
+                                  show_colcounts = TRUE,
+                                  id_var = "USUBJID",
+                                  arm_var = "ARM",
+                                  saffl_var = "SAFFL",
+                                  lbl_overall = NULL,
+                                  risk_diff = NULL,
+                                  prune_0 = FALSE,
+                                  annotations = NULL,
+                                  subset = NULL) {
+  if (is.null(subset)) {
+    subset <- as.character(formals(preproc_df_table_32)$subset)
   }
+  df <- preproc_df_table_32(df, denominator = alt_counts_df, id_var, arm_var, saffl_var, subset)
+  avalu <- unique(df$AVALU)[1]
 
-  tbl <- tbl %>% modify_footnote(update = everything() ~ NA)
+  lyt <- basic_table_annot(show_colcounts, annotations) |>
+    split_cols_by_arm(arm_var, lbl_overall, risk_diff) |>
+    count_patients_with_flags(
+      var = id_var,
+      flag_variables = c("L60", "G60", "G90", "G110", "GE120"),
+      riskdiff = !is.null(risk_diff)
+    ) |>
+    append_topleft(c("Diastolic Blood Pressure", paste0("(", avalu, ")")))
 
-  gtsummary::with_gtsummary_theme(
-    x = gtsummary::theme_gtsummary_compact(),
-    expr = as_gt(tbl)
-  )
+  tbl <- build_table(lyt, df = df, alt_counts_df = alt_counts_df)
+  if (prune_0) tbl <- prune_table(tbl)
+
+  tbl
 }