Add ard function for table 5 (#239)

NAMESPACE

@@ -12,6 +12,8 @@ export(make_table_02_tplyr)
 export(make_table_03)
 export(make_table_04)
 export(make_table_05)
+export(make_table_05_gtsummary)
+export(make_table_05_rtables)
 export(make_table_06)
 export(make_table_07)
 export(make_table_08)
@@ -40,6 +42,8 @@ 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)

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
@@ -24,5 +24,5 @@ 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"
 ))

R/fda-table_05.R

@@ -3,18 +3,17 @@
 #' @details
 #' * `df` must contain the variables specified by `arm_var`, `saffl_var`, `id_var`, `trtsdtm_var`,
 #'   and `trtedtm_var`.
-#' * If specified, `alt_counts_df` must contain the variables specified by `arm_var`, `id_var` and `saffl_var`.
+#' * If specified, `denominator` 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 "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.
 #'
+#' @inheritParams tbl_make_table_05
 #' @inheritParams argument_convention
-#' @param lbl_trtdur (`character`)\cr label for treatment duration variable.
 #'
-#' @return An `rtable` object.
+#' @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_05`]
 #'
 #' @examples
 #' adsl <- random.cdisc.data::cadsl
@@ -24,24 +23,54 @@
 #'
 #' @export
 make_table_05 <- function(df,
-                          alt_counts_df = NULL,
-                          show_colcounts = TRUE,
+                          denominator = NULL,
+                          return_ard = TRUE,
                           arm_var = "ARM",
                           id_var = "USUBJID",
                           saffl_var = "SAFFL",
                           trtsdtm_var = "TRTSDTM",
                           trtedtm_var = "TRTEDTM",
-                          u_trtdur = "days",
-                          lbl_trtdur = paste("Duration of Treatment,", u_trtdur),
-                          lbl_overall = NULL,
-                          risk_diff = NULL,
-                          prune_0 = FALSE,
-                          annotations = NULL) {
+                          u_trtdur = "days") {
   assert_subset(c(id_var, arm_var, saffl_var, id_var, trtsdtm_var, trtedtm_var), names(df))
   assert_choice(u_trtdur, c("days", "weeks", "months", "years"))
   assert_flag_variables(df, saffl_var)
 
-  df <- df %>%
+  ard <- ard_table_05(
+    df = df,
+    denominator = denominator,
+    arm_var = arm_var,
+    saffl_var = saffl_var,
+    trtsdtm_var = trtsdtm_var,
+    trtedtm_var = trtedtm_var,
+    u_trtdur = u_trtdur
+  )
+
+  tbl <- make_table_05_gtsummary(
+    df,
+    ard,
+    arm_var,
+    saffl_var,
+    trtsdtm_var,
+    trtedtm_var,
+    u_trtdur
+  )
+
+  if (return_ard) {
+    return(list(table = tbl, ard = ard))
+  } else {
+    return(tbl)
+  }
+}
+
+#' Pre-Process Data for Table 5 Creation
+#'
+#' @keywords internal
+preproc_df_table_05 <- function(df,
+                                saffl_var = "SAFFL",
+                                trtsdtm_var = "TRTSDTM",
+                                trtedtm_var = "TRTEDTM",
+                                u_trtdur = "days") {
+  df %>%
     as_tibble() %>%
     filter(.data[[saffl_var]] == "Y") %>%
     df_explicit_na() %>%
@@ -61,8 +90,180 @@ make_table_05 <- function(df,
       D_GT12 = (TRTDUR_MONTHS >= 12) %>% with_label(">=12 months"),
       DUR_LBL = "Patients Treated, by duration"
     )
+}
 
-  alt_counts_df <- alt_counts_df_preproc(alt_counts_df, id_var, arm_var, saffl_var)
+#' Make ARD: Table 5
+#'
+#' @examples
+#' adsl <- random.cdisc.data::cadsl
+#' df <- cardinal:::preproc_df_table_05(
+#'   adsl,
+#'   saffl_var = "SAFFL",
+#'   trtsdtm_var = "TRTSDTM",
+#'   trtedtm_var = "TRTEDTM",
+#'   u_trtdur = "days"
+#' )
+#'
+#' ard <- cardinal:::ard_table_05(df = df)
+#' ard
+#'
+#' @keywords internal
+#' @name ard_make_table_05
+ard_table_05 <- function(df,
+                         denominator = NULL,
+                         arm_var = "ARM",
+                         saffl_var = "SAFFL",
+                         trtsdtm_var = "TRTSDTM",
+                         trtedtm_var = "TRTEDTM",
+                         u_trtdur = "days") {
+  df <- preproc_df_table_05(df, saffl_var, trtsdtm_var, trtedtm_var, u_trtdur)
+
+  if (is.null(denominator)) {
+    denominator <- df
+  } else {
+    denominator <- alt_counts_df_preproc(denominator, id_var, arm_var, saffl_var)
+  }
+
+  stats_trtdur <- df |>
+    ard_continuous(
+      variables = "TRTDUR",
+      by = all_of(arm_var),
+      statistic = everything() ~ continuous_summary_fns(
+        summaries = c("mean", "sd", "median", "min", "max", "p25", "p75"),
+        other_stats = list(
+          tot_exposure = \(x) sum(x),
+          person_yrs = \(x) as.numeric(lubridate::duration(sum(x), u_trtdur), "years")
+        )
+      ),
+      fmt_fn = ~ list(~ \(x) round5(x, digits = 2))
+    ) |>
+    apply_fmt_fn()
+
+  stats_pt_cts <- df |>
+    group_by(!!rlang::sym(arm_var)) |>
+    ard_dichotomous(
+      variables = c(D_ANY, D_LT1, D_GT1, D_GT3, D_GT6, D_GT12),
+      value = list(D_ANY = TRUE, D_LT1 = TRUE, D_GT1 = TRUE, D_GT3 = TRUE, D_GT6 = TRUE, D_GT12 = TRUE),
+      statistic = everything() ~ c("n", "p"),
+      denominator = denominator
+    )
+
+  ard <- bind_ard(stats_trtdur, stats_pt_cts)
+
+  ard
+}
+
+#' Engine-Specific Functions: Table 5
+#'
+#' The table engine used by each engine-specific function is identified by its suffix.
+#'
+#' @inheritParams argument_convention
+#' @param lbl_trtdur (`character`)\cr label for treatment duration variable.
+#'
+#' @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_05_gtsummary()` returns a `gtsummary` object.
+#' * `make_table_05_rtables()` returns an `rtable` object.
+#'
+#' @seealso [make_table_05()]
+#'
+#' @examples
+#' adsl <- random.cdisc.data::cadsl
+#'
+#' # gtsummary table --------------
+#' ard <- cardinal:::ard_table_05(df = adsl)
+#' tbl_gtsummary <- cardinal:::make_table_05_gtsummary(df = adsl, ard = ard)
+#' tbl_gtsummary
+#'
+#' # rtables table ----------------
+#' tbl_rtables <- cardinal:::make_table_05_rtables(df = adsl)
+#' tbl_rtables
+#'
+#' @export
+#' @name tbl_make_table_05
+make_table_05_gtsummary <- function(df,
+                                    ard,
+                                    arm_var = "ARM",
+                                    saffl_var = "SAFFL",
+                                    trtsdtm_var = "TRTSDTM",
+                                    trtedtm_var = "TRTEDTM",
+                                    u_trtdur = "days") {
+  df <- preproc_df_table_05(df, saffl_var, trtsdtm_var, trtedtm_var, u_trtdur)
+
+  stat_fun <- function(data, ...) {
+    dplyr::tibble(
+      mean = mean(data$TRTDUR),
+      sd = sd(data$TRTDUR),
+      median = median(data$TRTDUR),
+      min = min(data$TRTDUR),
+      max = max(data$TRTDUR),
+      q25 = quantile(data$TRTDUR, 0.25),
+      q75 = quantile(data$TRTDUR, 0.75),
+      tot_exp = sum(data$TRTDUR),
+      tot_dur = as.numeric(lubridate::duration(sum(data$TRTDUR), u_trtdur), "years")
+    )
+  }
+
+  tbl_cts <- tbl_custom_summary(
+    df,
+    by = all_of(arm_var),
+    label = list(TRTDUR = paste("Duration of Treatment,", u_trtdur)),
+    stat_fns = everything() ~ stat_fun,
+    statistic = ~ c("{mean} ({sd})", "{median} ({min}, {max})", "{q25} - {q75}", "{tot_exp} ({tot_dur})"),
+    digits = ~2,
+    type = list(TRTDUR = "continuous2"),
+    include = TRTDUR,
+    missing = "no"
+  )
+  tbl_cts$table_body$label[4:5] <- c("Interquartile range", "Total exposure (person years)")
+
+  tbl_cat <- tbl_ard_summary(ard, by = all_of(arm_var), include = -TRTDUR)
+  tbl_cat$table_body <- dplyr::bind_rows(
+    data.frame(row_type = "label", label = "Patients Treated, by duration"),
+    tbl_cat$table_body
+  )
+  tbl_cat <- tbl_cat |>
+    modify_column_indent(
+      columns = dplyr::all_of("label"),
+      rows = !is.na(variable),
+      indent = 4L
+    )
+  tbl_cat$table_body$label[2:7] <- c(
+    "Any duration (at least 1 dose)", "<1 month", ">=1 month", ">=3 months", ">=6 months", ">=12 months"
+  )
+
+  tbl_stack(list(tbl_cts, tbl_cat), quiet = TRUE) |>
+    modify_table_styling(
+      columns = dplyr::all_of("label"),
+      label = "**Parameter**"
+    )
+}
+
+#' @export
+#' @rdname tbl_make_table_05
+make_table_05_rtables <- function(df,
+                                  alt_counts_df = NULL,
+                                  show_colcounts = TRUE,
+                                  arm_var = "ARM",
+                                  id_var = "USUBJID",
+                                  saffl_var = "SAFFL",
+                                  trtsdtm_var = "TRTSDTM",
+                                  trtedtm_var = "TRTEDTM",
+                                  u_trtdur = "days",
+                                  lbl_trtdur = paste("Duration of Treatment,", u_trtdur),
+                                  lbl_overall = NULL,
+                                  risk_diff = NULL,
+                                  prune_0 = FALSE,
+                                  annotations = NULL) {
+  df <- preproc_df_table_05(df, saffl_var, trtsdtm_var, trtedtm_var, u_trtdur)
+  if (!is.null(alt_counts_df)) {
+    alt_counts_df <- alt_counts_df_preproc(alt_counts_df, id_var, arm_var, saffl_var)
+  }
 
   lyt <- basic_table_annot(show_colcounts, annotations) %>%
     split_cols_by_arm(arm_var, lbl_overall, risk_diff) %>%