diff --git a/R/g_lineplot.R b/R/g_lineplot.R index 2a9d88d8e4..e0cac947d1 100644 --- a/R/g_lineplot.R +++ b/R/g_lineplot.R @@ -18,6 +18,8 @@ #' subtitle. Can be `NA` if `paramcd` is not to be added to the y-axis label or subtitle. #' * `y_unit` (`string` or `NA`)\cr name of variable with units of `y`. Used for y-axis label and plot's subtitle. #' Can be `NA` if y unit is not to be added to the y-axis label or subtitle. +#' * `facet_var` (`string` or `NA`)\cr name of the secondary grouping variable used for plot faceting, i.e. treatment +#' arm. Can be `NA` to indicate lack of groups. #' @param mid (`character` or `NULL`)\cr names of the statistics that will be plotted as midpoints. #' All the statistics indicated in `mid` variable must be present in the object returned by `sfun`, #' and be of a `double` or `numeric` type vector of length one. @@ -188,6 +190,11 @@ g_lineplot <- function(df, group_var <- variables[["group_var"]] subject_var <- variables[["subject_var"]] } + if (is.na(variables["facet_var"])) { + facet_var <- NULL # NULL if facet_var == NA or it is not in variables + } else { + facet_var <- variables[["facet_var"]] + } checkmate::assert_flag(y_lab_add_paramcd, null.ok = TRUE) checkmate::assert_flag(subtitle_add_paramcd, null.ok = TRUE) if ((!is.null(y_lab) && y_lab_add_paramcd) || (!is.null(subtitle) && subtitle_add_paramcd)) { @@ -209,18 +216,20 @@ g_lineplot <- function(df, ####################################### | # ---- Compute required statistics ---- ####################################### | - if (!is.null(group_var)) { + if (!is.null(facet_var) && !is.null(group_var)) { + df_grp <- tidyr::expand(df, .data[[facet_var]], .data[[group_var]], .data[[x]]) # expand based on levels of factors + } else if (!is.null(group_var)) { df_grp <- tidyr::expand(df, .data[[group_var]], .data[[x]]) # expand based on levels of factors } else { df_grp <- tidyr::expand(df, NULL, .data[[x]]) } df_grp <- df_grp %>% - dplyr::full_join(y = df[, c(group_var, x, y)], by = c(group_var, x), multiple = "all") %>% - dplyr::group_by_at(c(group_var, x)) + dplyr::full_join(y = df[, c(facet_var, group_var, x, y)], by = c(facet_var, group_var, x), multiple = "all") %>% + dplyr::group_by_at(c(facet_var, group_var, x)) df_stats <- df_grp %>% dplyr::summarise( - data.frame(t(do.call(c, unname(sfun(.data[[y]], ...)[c(mid, interval)])))), + data.frame(t(do.call(c, unname(sfun(.data[[y]])[c(mid, interval)])))), .groups = "drop" ) @@ -234,7 +243,14 @@ g_lineplot <- function(df, colnames(df_N) <- c(group_var, "N") # nolint df_N[[strata_N]] <- paste0(df_N[[group_var]], " (N = ", df_N$N, ")") # nolint - # strata_N should not be in clonames(df_stats) + # keep strata factor levels + matches <- sapply(unique(df_N[[group_var]]), + function(x) unique(df_N[[paste0(group_var, "_N")]]) #nolint + [grepl(paste0("^", x), unique(df_N[[paste0(group_var, "_N")]]))]) + df_N[[paste0(group_var, "_N")]] <- factor(df_N[[group_var]]) #nolint + levels(df_N[[paste0(group_var, "_N")]]) <- unlist(matches) #nolint + + # strata_N should not be in colnames(df_stats) checkmate::assert_disjunct(strata_N, colnames(df_stats)) df_stats <- merge(x = df_stats, y = df_N[, c(group_var, strata_N)], by = group_var) @@ -346,6 +362,11 @@ g_lineplot <- function(df, ggplot2::scale_color_manual(values = col) } + if (!is.null(facet_var)) { + p <- p + + facet_grid(cols = vars(df_stats[[facet_var]])) + } + if (!is.null(ggtheme)) { p <- p + ggtheme } else { @@ -487,6 +508,7 @@ h_format_row <- function(x, format, labels = NULL) { #' @param strata `r lifecycle::badge("deprecated")` use the `group_var` parameter instead. #' @param subject_var (`string` or `NA`)\cr subject variable name. #' @param cohort_id `r lifecycle::badge("deprecated")` use the `subject_var` parameter instead. +#' @param facet_var (`string` or `NA`)\cr faceting variable name. #' @param paramcd (`string` or `NA`)\cr parameter code variable name. #' @param y_unit (`string` or `NA`)\cr y-axis unit variable name. #' @@ -500,6 +522,7 @@ h_format_row <- function(x, format, labels = NULL) { control_lineplot_vars <- function(x = "AVISIT", y = "AVAL", group_var = "ARM", + facet_var = NA, paramcd = "PARAMCD", y_unit = "AVALU", subject_var = "USUBJID", @@ -518,10 +541,12 @@ control_lineplot_vars <- function(x = "AVISIT", checkmate::assert_string(x) checkmate::assert_string(y) checkmate::assert_string(group_var, na.ok = TRUE, null.ok = TRUE) + checkmate::assert_string(facet_var, na.ok = TRUE, null.ok = TRUE) checkmate::assert_string(subject_var, na.ok = TRUE, null.ok = TRUE) checkmate::assert_string(paramcd, na.ok = TRUE, null.ok = TRUE) checkmate::assert_string(y_unit, na.ok = TRUE, null.ok = TRUE) - variables <- c(x = x, y = y, group_var = group_var, paramcd = paramcd, y_unit = y_unit, subject_var = subject_var) + variables <- c(x = x, y = y, group_var = group_var, paramcd = paramcd, + y_unit = y_unit, subject_var = subject_var, facet_var = facet_var) return(variables) } diff --git a/man/control_lineplot_vars.Rd b/man/control_lineplot_vars.Rd index e496116e8c..cf52768f5e 100644 --- a/man/control_lineplot_vars.Rd +++ b/man/control_lineplot_vars.Rd @@ -8,6 +8,7 @@ control_lineplot_vars( x = "AVISIT", y = "AVAL", group_var = "ARM", + facet_var = NA, paramcd = "PARAMCD", y_unit = "AVALU", subject_var = "USUBJID", @@ -22,6 +23,8 @@ control_lineplot_vars( \item{group_var}{(\code{string} or \code{NA})\cr group variable name.} +\item{facet_var}{(\code{string} or \code{NA})\cr faceting variable name.} + \item{paramcd}{(\code{string} or \code{NA})\cr parameter code variable name.} \item{y_unit}{(\code{string} or \code{NA})\cr y-axis unit variable name.} diff --git a/man/g_lineplot.Rd b/man/g_lineplot.Rd index d2ea8a1a1e..18e817b5c0 100644 --- a/man/g_lineplot.Rd +++ b/man/g_lineplot.Rd @@ -54,6 +54,8 @@ not NULL. subtitle. Can be \code{NA} if \code{paramcd} is not to be added to the y-axis label or subtitle. \item \code{y_unit} (\code{string} or \code{NA})\cr name of variable with units of \code{y}. Used for y-axis label and plot's subtitle. Can be \code{NA} if y unit is not to be added to the y-axis label or subtitle. +\item \code{facet_var} (\code{string} or \code{NA})\cr name of the secondary grouping variable used for plot faceting, i.e. treatment +arm. Can be \code{NA} to indicate lack of groups. }} \item{mid}{(\code{character} or \code{NULL})\cr names of the statistics that will be plotted as midpoints. diff --git a/tests/testthat/_snaps/g_lineplot/g_lineplot_cohorts.svg b/tests/testthat/_snaps/g_lineplot/g_lineplot_cohorts.svg index 0099953b1b..2681f7be69 100644 --- a/tests/testthat/_snaps/g_lineplot/g_lineplot_cohorts.svg +++ b/tests/testthat/_snaps/g_lineplot/g_lineplot_cohorts.svg @@ -38,90 +38,94 @@ - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - + + + + + -19 -20 -21 - - - +18 +19 +20 +21 +22 + + + + + diff --git a/tests/testthat/_snaps/g_lineplot/g_lineplot_facets.svg b/tests/testthat/_snaps/g_lineplot/g_lineplot_facets.svg new file mode 100644 index 0000000000..b79c4eaeae --- /dev/null +++ b/tests/testthat/_snaps/g_lineplot/g_lineplot_facets.svg @@ -0,0 +1,913 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +CHN + + + + + + + + + + +USA + + + + + + + + + + +BRA + + + + + + + + + + +PAK + + + + + + + + + + +NGA + + + + + + + + + + +RUS + + + + + + + + + + +JPN + + + + + + + + + + +GBR + + + + + + + + + + +CAN + + + + + + + + +BASELINE +WEEK 1 DAY 8 +WEEK 2 DAY 15 +WEEK 3 DAY 22 +WEEK 4 DAY 29 +WEEK 5 DAY 36 + + + + + + +BASELINE +WEEK 1 DAY 8 +WEEK 2 DAY 15 +WEEK 3 DAY 22 +WEEK 4 DAY 29 +WEEK 5 DAY 36 + + + + + + +BASELINE +WEEK 1 DAY 8 +WEEK 2 DAY 15 +WEEK 3 DAY 22 +WEEK 4 DAY 29 +WEEK 5 DAY 36 + + + + + + +BASELINE +WEEK 1 DAY 8 +WEEK 2 DAY 15 +WEEK 3 DAY 22 +WEEK 4 DAY 29 +WEEK 5 DAY 36 + + + + + + +BASELINE +WEEK 1 DAY 8 +WEEK 2 DAY 15 +WEEK 3 DAY 22 +WEEK 4 DAY 29 +WEEK 5 DAY 36 + + + + + + +BASELINE +WEEK 1 DAY 8 +WEEK 2 DAY 15 +WEEK 3 DAY 22 +WEEK 4 DAY 29 +WEEK 5 DAY 36 + + + + + + +BASELINE +WEEK 1 DAY 8 +WEEK 2 DAY 15 +WEEK 3 DAY 22 +WEEK 4 DAY 29 +WEEK 5 DAY 36 + + + + + + +BASELINE +WEEK 1 DAY 8 +WEEK 2 DAY 15 +WEEK 3 DAY 22 +WEEK 4 DAY 29 +WEEK 5 DAY 36 + + + + + + +BASELINE +WEEK 1 DAY 8 +WEEK 2 DAY 15 +WEEK 3 DAY 22 +WEEK 4 DAY 29 +WEEK 5 DAY 36 +-50 +0 +50 +100 + + + + +Lab Test ALT (U/L) + +Description of Planned Arm + + + + + + + + + +A: Drug X (N = 69) +B: Placebo (N = 73) +C: Combination (N = 58) +Laboratory Test: ALT (U/L) +Plot of Mean and 80% Confidence Limits by Visit +caption + + diff --git a/tests/testthat/_snaps/g_lineplot/g_lineplot_w_stats.svg b/tests/testthat/_snaps/g_lineplot/g_lineplot_w_stats.svg index 3e60bd25ee..41a8c148b4 100644 --- a/tests/testthat/_snaps/g_lineplot/g_lineplot_w_stats.svg +++ b/tests/testthat/_snaps/g_lineplot/g_lineplot_w_stats.svg @@ -38,90 +38,94 @@ - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - + + + + + -19 -20 -21 - - - +18 +19 +20 +21 +22 + + + + + diff --git a/tests/testthat/test-g_lineplot.R b/tests/testthat/test-g_lineplot.R index 0fbc8a124b..4e56b53429 100644 --- a/tests/testthat/test-g_lineplot.R +++ b/tests/testthat/test-g_lineplot.R @@ -48,3 +48,22 @@ testthat::test_that("g_lineplot works with cohort_id specified", { ) expect_snapshot_ggplot(title = "g_lineplot_cohorts", fig = g_lineplot_cohorts, width = 10, height = 8) }) + + +testthat::test_that("g_lineplot works with facet_var specified", { + g_lineplot_facets <- withr::with_options( + opts_partial_match_old, + g_lineplot( + adlb, + adsl, + variables = control_lineplot_vars(facet_var = "COUNTRY"), + mid = "median", + control = control_analyze_vars(conf_level = 0.80), + title = "Plot of Mean and 80% Confidence Limits by Visit", + y_lab = "Lab Test", + subtitle = "Laboratory Test:", + caption = "caption" + ) + ) + expect_snapshot_ggplot(title = "g_lineplot_facets", fig = g_lineplot_facets, width = 10, height = 8) +})