Add gtsummary function for table 09

NAMESPACE

@@ -19,6 +19,8 @@ export(make_table_07)
 export(make_table_08)
 export(make_table_09)
 export(make_table_09_gtsum)
+export(make_table_09_gtsummary)
+export(make_table_09_rtables)
 export(make_table_09_tplyr)
 export(make_table_10)
 export(make_table_11)

R/fda-table_09.R

@@ -3,11 +3,11 @@
 #'
 #' @inheritParams argument_convention
 #'
-#' @name make_table_09
+#' @name make_table_09_rtables
 NULL
 
 
-#' @describeIn make_table_09 Create FDA table 9 using functions from `rtables` and `tern`.
+#' @describeIn make_table_09_rtables Create FDA table 9 using functions from `rtables` and `tern`.
 #'
 #' @details
 #' * `adae` must contain `AESER`, `AESOC`, and the variables specified by `pref_var`, `id_var`, `arm_var`,
@@ -20,7 +20,7 @@ NULL
 #' * All-zero rows are removed by default (see `prune_0` argument).
 #'
 #' @return
-#' * `make_table_09` returns an `rtables` table object.
+#' * `make_table_09_rtables` returns an `rtables` table object.
 #'
 #' @return An `rtable` object.
 #'
@@ -32,7 +32,7 @@ NULL
 #' tbl
 #'
 #' @export
-make_table_09 <- function(adae,
+make_table_09_rtables <- function(adae,
                           alt_counts_df = NULL,
                           show_colcounts = TRUE,
                           id_var = "USUBJID",
@@ -683,3 +683,129 @@ calculate_riskdiff <- function(x, y, n_x, n_y) {
     paste0(val, " (", conf_int[[1]], ", ", conf_int[[2]], ")")
   })
 }
+
+
+
+#' Engine-Specific Functions: Table 09
+#'
+#' The table engine used by each engine-specific function is identified by its suffix.
+#'
+#' @inheritParams argument_convention
+#'
+#' @return
+#' * `make_table_09_gtsummary()` returns a `gtsummary` object.
+#'
+#' @seealso [make_table_09()]
+#'
+#' @export
+#'
+#' @examples
+#' adsl <- random.cdisc.data::cadsl
+#' adae <- random.cdisc.data::cadae
+#'
+#' tbl_gtsummary <- make_table_09_gtsummary(df = adae, denominator = adsl)
+#' tbl_gtsummary
+make_table_09_gtsummary <- function(
+    df,
+    denominator = NULL,
+    saffl_var = "SAFFL",
+    ser_var = "AESER",
+    arm_var = "ARM",
+    pref_var = "AEDECOD",
+    id_var = "USUBJID",
+    soc_var = "AESOC",
+    lbl_overall = NULL
+) {
+
+  assert_data_frame(df)
+  assert_subset(c(saffl_var, id_var, ser_var, soc_var, arm_var, pref_var), names(df))
+  assert_flag_variables(df, saffl_var)
+  assert_factor(df[[arm_var]])
+
+  if (!is.null(denominator)) {
+    assert_data_frame(denominator)
+    assert_subset(c(id_var, arm_var), names(denominator))
+  }
+
+  if (is.null(denominator)) {
+    denominator <- df
+  }
+
+  df <- df %>%
+    dplyr::filter(.data[[saffl_var]] == "Y", .data[[ser_var]] == "Y")
+
+  tbl <- df |>
+    tbl_hierarchical(
+      variables = c(soc_var, pref_var),
+      by = arm_var,
+      id = id_var,
+      denominator = denominator,
+      overall_row = TRUE,
+      statistic = "{n} ({p}%)",
+      label = "overall" ~ "Any SAE"
+    )
+  if (!is.null(lbl_overall)) {
+    total <- df |>
+      tbl_hierarchical(
+        variables = c(soc_var, pref_var),
+        id = id_var,
+        denominator = denominator,
+        overall_row = TRUE,
+        statistic = "{n} ({p}%)"
+      )
+
+    tbl <- tbl_merge(list(tbl, total), tab_spanner = FALSE)
+  }
+
+
+  return(tbl)
+}
+
+
+#' FDA Table 9: Patients With Serious Adverse Events by System Organ Class and Preferred Term,
+#'   Safety Population, Pooled Analyses
+#'
+#' @inheritParams argument_convention
+#'
+#' @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`.
+#' @export
+#'
+#' @examples
+#' adsl <- random.cdisc.data::cadsl
+#' adae <- random.cdisc.data::cadae
+#'
+#' tbl <- make_table_09(df = adae, denominator = adsl)
+#' tbl
+make_table_09 <- function(
+    df,
+    denominator = NULL,
+    return_ard = TRUE,
+    saffl_var = "SAFFL",
+    ser_var = "AESER",
+    arm_var = "ARM",
+    pref_var = "AEDECOD",
+    id_var = "USUBJID",
+    soc_var = "AESOC",
+    lbl_overall = NULL
+) {
+
+  tbl <- make_table_09_gtsummary(
+    df = df,
+    denominator = denominator,
+    saffl_var = saffl_var,
+    ser_var = ser_var,
+    arm_var = arm_var,
+    pref_var = pref_var,
+    id_var = id_var,
+    soc_var = soc_var,
+    lbl_overall = lbl_overall
+  )
+
+  if (return_ard) {
+    ard <- gather_ard(tbl)
+    return(list(table = tbl, ard = ard))
+  } else {
+    return(tbl)
+  }
+}