diff --git a/DESCRIPTION b/DESCRIPTION
index cecebf1c..f9b7fcd9 100644
--- a/DESCRIPTION
+++ b/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),
diff --git a/NAMESPACE b/NAMESPACE
index b19cae96..c0d69c5b 100644
--- a/NAMESPACE
+++ b/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)
diff --git a/R/cardinal.R b/R/cardinal.R
index 01b8c756..4e58ccf6 100644
--- a/R/cardinal.R
+++ b/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"
))
diff --git a/R/fda-fig_01.R b/R/fda-fig_01.R
index 623744cb..701d1212 100644
--- a/R/fda-fig_01.R
+++ b/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
diff --git a/R/fda-fig_02.R b/R/fda-fig_02.R
index 7486ffe9..7a5e8b17 100644
--- a/R/fda-fig_02.R
+++ b/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
diff --git a/R/fda-fig_03.R b/R/fda-fig_03.R
new file mode 100644
index 00000000..b860a08d
--- /dev/null
+++ b/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
+ }
+}
diff --git a/R/fda-fig_14.R b/R/fda-fig_14.R
index ad5783f8..ab8f3a59 100644
--- a/R/fda-fig_14.R
+++ b/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
diff --git a/R/fda-table_04.R b/R/fda-table_04.R
index 9fcda584..302ef540 100644
--- a/R/fda-table_04.R
+++ b/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"),
diff --git a/_quarto.yml b/_quarto.yml
index 8d7efe8e..bc121553 100644
--- a/_quarto.yml
+++ b/_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
diff --git a/man/make_fig_03.Rd b/man/make_fig_03.Rd
new file mode 100644
index 00000000..2327e6ad
--- /dev/null
+++ b/man/make_fig_03.Rd
@@ -0,0 +1,85 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/fda-fig_03.R
+\name{make_fig_03}
+\alias{make_fig_03}
+\title{FDA Figure 3: Time to Adverse Event Leading to Treatment Discontinuation, Safety Population, Trial X}
+\usage{
+make_fig_03(
+ 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
+)
+}
+\arguments{
+\item{df}{(\code{data.frame})\cr dataset required to build table.}
+
+\item{arm_var}{(\code{character})\cr Name of the treatment arm variable used to split table into columns.}
+
+\item{id_var}{(\code{character})\cr variable used as unique subject identifier.}
+
+\item{saffl_var}{(\code{character})\cr flag variable used to indicate inclusion in safety population.}
+
+\item{trtsdtm_var}{(\code{character})\cr treatment start datetime variable.}
+
+\item{trtedtm_var}{(\code{character})\cr treatment end datetime variable.}
+
+\item{u_trtdur}{(\code{character})\cr unit for duration of treatment. Options are \code{"days"}, \code{"weeks"}, \code{"months"},
+and \code{"years"}.}
+
+\item{dcsreas_var}{(\code{character})\cr reason for treatment discontinuation variable used to split figure into lines.}
+
+\item{x_lab}{(\code{character})\cr x-axis label.}
+
+\item{y_lab}{(\code{character})\cr y-axis label.}
+
+\item{xticks}{(\code{vector} of \code{numeric})\cr x-axis tick positions. If \code{NA} (default), tick mark positions are
+automatically calculated.}
+
+\item{ggtheme}{(\code{theme})\cr a graphical theme as provided by \code{ggplot2} to control styling of the \code{ggplot} object.}
+
+\item{add_table}{(\code{flag})\cr whether tables should be printed under the plot.}
+
+\item{annotations}{(named \code{list} of \code{character})\cr list of annotations to add to the figure. Valid annotation types
+are \code{title}, \code{subtitles}, and \code{caption}. Each name-value pair should use the annotation type as name and the
+desired string as value.}
+}
+\value{
+A \code{ggplot2} object.
+}
+\description{
+FDA Figure 3: Time to Adverse Event Leading to Treatment Discontinuation, Safety Population, Trial X
+}
+\details{
+\itemize{
+\item \code{df} must contain the variables specified by \code{arm_var}, \code{id_var}, \code{saffl_var}, \code{trtsdtm_var}, \code{trtedtm_var} and
+\code{dcsreas_var}.
+\item Flag variables (i.e. \code{XXXFL}) are expected to have two levels: \code{"Y"} (true) and \code{"N"} (false). Missing values in
+flag variables are treated as \code{"N"}.
+\item It is assumed that every record for a unique patient in \code{df} has the same treatment start and end datetime.
+\item 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).
+\item 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).
+\item Records with missing treatment start and/or end datetime are excluded from all calculations.
+}
+}
+\examples{
+adsl <- random.cdisc.data::cadsl
+
+fig <- make_fig_03(df = adsl, dcsreas_var = "DCSREAS")
+fig
+
+}
diff --git a/man/make_table_04.Rd b/man/make_table_04.Rd
index 98f0e666..54e7530b 100644
--- a/man/make_table_04.Rd
+++ b/man/make_table_04.Rd
@@ -64,7 +64,7 @@ FDA Table 4: Patient Disposition, Pooled Analyses
}
\details{
\itemize{
-\item \code{df} must contain \code{EOTSTT}, \code{DCTREAS}, \code{EOSSTT}, \code{DCSREAS} and the variables specified by \code{arm_var}, \code{id_var},
+\item \code{df} must contain \code{EOTSTT}, \code{DCSREAS}, \code{EOSSTT}, \code{DCSREAS} and the variables specified by \code{arm_var}, \code{id_var},
and \code{pop_vars}.
\item If specified, \code{alt_counts_df} must contain the variable specified by \code{arm_var}, \code{id_var}, and \code{pop_vars}.
\item Flag variables (i.e. \code{XXXFL}) are expected to have two levels: \code{"Y"} (true) and \code{"N"} (false). Missing values in
@@ -85,8 +85,7 @@ adsl <- random.cdisc.data::cadsl \%>\%
"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"),
diff --git a/quarto/assets/images/screenshots/fig_03.png b/quarto/assets/images/screenshots/fig_03.png
new file mode 100644
index 00000000..0608685c
Binary files /dev/null and b/quarto/assets/images/screenshots/fig_03.png differ
diff --git a/quarto/figure-templates/template-fig_03.qmd b/quarto/figure-templates/template-fig_03.qmd
new file mode 100644
index 00000000..ff645419
--- /dev/null
+++ b/quarto/figure-templates/template-fig_03.qmd
@@ -0,0 +1,56 @@
+---
+title: FDA Figure 3
+subtitle: Figure 3. Time to Adverse Event Leading to Treatment Discontinuation, Safety Population, Trial X
+format: html
+---
+
+::: panel-tabset
+## Spec. Screenshot
+
+{fig-align="center"}
+
+## ggplot2 Figure
+
+```{r fig, message=FALSE, warning=FALSE}
+# Load Libraries & Data
+library(cardinal)
+
+adsl <- random.cdisc.data::cadsl
+
+# Output Figure
+make_fig_03(df = adsl, dcsreas_var = "DCSREAS")
+```
+
+## Figure Setup
+
+```{r fig, eval=FALSE, echo=TRUE}
+```
+
+## Function Details
+
+### `make_fig_03()`
+
+------------------------------------------------------------------------
+
+Required variables:
+
+- **`df`**: The variables specified by `arm_var`, `id_var`, `saffl_var`, `trtsdtm_var`, `trtedtm_var` and `dcsreas_var`.
+
+| Argument | Description | Default |
+|:--------------|:-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------|:--------------------------------------------------|
+| `df` | (`data.frame`) Dataset (typically ADSL) required to build figure. | *No default* |
+| `arm_var` | (`character`) Arm variable used to split table into columns. | `"ARM"` |
+| `saffl_var` | (`character`) Flag variable used to indicate inclusion in safety population. | `"SAFFL"` |
+| `id_var` | (`character`) Identifier variable used to count the participants within each flag. | `"USUBJID"` |
+| `trtsdtm_var` | (`character`) Treatment start datetime variable in df. | `"TRTSDTM"` |
+| `trtedtm_var` | (`character`) Treatment end datetime variable in df. | `"TRTEDTM"` |
+| `u_trtdur` | (`character`) Unit for duration of treatment. Options are `"days"`, `"weeks"`, `"months"` and `"years"`. | `"days"` |
+| `dcsreas_var` | (`character`) Reason for treatment discontinuation variable used to split figure into lines. | `"DCSREAS"` |
+| `x_lab` | (`character`) x-axis label. | `paste0("Time from first dose (", u_trtdur, ")")` |
+| `y_lab` | (`character`) y-axis label. | `"Percent of Patients (%)"` |
+| `xticks` | (`vector` of `numeric`) x-axis tick positions. If `NA` (default), tick mark positions are automatically calculated. | `NA` |
+| `add_table` | (`flag`) whether "Number of Patients" table should be printed under the plot. | `TRUE` |
+| `annotations` | (named `list` of `character`) 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. | `NULL` |
+
+Source code for this function is available [here](https://github.com/pharmaverse/cardinal/blob/main/R/fda-fig_03.R).
+:::
diff --git a/quarto/index-templates.qmd b/quarto/index-templates.qmd
index 90caf8f6..c6f6c61c 100644
--- a/quarto/index-templates.qmd
+++ b/quarto/index-templates.qmd
@@ -65,5 +65,7 @@ title: Template Library Index
- [FDA Figure 2 -- Time to Last Follow Up, Safety Population, Pooled Analyses](figure-templates/template-fig_02.qmd)
+- [FDA Figure 3 -- Figure 3. Time to Adverse Event Leading to Treatment Discontinuation, Safety Population, Trial X](figure-templates/template-fig_03.qmd)
+
- [FDA Figure 14 -- Mean and 95% Confidence Interval of Systolic Blood Pressure Over Time by Treatment Arm, Safety Population, Trial X](figure-templates/template-fig_14.qmd)
diff --git a/quarto/table-templates/template-table_04.qmd b/quarto/table-templates/template-table_04.qmd
index 7e1947f0..e19122c8 100644
--- a/quarto/table-templates/template-table_04.qmd
+++ b/quarto/table-templates/template-table_04.qmd
@@ -25,8 +25,7 @@ adsl <- random.cdisc.data::cadsl %>%
"ADVERSE EVENT", "LACK OF EFFICACY", "PROTOCOL VIOLATION",
"DEATH", "WITHDRAWAL BY PARENT/GUARDIAN"
), DCSREAS, "OTHER")
- ) %>%
- mutate(DCTREAS = DCSREAS)
+ )
# Output Table
risk_diff <- list(arm_x = "B: Placebo", arm_y = "A: Drug X") # optional
@@ -51,7 +50,7 @@ tbl
Required variables:
-- **`df`**: `USUBJID`, `EOTSTT`, `DCTREAS`, `EOSSTT`, `DCSREAS` and the variables specified by `arm_var` and `pop_var`.
+- **`df`**: `USUBJID`, `EOTSTT`, `DCSREAS`, `EOSSTT`, `DCSREAS` and the variables specified by `arm_var` and `pop_var`.
- **`alt_counts_df`** (if specified): `USUBJID`, and the variable specified by `arm_var` and `pop_var`.
diff --git a/tests/testthat/_snaps/fda-fig_03/fig_03_custom.svg b/tests/testthat/_snaps/fda-fig_03/fig_03_custom.svg
new file mode 100644
index 00000000..23621ef1
--- /dev/null
+++ b/tests/testthat/_snaps/fda-fig_03/fig_03_custom.svg
@@ -0,0 +1,223 @@
+
+
diff --git a/tests/testthat/_snaps/fda-fig_03/fig_03_default.svg b/tests/testthat/_snaps/fda-fig_03/fig_03_default.svg
new file mode 100644
index 00000000..f7fb13e0
--- /dev/null
+++ b/tests/testthat/_snaps/fda-fig_03/fig_03_default.svg
@@ -0,0 +1,188 @@
+
+
diff --git a/tests/testthat/_snaps/fda-fig_03/fig_03_notbl.svg b/tests/testthat/_snaps/fda-fig_03/fig_03_notbl.svg
new file mode 100644
index 00000000..8545e12d
--- /dev/null
+++ b/tests/testthat/_snaps/fda-fig_03/fig_03_notbl.svg
@@ -0,0 +1,85 @@
+
+
diff --git a/tests/testthat/_snaps/fda-fig_03/fig_03_theme.svg b/tests/testthat/_snaps/fda-fig_03/fig_03_theme.svg
new file mode 100644
index 00000000..bda586a2
--- /dev/null
+++ b/tests/testthat/_snaps/fda-fig_03/fig_03_theme.svg
@@ -0,0 +1,213 @@
+
+
diff --git a/tests/testthat/test-fda-fig_03.R b/tests/testthat/test-fda-fig_03.R
new file mode 100644
index 00000000..77f173fc
--- /dev/null
+++ b/tests/testthat/test-fda-fig_03.R
@@ -0,0 +1,49 @@
+adsl <- adsl_raw
+
+test_that("Figure 03 generation works with default values", {
+ fig_03_default <- withr::with_options(
+ opts_partial_match_old,
+ make_fig_03(adsl, dcsreas_var = "DCSREAS")
+ )
+
+ expect_snapshot_ggplot("fig_03_default", fig_03_default, width = 8, height = 5)
+})
+
+test_that("Figure 03 generation works with no table", {
+ fig_03_notbl <- withr::with_options(
+ opts_partial_match_old,
+ make_fig_03(adsl, dcsreas_var = "DCSREAS", add_table = FALSE)
+ )
+
+ expect_snapshot_ggplot("fig_03_notbl", fig_03_notbl, width = 8, height = 3)
+})
+
+test_that("Figure 03 generation works with custom values", {
+ fig_03_custom <- withr::with_options(
+ opts_partial_match_old,
+ make_fig_03(
+ adsl,
+ dcsreas_var = "DCSREAS",
+ u_trtdur = "years",
+ annotations = list(
+ title = "Figure 3. Time to Adverse Event Leading to Treatment Discontinuation, Safety Population, Trial X"
+ ),
+ xticks = c(0, 0.25, 0.5, 0.75, 1, 1.15)
+ )
+ )
+
+ expect_snapshot_ggplot("fig_03_custom", fig_03_custom, width = 10, height = 5)
+})
+
+test_that("Figure 03 generation works with ggtheme argument specified", {
+ fig_03_theme <- withr::with_options(
+ opts_partial_match_old,
+ make_fig_03(
+ adsl,
+ dcsreas_var = "DCSREAS",
+ ggtheme = theme_dark()
+ )
+ )
+
+ expect_snapshot_ggplot("fig_03_theme", fig_03_theme, width = 10, height = 6)
+})
diff --git a/tests/testthat/test-fda-table_04.R b/tests/testthat/test-fda-table_04.R
index ac5231ed..57fc4e6a 100644
--- a/tests/testthat/test-fda-table_04.R
+++ b/tests/testthat/test-fda-table_04.R
@@ -8,8 +8,7 @@ adsl <- adsl_raw %>%
"ADVERSE EVENT", "LACK OF EFFICACY", "PROTOCOL VIOLATION",
"DEATH", "WITHDRAWAL BY PARENT/GUARDIAN"
), DCSREAS, "OTHER")
- ) %>%
- mutate(DCTREAS = DCSREAS)
+ )
test_that("Table 04 generation works with default values", {
result <- make_table_04(adsl)