207 new figure figure 3

DESCRIPTION

@@ -21,6 +21,7 @@ Imports:
     dplyr (>= 1.0.0),
     formatters (>= 0.5.8),
     ggplot2 (>= 3.5.0),
+    ggsurvfit (>= 1.1.0),
     gt (>= 0.10.1),
     gtsummary (>= 2.0.0),
     lubridate (>= 1.7.10),

NAMESPACE

@@ -4,6 +4,7 @@ export(alt_counts_df_preproc)
 export(basic_table_annot)
 export(make_fig_01)
 export(make_fig_02)
+export(make_fig_03)
 export(make_fig_14)
 export(make_table_02)
 export(make_table_02_gtsum)

R/cardinal.R

@@ -20,9 +20,9 @@ NULL
 utils::globalVariables(c(
   ".", "AEACN", "AESCONG", "AESDISAB", "AESDTH", "AESER", "AESHOSP", "AESIFL", "AESLIFE", "AESMIE", "AGE",
   "AGESEX", "AVAL", "AVALU", "AVISITN", "DOSAGE", "DOSDUR", "DTHADY", "DTHCAT", "DTHCAUS", "DTHFL", "DCSREAS",
-  "MAX_DIABP", "MAX_SYSBP", "PARAMCD", "SEX", "TRTDUR", "TRTDUR_MONTHS", "TRTEDT", "ASER", "DCTREAS",
-  "EOSSTT", "EOTSTT", "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"
+  "MAX_DIABP", "MAX_SYSBP", "PARAMCD", "SEX", "TRTDUR", "TRTDUR_MONTHS", "TRTEDT", "ASER", "EOSSTT", "EOTSTT",
+  "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"
 ))

R/fda-fig_01.R

@@ -63,7 +63,7 @@ make_fig_01 <- function(df,
     geom_line() +
     labs(
       title = annotations[["title"]],
-      subtitle = annotations[["subtitle"]],
+      subtitle = annotations[["subtitles"]],
       caption = annotations[["caption"]],
       x = x_lab,
       y = y_lab

R/fda-fig_02.R

@@ -61,7 +61,7 @@ make_fig_02 <- function(df,
     geom_line() +
     labs(
       title = annotations[["title"]],
-      subtitle = annotations[["subtitle"]],
+      subtitle = annotations[["subtitles"]],
       caption = annotations[["caption"]],
       x = x_lab,
       y = y_lab

R/fda-fig_03.R

@@ -0,0 +1,179 @@
+#' FDA Figure 3: Time to Adverse Event Leading to Treatment Discontinuation, Safety Population, Trial X
+#'
+#' @details
+#' * `df` must contain the variables specified by `arm_var`, `id_var`, `saffl_var`, `trtsdtm_var`, `trtedtm_var` and
+#'   `dcsreas_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"`.
+#' * It is assumed that every record for a unique patient in `df` has the same treatment start and end datetime.
+#' * Values in the "Number at risk" table are the number of patients at risk for each arm with treatment duration equal
+#'   to
+#'   or greater than the given time (times corresponding to the figure's x-ticks labels).
+#' * Values in the "Cumulative Number of Patients with Event" table are the cumulative number of patients given time to
+#'   AEs leading to treatment discontinuation for each arm throughout the trial (times corresponding to the figure's
+#'   x-ticks labels).
+#' * Records with missing treatment start and/or end datetime are excluded from all calculations.
+#'
+#' @inheritParams argument_convention
+#' @param dcsreas_var (`character`)\cr reason for treatment discontinuation variable used to split figure into lines.
+#' @param add_table (`flag`)\cr whether tables should be printed under the plot.
+#' @param annotations (named `list` of `character`)\cr list of annotations to add to the figure. Valid annotation types
+#'   are `title`, `subtitles`, and `caption`. Each name-value pair should use the annotation type as name and the
+#'   desired string as value.
+#'
+#' @return A `ggplot2` object.
+#'
+#' @examples
+#' adsl <- random.cdisc.data::cadsl
+#'
+#' fig <- make_fig_03(df = adsl, dcsreas_var = "DCSREAS")
+#' fig
+#'
+#' @export
+make_fig_03 <- function(df,
+                        arm_var = "ARM",
+                        id_var = "USUBJID",
+                        saffl_var = "SAFFL",
+                        trtsdtm_var = "TRTSDTM",
+                        trtedtm_var = "TRTEDTM",
+                        u_trtdur = "days",
+                        dcsreas_var = "DCSREAS",
+                        x_lab = paste0("Time from first dose (", u_trtdur, ")"),
+                        y_lab = "Cumulative Incidence (%)\nAEs Leading to Treatment\nDiscontinuation",
+                        xticks = NA,
+                        ggtheme = NULL,
+                        add_table = TRUE,
+                        annotations = NULL) {
+  assert_subset(c(arm_var, id_var, saffl_var, trtsdtm_var, trtedtm_var, dcsreas_var), names(df))
+  assert_choice(u_trtdur, c("days", "weeks", "months", "years"))
+  assert_flag_variables(df, saffl_var)
+
+  df <- df %>%
+    filter(.data[[saffl_var]] == "Y") %>%
+    df_explicit_na() %>%
+    mutate(
+      TRTDUR = lubridate::interval(lubridate::ymd_hms(.data[[trtsdtm_var]]), lubridate::ymd_hms(.data[[trtedtm_var]])),
+      TRTDUR = TRTDUR %>% as.numeric(u_trtdur),
+      AVALU = u_trtdur,
+      STATUS = case_when(.data[[dcsreas_var]] == "ADVERSE EVENT" ~ 1, TRUE ~ 0)
+    ) %>%
+    filter(!is.na(TRTDUR)) %>%
+    select(all_of(c(id_var, arm_var)), TRTDUR, STATUS) %>%
+    distinct() %>%
+    arrange(desc(TRTDUR))
+
+  max_time <- max(df$TRTDUR)
+
+  fit <- ggsurvfit::survfit2(ggsurvfit::Surv(TRTDUR, STATUS) ~ ARM, data = df)
+
+  survival_plot <- ggsurvfit::ggsurvfit(fit, type = "risk", linetype_aes = TRUE) +
+    scale_color_manual(values = c("blue", rep("darkgrey", length(levels(df[[arm_var]])) - 1)))
+
+  g <- survival_plot +
+    labs(
+      title = annotations[["title"]],
+      subtitle = annotations[["subtitles"]],
+      caption = annotations[["caption"]],
+      x = x_lab,
+      y = y_lab
+    ) +
+    theme(
+      legend.position = "bottom",
+      legend.title = element_blank(),
+      plot.margin = unit(c(0.05, 0.05, 0, 0.025), "npc")
+    )
+
+  if (any(!is.na(xticks))) {
+    g <- g +
+      scale_x_continuous(breaks = xticks, limits = c(min(xticks), max(c(xticks, max_time))))
+  }
+
+  if (!is.null(ggtheme)) g <- g + ggtheme
+
+  if (add_table) {
+    # following 2 lines replace `g_legend <- cowplot::get_legend(g)` which is currently broken
+    legend_pos <- paste0("guide-box-", ifelse(is.null(ggtheme), "bottom", ggtheme$legend.position))
+    g_legend <- cowplot::get_plot_component(g, legend_pos, return_all = TRUE)
+
+    g <- g + theme(legend.position = "none")
+
+    xtick_lbls <- ggplot_build(g)$layout$panel_params[[1]]$x$breaks
+    xtick_lbls <- xtick_lbls[!is.na(xtick_lbls)]
+    xlims <- ggplot_build(g)$layout$panel_params[[1]]$x$limits
+    arm_colors <- c(rep("darkgrey", length(levels(df[[arm_var]])) - 1), "blue")
+
+    tbl_n <- expand.grid(
+      x = xtick_lbls,
+      arm = rev(levels(df[[arm_var]])),
+      n = 0
+    )
+
+    g_tbl <- ggplot(tbl_n, aes(x = x, y = arm)) +
+      suppressWarnings(theme(
+        axis.title.x = element_blank(),
+        axis.title.y = element_blank(),
+        axis.ticks.x = element_blank(),
+        axis.ticks.y = element_blank(),
+        panel.background = element_blank(),
+        axis.text.x = element_blank(),
+        axis.text.y = element_text(color = arm_colors),
+        panel.border = element_rect(color = "black", fill = NA, linewidth = 0.5),
+        plot.margin = unit(c(0.1, 0.05, 0, 0.025), "npc")
+      )) +
+      labs(title = "Number at risk") +
+      scale_x_continuous(breaks = xtick_lbls, limits = c(min(xlims, xtick_lbls), max(xlims, xtick_lbls)))
+
+    for (i in seq_len(nrow(tbl_n))) {
+      tbl_n$n[i] <- sum(df$ARM == tbl_n$arm[i] & df$TRTDUR >= tbl_n$x[i])
+      colors <- ifelse(tbl_n$arm[i] == levels(df[[arm_var]])[1], "blue", "darkgrey")
+      g_tbl <- g_tbl +
+        annotate("text", label = as.character(tbl_n$n[i]), x = tbl_n$x[i], y = tbl_n$arm[i], color = colors)
+    }
+
+    tbl_n_cum <- expand.grid(
+      x = xtick_lbls,
+      arm = rev(levels(df[[arm_var]])),
+      n = 0
+    )
+
+    g_tbl_cum <- ggplot(tbl_n_cum, aes(x = x, y = arm)) +
+      suppressWarnings(theme(
+        axis.title.x = element_blank(),
+        axis.title.y = element_blank(),
+        axis.ticks.x = element_blank(),
+        axis.ticks.y = element_blank(),
+        panel.background = element_blank(),
+        axis.text.x = element_blank(),
+        axis.text.y = element_text(color = arm_colors),
+        panel.border = element_rect(color = "black", fill = NA, linewidth = 0.5),
+        plot.margin = unit(c(0.1, 0.05, 0, 0.025), "npc")
+      )) +
+      labs(title = "Cumulative Number of Patients with Event") +
+      scale_x_continuous(breaks = xtick_lbls, limits = c(min(xlims, xtick_lbls), max(xlims, xtick_lbls)))
+
+    for (i in seq_len(nrow(tbl_n_cum))) {
+      tbl_n_cum$n[i] <- sum(df$ARM == tbl_n_cum$arm[i] & df$TRTDUR >= tbl_n_cum$x[i])
+      colors <- ifelse(tbl_n_cum$arm[i] == levels(df[[arm_var]])[1], "blue", "darkgrey")
+      g_tbl_cum <- g_tbl_cum +
+        annotate("text", label = as.character(tbl_n_cum$n[i]), x = tbl_n_cum$x[i], y = tbl_n_cum$arm[i], color = colors)
+    }
+
+    if (!is.null(ggtheme)) {
+      g_tbl <- g_tbl + ggtheme
+      g_tbl_cum <- g_tbl_cum + ggtheme
+    }
+
+    cowplot::plot_grid(
+      g,
+      g_tbl,
+      g_tbl_cum,
+      g_legend,
+      align = "v",
+      axis = "l",
+      ncol = 1,
+      rel_heights = c(0.75, 0.25, 0.25, 0.1)
+    )
+  } else {
+    g
+  }
+}

R/fda-fig_14.R

@@ -103,7 +103,7 @@ make_fig_14 <- function(df,
     ) +
     labs(
       title = annotations[["title"]],
-      subtitle = annotations[["subtitle"]],
+      subtitle = annotations[["subtitles"]],
       caption = annotations[["caption"]],
       x = x_lab,
       y = y_lab

R/fda-table_04.R

@@ -1,7 +1,7 @@
 #' FDA Table 4: Patient Disposition, Pooled Analyses
 #'
 #' @details
-#' * `df` must contain `EOTSTT`, `DCTREAS`, `EOSSTT`, `DCSREAS` and the variables specified by `arm_var`, `id_var`,
+#' * `df` must contain `EOTSTT`, `DCSREAS`, `EOSSTT`, `DCSREAS` and the variables specified by `arm_var`, `id_var`,
 #'   and `pop_vars`.
 #' * If specified, `alt_counts_df` must contain the variable specified by `arm_var`, `id_var`, and `pop_vars`.
 #' * Flag variables (i.e. `XXXFL`) are expected to have two levels: `"Y"` (true) and `"N"` (false). Missing values in
@@ -28,8 +28,7 @@
 #'       "ADVERSE EVENT", "LACK OF EFFICACY", "PROTOCOL VIOLATION",
 #'       "DEATH", "WITHDRAWAL BY PARENT/GUARDIAN"
 #'     ), DCSREAS, "OTHER")
-#'   ) %>%
-#'   mutate(DCTREAS = DCSREAS)
+#'   )
 #'
 #' tbl <- make_table_04(
 #'   df = adsl, pop_vars = c("RANDFL", "ITTFL", "SAFFL", "PPROTFL"),
@@ -53,7 +52,7 @@ make_table_04 <- function(df,
                           annotations = NULL) {
   assert_subset(c(
     id_var, arm_var, pop_vars,
-    "EOTSTT", "DCTREAS", "EOSSTT", "DCSREAS"
+    "EOTSTT", "DCSREAS", "EOSSTT", "DCSREAS"
   ), names(df))
   assert_flag_variables(df, pop_vars)
 
@@ -64,12 +63,12 @@ make_table_04 <- function(df,
     mutate(
       across(all_of(pop_vars), ~ with_label(. == "Y", lbl_pop_vars[match(cur_column(), pop_vars)])),
       DISCSD = with_label(EOTSTT == "DISCONTINUED", "Discontinued study drug"),
-      DISCSD_AE = with_label(EOTSTT == "DISCONTINUED" & DCTREAS == "ADVERSE EVENT", "Adverse event"),
-      DISCSD_LOE = with_label(EOTSTT == "DISCONTINUED" & DCTREAS == "LACK OF EFFICACY", "Lack of efficacy"),
-      DISCSD_PD = with_label(EOTSTT == "DISCONTINUED" & DCTREAS == "PROTOCOL DEVIATION", "Protocol deviation"),
-      DISCSD_DT = with_label(EOTSTT == "DISCONTINUED" & DCTREAS == "DEATH", "Death"),
-      DISCSD_WBS = with_label(EOTSTT == "DISCONTINUED" & DCTREAS == "WITHDRAWAL BY SUBJECT", "Withdrawal by subject"),
-      DISCSD_OTH = with_label(EOTSTT == "DISCONTINUED" & DCTREAS == "OTHER", "Other"),
+      DISCSD_AE = with_label(EOTSTT == "DISCONTINUED" & DCSREAS == "ADVERSE EVENT", "Adverse event"),
+      DISCSD_LOE = with_label(EOTSTT == "DISCONTINUED" & DCSREAS == "LACK OF EFFICACY", "Lack of efficacy"),
+      DISCSD_PD = with_label(EOTSTT == "DISCONTINUED" & DCSREAS == "PROTOCOL DEVIATION", "Protocol deviation"),
+      DISCSD_DT = with_label(EOTSTT == "DISCONTINUED" & DCSREAS == "DEATH", "Death"),
+      DISCSD_WBS = with_label(EOTSTT == "DISCONTINUED" & DCSREAS == "WITHDRAWAL BY SUBJECT", "Withdrawal by subject"),
+      DISCSD_OTH = with_label(EOTSTT == "DISCONTINUED" & DCSREAS == "OTHER", "Other"),
       DISCS = with_label(EOSSTT == "DISCONTINUED", "Discontinued study"),
       DISCS_DT = with_label(EOSSTT == "DISCONTINUED" & DCSREAS == "DEATH", "Death"),
       DISCS_LFU = with_label(EOSSTT == "DISCONTINUED" & DCSREAS == "LOST TO FOLLOW-UP", "Lost to follow-up"),

_quarto.yml

@@ -106,6 +106,7 @@ website:
           - quarto/table-templates/template-table_36.qmd
           - quarto/figure-templates/template-fig_01.qmd
           - quarto/figure-templates/template-fig_02.qmd
+          - quarto/figure-templates/template-fig_03.qmd
           - quarto/figure-templates/template-fig_14.qmd
       - text: About
         file: quarto/about.qmd