|
| 1 | +#' FDA Table 22. Overview of Adverse Events by Demographic Subgroup, Safety Population, Pooled Analysis (or Trial X) |
| 2 | +#' |
| 3 | +#' @details |
| 4 | +#' * `df` must contain the variables specified by `vars`, `arm_var`, and `saffl_var`. |
| 5 | +#' * If specified, `alt_counts_df` must contain `USUBJID` and the variables specified by `arm_var` and `saffl_var`. |
| 6 | +#' * Flag variables (i.e. `XXXFL`) are expected to have two levels: `"Y"` (true) and `"N"` (false). Missing values in |
| 7 | +#' flag variables are treated as `"N"`. |
| 8 | +#' * Columns are split by arm. |
| 9 | +#' * Information from either ADSUB or ADVS is generally included into `df` prior to analysis. |
| 10 | +#' * Numbers in the table for non-numeric variables represent the absolute number of patients and fraction of `n`. |
| 11 | +#' * All-zero rows are removed by default (see `prune_0` argument). |
| 12 | +#' |
| 13 | +#' @inheritParams argument_convention |
| 14 | +#' @inheritParams a_count_occurrences_trtem_ae |
| 15 | +#' |
| 16 | +#' @return An `rtable` object. |
| 17 | +#' |
| 18 | +#' @examples |
| 19 | +#' library(dplyr) |
| 20 | +#' |
| 21 | +#' adsl <- scda::synthetic_cdisc_dataset("rcd_2022_10_13", "adsl") %>% |
| 22 | +#' mutate(AGEGR1 = as.factor(case_when( |
| 23 | +#' AGE >= 17 & AGE < 65 ~ ">=17 to <65", |
| 24 | +#' AGE >= 65 ~ ">=65", |
| 25 | +#' AGE >= 65 & AGE < 75 ~ ">=65 to <75", |
| 26 | +#' AGE >= 75 ~ ">=75" |
| 27 | +#' )) %>% formatters::with_label("Age Group, years")) %>% |
| 28 | +#' formatters::var_relabel( |
| 29 | +#' AGE = "Age, years" |
| 30 | +#' ) |
| 31 | +#' |
| 32 | +#' adae <- scda::synthetic_cdisc_dataset("rcd_2022_10_13", "adae") |
| 33 | +#' |
| 34 | +#' df <- left_join(adsl, adae, by = intersect(names(adsl), names(adae))) |
| 35 | +#' |
| 36 | +#' tbl <- make_table_22(df = df, alt_counts_df = adsl) |
| 37 | +#' tbl |
| 38 | +#' |
| 39 | +#' @export |
| 40 | +make_table_22 <- function(df, |
| 41 | + alt_counts_df = NULL, |
| 42 | + show_colcounts = TRUE, |
| 43 | + arm_var = "ARM", |
| 44 | + saffl_var = "SAFFL", |
| 45 | + vars = c("SEX", "AGEGR1", "RACE", "ETHNIC"), |
| 46 | + denom = c("N_s", "N_col", "n"), |
| 47 | + lbl_overall = NULL, |
| 48 | + lbl_vars = formatters::var_labels(df, fill = TRUE)[vars], |
| 49 | + prune_0 = FALSE, |
| 50 | + annotations = NULL) { |
| 51 | + checkmate::assert_subset(c(vars, arm_var, saffl_var), names(df)) |
| 52 | + |
| 53 | + df <- df %>% |
| 54 | + filter(.data[[saffl_var]] == "Y") %>% |
| 55 | + df_explicit_na() |
| 56 | + |
| 57 | + # For percentages calculations in case of N_s, add the overall observations |
| 58 | + denom <- match.arg(denom) |
| 59 | + if (!is.null(lbl_overall) && denom == "N_s") { |
| 60 | + df_ovrl <- df |
| 61 | + df_ovrl[[arm_var]] <- lbl_overall |
| 62 | + df <- rbind(df, df_ovrl) |
| 63 | + |
| 64 | + if (!is.null(alt_counts_df)) { |
| 65 | + alt_df_ovrl <- alt_counts_df |
| 66 | + alt_df_ovrl[[arm_var]] <- lbl_overall |
| 67 | + alt_counts_df <- rbind(alt_counts_df, alt_df_ovrl) |
| 68 | + } |
| 69 | + } |
| 70 | + |
| 71 | + alt_counts_df <- alt_counts_df_preproc(alt_counts_df, arm_var, saffl_var) |
| 72 | + |
| 73 | + lyt <- basic_table_annot(show_colcounts, annotations) |
| 74 | + |
| 75 | + lyt <- if (!is.null(lbl_overall) && denom != "N_s") { |
| 76 | + lyt %>% split_cols_by_arm(arm_var, lbl_overall) |
| 77 | + } else { |
| 78 | + lyt %>% split_cols_by_arm(arm_var) |
| 79 | + } |
| 80 | + |
| 81 | + lyt <- lyt %>% |
| 82 | + count_patients_with_event( |
| 83 | + "USUBJID", |
| 84 | + filters = c("TRTEMFL" = "Y"), |
| 85 | + .labels = c(count_fraction = "Any AE, n (%)") |
| 86 | + ) %>% |
| 87 | + analyze( |
| 88 | + vars = vars, |
| 89 | + var_labels = paste0(lbl_vars, ", n (%)"), |
| 90 | + afun = a_count_occurrences_trtem_ae, |
| 91 | + extra_args = list( |
| 92 | + denom = denom, |
| 93 | + arm_var = arm_var, |
| 94 | + df_denom = if (!is.null(alt_counts_df)) alt_counts_df else df |
| 95 | + ), |
| 96 | + show_labels = "visible" |
| 97 | + ) %>% |
| 98 | + append_topleft(c("", "Characteristic")) |
| 99 | + |
| 100 | + tbl <- build_table(lyt, df = df, alt_counts_df = alt_counts_df) |
| 101 | + if (prune_0) tbl <- prune_table(tbl) |
| 102 | + |
| 103 | + tbl |
| 104 | +} |
| 105 | + |
| 106 | +#' Analysis Function to Calculate Count/Fraction of Any Adverse Event Occurrences |
| 107 | +#' |
| 108 | +#' @inheritParams tern::s_count_occurrences |
| 109 | +#' @inheritParams argument_convention |
| 110 | +#' @param df_denom (`data.frame`)\cr Full data frame used to calculate denominator subgroup counts |
| 111 | +#' when `denom = "N_s"`. |
| 112 | +#' @param denom (`character`)\cr Denominator to use to calculate fractions. Can be `"N_s"` (total `df_denom` |
| 113 | +#' subgroup/row counts), `"N_col"` (total `df` column counts), or `"n"` (total `df` overall patient count). |
| 114 | +#' Note that `df` is filtered to only include treatment-emergent adverse events (`TRTEMFL == "Y"`). |
| 115 | +#' |
| 116 | +#' @keywords internal |
| 117 | +a_count_occurrences_trtem_ae <- function(df, |
| 118 | + .var, |
| 119 | + .N_col, # nolint |
| 120 | + df_denom = NULL, |
| 121 | + denom = c("N_s", "N_col", "n"), |
| 122 | + id_var = "USUBJID", |
| 123 | + arm_var = "ARM") { |
| 124 | + df <- df %>% filter(TRTEMFL == "Y") |
| 125 | + occurrences <- df[[.var]] |
| 126 | + ids <- factor(df[[id_var]]) |
| 127 | + has_occurrence_per_id <- table(occurrences, ids) > 0 |
| 128 | + n_ids_per_occurrence <- as.list(rowSums(has_occurrence_per_id)) |
| 129 | + lvls <- names(n_ids_per_occurrence) |
| 130 | + |
| 131 | + denom <- match.arg(denom) |
| 132 | + if (denom == "N_s" && is.null(df_denom)) { |
| 133 | + stop("If using subgroup population counts, `df_denom` must be specified.") # nocov |
| 134 | + } |
| 135 | + dn <- switch(denom, |
| 136 | + N_s = lapply( |
| 137 | + lvls, |
| 138 | + function(x) { |
| 139 | + df_denom %>% |
| 140 | + filter(.data[[.var]] == x, .data[[arm_var]] == df[[arm_var]][1]) %>% |
| 141 | + select(USUBJID) %>% |
| 142 | + distinct() %>% |
| 143 | + nrow() |
| 144 | + } |
| 145 | + ), |
| 146 | + n = nlevels(ids), |
| 147 | + N_col = .N_col |
| 148 | + ) |
| 149 | + if (denom == "N_s") names(dn) <- lvls |
| 150 | + |
| 151 | + x_stats <- lapply( |
| 152 | + lvls, |
| 153 | + function(x) { |
| 154 | + i <- n_ids_per_occurrence[[x]] |
| 155 | + denom <- if (denom == "N_s") dn[[x]] else dn |
| 156 | + if (i == 0 && denom == 0) c(0, 0) else c(i, i / denom) |
| 157 | + } |
| 158 | + ) |
| 159 | + names(x_stats) <- names(n_ids_per_occurrence) |
| 160 | + |
| 161 | + in_rows( |
| 162 | + .list = x_stats, |
| 163 | + .formats = tern::format_count_fraction |
| 164 | + ) |
| 165 | +} |
0 commit comments