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 @@
+
+
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)
+})