201 new figure figure 14

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_14)
 export(make_table_02)
 export(make_table_02_gtsum)
 export(make_table_02_tplyr)

NEWS.md

@@ -5,7 +5,7 @@
   `make_table_06`, `make_table_07`, `make_table_08`, `make_table_09`, `make_table_10`, `make_table_11`, `make_table_12`, 
   `make_table_13`, `make_table_14`, `make_table_15`, `make_table_16`, `make_table_17`, `make_table_18`, `make_table_20`, 
   `make_table_21`, `make_table_22`, `make_table_32`, `make_table_33`, `make_table_34`, `make_table_35`.
-* Added new functions for creating standard FDA figures: `make_fig_01`, `make_fig_02`.
+* Added new functions for creating standard FDA figures: `make_fig_01`, `make_fig_02`, `make_fig_14`.
 * Added helper functions used within table functions:
   * `basic_table_annot` for adding basic table annotations (titles, footnotes, column counts).
   * `split_cols_by_arm` for splitting columns by arm with option to add total column.

R/argument_convention.R

@@ -51,6 +51,8 @@
 #' @param xticks (`vector` of `numeric`)\cr x-axis tick positions. If `NA` (default), tick mark positions are
 #'   automatically calculated.
 #' @param x_lab (`character`)\cr x-axis label.
+#' @param yticks (`vector` of `numeric`)\cr y-axis tick positions. If `NA` (default), tick mark positions are
+#'   automatically calculated.
 #' @param y_lab (`character`)\cr y-axis label.
 #'
 #' @name argument_convention

R/fda-fig_14.R

@@ -0,0 +1,183 @@
+#' FDA Figure 14: Mean and 95% Confidence Interval of Systolic Blood Pressure Over Time
+#' by Treatment Arm, Safety Population, Trial X
+#'
+#' @details
+#' * `df` must contain the variables `AVAL` and `PARAMCD`, and the variables specified by `arm_var`,
+#'   `saffl_var`, `visit_var`, and `add_cond`.
+#' * 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 `df` contains one unique record per patient.
+#'
+#' @inheritParams argument_convention
+#' @param add_table (`flag`)\cr whether "Mean Value" and "Number of Patients" tables should be printed under the plot
+#' @param visit_var (`character`)\cr visit variable to put on the x-axis
+#' @param paramcd_val (`character`)\cr value of `PARAMCD` to plot
+#' @param add_cond (`expr`)\cr expression that provides additional filters for the analysis
+#'   (for instance on `ATPT` or `VSPOS`)
+#' @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
+#' advs <- random.cdisc.data::cadvs
+#'
+#' fig <- make_fig_14(
+#'   df = advs,
+#'   add_cond = bquote("ONTRTFL == 'Y' | ABLFL == 'Y'"),
+#'   add_table = TRUE,
+#'   yticks = c(135, 140, 145, 150, 155, 160)
+#' )
+#' fig
+#'
+#' @export
+make_fig_14 <- function(df,
+                        arm_var = "ARM",
+                        saffl_var = "SAFFL",
+                        visit_var = "AVISIT",
+                        paramcd_val = "SYSBP",
+                        add_cond = NULL,
+                        x_lab = "",
+                        y_lab = NULL,
+                        yticks = NA,
+                        ggtheme = NULL,
+                        add_table = TRUE,
+                        annotations = NULL) {
+  checkmate::assert_subset(c(arm_var, saffl_var, visit_var), names(df))
+  assert_flag_variables(df, saffl_var)
+
+  df <- df %>%
+    as_tibble() %>%
+    filter(
+      .data[[saffl_var]] == "Y",
+      PARAMCD == {{ paramcd_val }},
+      !is.na(AVAL)
+    ) %>%
+    df_explicit_na()
+
+  if (!(is.null({{ add_cond }}))) {
+    df <- df %>%
+      filter(!!rlang::parse_expr(add_cond))
+  }
+
+  if (is.null({{ y_lab }})) {
+    y_param <- unique(df$PARAM)
+    y_avalu <- unique(df$AVALU)
+
+    y_lab <- paste0("Mean Value (95% CI)", "\n", y_param, " (", y_avalu, ")")
+  }
+
+  df <- df %>%
+    group_by(!!sym(arm_var), !!sym(visit_var), .drop = TRUE) %>%
+    summarise(
+      mean = mean(AVAL, na.rm = TRUE),
+      sd = sd(AVAL, na.rm = TRUE),
+      n = n()
+    ) %>%
+    mutate(
+      se = sd / sqrt(n),
+      lower_ci = mean - qt(1 - (0.05 / 2), n - 1) * se,
+      upper_ci = mean + qt(1 - (0.05 / 2), n - 1) * se
+    ) %>%
+    ungroup()
+
+  g <-
+    ggplot(
+      data = df,
+      aes(
+        x = !!sym(visit_var),
+        y = mean,
+        group = .data[[arm_var]],
+        color = .data[[arm_var]]
+      )
+    ) +
+    geom_point(position = position_dodge(width = 0.5)) +
+    geom_line(position = position_dodge(width = 0.5)) +
+    geom_errorbar(
+      aes(
+        ymin = lower_ci,
+        ymax = upper_ci
+      ),
+      position = position_dodge(width = 0.5)
+    ) +
+    labs(
+      title = annotations[["title"]],
+      subtitle = annotations[["subtitle"]],
+      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(yticks))) {
+    g <- g +
+      scale_y_continuous(breaks = yticks, limits = c(min(yticks), max(yticks)))
+  }
+
+  if (!is.null(ggtheme)) g <- g + ggtheme
+
+  if (add_table) {
+    g_legend <- cowplot::get_legend(g)
+    g <- g + theme(legend.position = "none")
+
+    tbl_n <- df %>%
+      mutate(meanr = sprintf("%.1f", mean)) %>%
+      arrange(desc(!!sym(arm_var)))
+
+    g_tbl1 <- ggplot(tbl_n, aes(x = !!sym(visit_var), y = !!sym(arm_var))) +
+      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(),
+        panel.border = element_rect(color = "black", fill = NA, linewidth = 0.5),
+        plot.margin = unit(c(0.1, 0.05, 0, 0.025), "npc"),
+        plot.title = element_text(size = 10)
+      ) +
+      labs(title = "Mean Value")
+
+    for (i in seq_len(nrow(tbl_n))) {
+      g_tbl1 <- g_tbl1 +
+        annotate("text", label = as.character(tbl_n$meanr[i]), x = tbl_n[[visit_var]][i], y = tbl_n[[arm_var]][i])
+    }
+
+    g_tbl2 <- ggplot(tbl_n, aes(x = !!sym(visit_var), y = !!sym(arm_var))) +
+      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(),
+        panel.border = element_rect(color = "black", fill = NA, linewidth = 0.2),
+        plot.margin = unit(c(0.1, 0.05, 0, 0.025), "npc"),
+        plot.title = element_text(size = 10)
+      ) +
+      labs(title = "Number of Patients with Data")
+
+    for (i in seq_len(nrow(tbl_n))) {
+      g_tbl2 <- g_tbl2 +
+        annotate("text", label = as.character(tbl_n$n[i]), x = tbl_n[[visit_var]][i], y = tbl_n[[arm_var]][i])
+    }
+
+    cowplot::plot_grid(
+      g,
+      g_tbl1,
+      g_tbl2,
+      g_legend,
+      align = "v",
+      axis = "l",
+      ncol = 1,
+      rel_heights = c(0.60, 0.15, 0.15, 0.1)
+    )
+  } else {
+    g
+  }
+}

R/fda-table_22.R

@@ -18,18 +18,16 @@
 #' @examples
 #' library(dplyr)
 #'
-#' adsl <- scda::synthetic_cdisc_dataset("rcd_2022_10_13", "adsl") %>%
+#' adsl <- random.cdisc.data::cadsl %>%
 #'   mutate(AGEGR1 = as.factor(case_when(
 #'     AGE >= 17 & AGE < 65 ~ ">=17 to <65",
 #'     AGE >= 65 ~ ">=65",
 #'     AGE >= 65 & AGE < 75 ~ ">=65 to <75",
 #'     AGE >= 75 ~ ">=75"
 #'   )) %>% formatters::with_label("Age Group, years")) %>%
-#'   formatters::var_relabel(
-#'     AGE = "Age, years"
-#'   )
+#'   formatters::var_relabel(AGE = "Age, years")
 #'
-#' adae <- scda::synthetic_cdisc_dataset("rcd_2022_10_13", "adae")
+#' adae <- random.cdisc.data::cadae
 #'
 #' df <- left_join(adsl, adae, by = intersect(names(adsl), names(adae)))
 #'

_quarto.yml

@@ -105,6 +105,7 @@ website:
           - quarto/table-templates/template-table_35.qmd
           - quarto/figure-templates/template-fig_01.qmd
           - quarto/figure-templates/template-fig_02.qmd
+          - quarto/figure-templates/template-fig_14.qmd
       - text: About
         file: quarto/about.qmd
       - text: Resources