Merge branch 'main' into 242_ard_tbl_11_12@main

Author: edelarua

.pre-commit-config.yaml

@@ -3,7 +3,7 @@
 # R specific hooks: https://github.com/lorenzwalthert/precommit
 repos:
   - repo: https://github.com/lorenzwalthert/precommit
-    rev: v0.4.3.9001
+    rev: v0.4.3.9003
     hooks:
       - id: style-files
         args: [--style_pkg=styler, --style_fun=tidyverse_style]
@@ -50,7 +50,7 @@ repos:
     hooks:
       - id: prettier
   - repo: https://github.com/pre-commit/pre-commit-hooks
-    rev: v4.6.0
+    rev: v5.0.0
     hooks:
       - id: check-added-large-files
         args: ["--maxkb=200"]
@@ -76,6 +76,6 @@ repos:
         files: '\.Rhistory|\.RData|\.Rds|\.rds$'
         # `exclude: <regex>` to allow committing specific files.
   - repo: https://github.com/igorshubovych/markdownlint-cli
-    rev: v0.41.0
+    rev: v0.43.0
     hooks:
       - id: markdownlint

DESCRIPTION

@@ -1,8 +1,8 @@
 Type: Package
 Package: cardinal
 Title: FDA Safety Tables and Figures
-Version: 0.1.0.9062
-Date: 2024-09-19
+Version: 0.1.0.9063
+Date: 2024-12-02
 Authors@R:
     person("Pawel", "Rucki", , "[email protected]", role = c("aut", "cre"))
 Description: R package with implementation of Safety Tables and Figures

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)

NEWS.md

@@ -1,3 +1,3 @@
-# cardinal 0.1.0.9062
+# cardinal 0.1.0.9063
 
 * Initial release.

R/argument_convention.R

@@ -69,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

@@ -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) %>%