From 0776a828ea5f10008f8ab19f2f19cad1f016d251 Mon Sep 17 00:00:00 2001 From: certara-jcraig <61294078+certara-jcraig@users.noreply.github.com> Date: Wed, 16 Aug 2023 06:41:24 -0700 Subject: [PATCH 1/3] split plot generic into separate internal functions --- R/plot.R | 547 ++++++++++++++++++++++++++++++++++++------------------- 1 file changed, 357 insertions(+), 190 deletions(-) diff --git a/R/plot.R b/R/plot.R index 5d58efe..2643394 100644 --- a/R/plot.R +++ b/R/plot.R @@ -58,187 +58,40 @@ plot.tidyvpcobj <- function(x, xbin <- lo <- hi <- qname <- md <- y <- xleft <- xright <- ypc <- l.ypc <- bin <- blq <- alq <- pname <- NULL . <- list - point_shape_vec <- c("circle" = 1, "circle-fill" = 19, "diamond" = 5, "diamond-fill" = 18, - "square" = 0, "square-fill" = 15, "triangle-fill" = 17, "triangle" = 2) - if(!point.shape %in% names(point_shape_vec)) - stop(paste0("point.shape must be one of ", paste0(names(point_shape_vec), collapse = ", "))) - - point.shape <- as.numeric(point_shape_vec[names(point_shape_vec) == point.shape]) - vpc <- x - vpc.type <- vpc$vpc.type - - if(is.null(vpc.type)) vpc.type <- "continuous" - - qlvls <- levels(vpc$stats$qname) - qlbls <- paste0(100*as.numeric(sub("^q", "", qlvls)), "%") - - if (isTRUE(vpc$predcor)) { - ylab <- paste0(ylab, "\nPrediction Corrected") - } - - has_ggplot2 <- requireNamespace("ggplot2", quietly=TRUE) - if (!has_ggplot2) { - stop("Package 'ggplot2' is required for plotting. Please install it to use this method.") - } - - if(vpc.type == "continuous"){ - if (show.stats) { - if (!is.null(vpc$rqss.obs.fits)) { - g <- ggplot2::ggplot(vpc$stats, ggplot2::aes(x = x)) + - ggplot2::geom_ribbon(ggplot2::aes(ymin=lo, ymax=hi, fill=qname, col=qname, group=qname), alpha=ribbon.alpha, col=NA) + - ggplot2::geom_line(ggplot2::aes(y=md, col=qname, group=qname)) + - ggplot2::geom_line(ggplot2::aes(y=y, linetype=qname), linewidth=1) + - ggplot2::scale_colour_manual( - name=sprintf("Simulated Percentiles\nMedian (lines) %s%% CI (areas)", 100*vpc$conf.level), - values=color, - breaks=qlvls, - labels=qlbls) + - ggplot2::scale_fill_manual( - name=sprintf("Simulated Percentiles\nMedian (lines) %s%% CI (areas)", 100*vpc$conf.level), - values=color, - breaks=qlvls, - labels=qlbls) + - ggplot2::scale_linetype_manual( - name="Observed Percentiles\n(black lines)", - values=linetype, - breaks=qlvls, - labels=qlbls) + - ggplot2::guides( - fill=ggplot2::guide_legend(order=2), - colour=ggplot2::guide_legend(order=2), - linetype=ggplot2::guide_legend(order=1)) + - ylab(sprintf("Observed/Simulated probabilities and associated %s%% CI", 100*vpc$conf.level)) + - xlab("TIME") - } else { - g <- ggplot2::ggplot(vpc$stats, ggplot2::aes(x = xbin)) + - ggplot2::geom_ribbon(ggplot2::aes(ymin=lo, ymax=hi, fill=qname, col=qname, group=qname), alpha=ribbon.alpha, col=NA) + - ggplot2::geom_line(ggplot2::aes(y=md, col=qname, group=qname)) + - ggplot2::geom_line(ggplot2::aes(y=y, linetype=qname), linewidth=1) + - ggplot2::scale_colour_manual( - name=sprintf("Simulated Percentiles\nMedian (lines) %s%% CI (areas)", 100*vpc$conf.level), - values=color, - breaks=qlvls, - labels=qlbls) + - ggplot2::scale_fill_manual( - name=sprintf("Simulated Percentiles\nMedian (lines) %s%% CI (areas)", 100*vpc$conf.level), - values=color, - breaks=qlvls, - labels=qlbls) + - ggplot2::scale_linetype_manual( - name="Observed Percentiles\n(black lines)", - values=linetype, - breaks=qlvls, - labels=qlbls) + - ggplot2::guides( - fill=ggplot2::guide_legend(order=2), - colour=ggplot2::guide_legend(order=2), - linetype=ggplot2::guide_legend(order=1)) + - ylab(sprintf("Observed/Simulated probabilities and associated %s%% CI", 100*vpc$conf.level)) + - xlab("TIME") - } - } else { - g <- ggplot2::ggplot(vpc$strat) - } - - if (show.points) { - points.dat <- copy(vpc$obs) - if (isTRUE(vpc$predcor)) { - if(isTRUE(vpc$loess.ypc)) { - points.dat[, y := l.ypc] - } else { - points.dat[, y := ypc] - } - } - if (show.binning) { - reorder2 <- function(y, x) { - y <- stats::reorder(y, x) - (1:nlevels(y))[y] - } - points.dat[, color := reorder2(factor(bin), x), by=vpc$strat] - points.dat[, color := factor(color)] - points.dat <- points.dat[!(blq|alq)] - g <- g + ggplot2::geom_point(data=points.dat, ggplot2::aes(x=x, y=y, color=color), - size=point.size, alpha=point.alpha, shape = point.shape, stroke = point.stroke, show.legend=FALSE) + - ggplot2::scale_color_brewer(palette="Set1") - } else { - points.dat <- points.dat[!(blq|alq)] - g <- g + ggplot2::geom_point(data=points.dat, ggplot2::aes(x=x, y=y), - size=point.size, shape = point.shape, stroke = point.stroke, alpha=point.alpha) - } - } - - if (show.boundaries) { - if(is.null(vpc$rqss.obs.fits)) { - if (!is.null(vpc$strat)) { - boundaries <- bininfo(vpc)[, .(x=sort(unique(c(xleft, xright)))), by=names(vpc$strat)] - } else { - boundaries <- bininfo(vpc)[, .(x=sort(unique(c(xleft, xright))))] - } - if (show.binning) { - g <- g + ggplot2::geom_vline(data=boundaries, ggplot2::aes(xintercept=x), linewidth=ggplot2::rel(0.5), col="gray80") + - ggplot2::theme(panel.grid=ggplot2::element_blank()) - } - g <- g + ggplot2::geom_rug(data=boundaries, ggplot2::aes(x=x), sides="t", linewidth=1) - } - } - - if(facet){ - if (!is.null(vpc$strat)) { - g <- g + ggplot2::facet_grid(as.formula(paste("qname ~", paste0(names(vpc$strat), collapse = " + "), sep = " ")), scales=facet.scales, as.table = FALSE) - } else { - g <- g + ggplot2::facet_grid(qname ~ ., scales=facet.scales, as.table =FALSE ) - } - } else { - if (!is.null(vpc$strat)) { - if(length(as.list(vpc$strat.formula)) == 3) { - g <- g + ggplot2::facet_grid(vpc$strat.formula, scales=facet.scales) - } else { - g <- g + ggplot2::facet_wrap(names(vpc$strat), scales=facet.scales) - } - } - } - + vpc_type <- vpc$vpc.type + + if(is.null(vpc_type)) vpc_type <- "continuous" + + if(vpc_type == "continuous"){ + g <- + plot_continuous( + vpc, + show.stats, + show.points, + show.boundaries, + show.binning, + ribbon.alpha, + color, + linetype, + facet, + facet.scales, + point.size, point.shape, point.stroke, point.alpha + ) } else { - if(vpc$vpc.method$method == "binless"){ - g <- ggplot(vpc$stats, aes(x = x)) + - geom_ribbon(aes(ymin = lo, ymax = hi, fill = pname, col = pname, group = pname), alpha = ribbon.alpha, col = NA) + - geom_line(aes(y = md, col = pname, group = pname)) + - geom_line(aes(y = y, linetype = pname), linewidth = 1) + - geom_point(aes(x = x, y = y), size = point.size, alpha = point.alpha, shape = point.shape, stroke = point.stroke) + - ylab(sprintf("Observed/Simulated probabilities and associated %s%% CI", 100*vpc$conf.level)) + - xlab("TIME") + - scale_colour_manual(name = sprintf("Simulated \nMedian (lines) %s%% CI (areas)",100*vpc$conf.level) , breaks = levels(vpc$stats$pname), values = .get_colors(length(levels(vpc$stats$pname))), labels = levels(vpc$stats$pname)) + - scale_fill_manual(name = sprintf("Simulated \nMedian (lines) %s%% CI (areas)",100*vpc$conf.level), breaks = levels(vpc$stats$pname), values = .get_colors(length(levels(vpc$stats$pname))), labels = levels(vpc$stats$pname)) + - scale_linetype_manual(name = "Observed \nMedian (lines)", breaks = levels(vpc$stats$pname), values = .get_lines(length(levels(vpc$stats$pname))), labels = levels(vpc$stats$pname)) + - guides(fill = guide_legend(order = 2), colour = guide_legend(order = 2), linetype = guide_legend(order = 1)) - } else { - g <- ggplot(vpc$stats, aes(x = xbin)) + - geom_ribbon(aes(ymin = lo, ymax = hi, fill = pname, col = pname, group = pname), alpha = ribbon.alpha, col = NA) + - geom_line(aes(y = md, col = pname, group = pname)) + - geom_line(aes(y = y, linetype = pname), linewidth = 1) + - geom_point(aes(x = xbin, y = y), size = point.size, alpha = point.alpha, shape = point.shape, stroke = point.stroke) + - ylab(sprintf("Observed/Simulated probabilities and associated %s%% CI", 100*vpc$conf.level)) + - xlab("TIME") + - scale_colour_manual(name = sprintf("Simulated \nMedian (lines) %s%% CI (areas)",100*vpc$conf.level), breaks = levels(vpc$stats$pname), values = .get_colors(length(levels(vpc$stats$pname))), labels = levels(vpc$stats$pname)) + - scale_fill_manual(name = sprintf("Simulated \nMedian (lines) %s%% CI (areas)",100*vpc$conf.level), breaks = levels(vpc$stats$pname), values = .get_colors(length(levels(vpc$stats$pname))), labels = levels(vpc$stats$pname)) + - scale_linetype_manual(name = "Observed \nMedian (lines)", breaks = levels(vpc$stats$pname), values = .get_lines(length(levels(vpc$stats$pname))), labels = levels(vpc$stats$pname)) + - guides(fill = guide_legend(order = 2), colour = guide_legend(order = 2), linetype = guide_legend(order = 1)) - } - - if(facet){ - if (!is.null(vpc$strat)) { - g <- g + ggplot2::facet_grid(as.formula(paste(paste0(names(vpc$strat), collapse = " + "), "~", "pname", sep = " ")), scales=facet.scales, as.table = TRUE, labeller = label_both) - } else { - g <- g + ggplot2::facet_grid(~ pname, scales=facet.scales, as.table = FALSE, labeller = label_both) - } - } else { - if (!is.null(vpc$strat)) { - g <- g + ggplot2::facet_wrap(names(vpc$strat), scales=facet.scales, label = label_both) - } - } - + g <- + plot_categorical( + vpc, + ribbon.alpha, + facet, + facet.scales, + point.size, + point.shape, + point.stroke, + point.alpha + ) + } @@ -246,12 +99,30 @@ plot.tidyvpcobj <- function(x, g <- g + eval(parse(text = paste0(custom.theme, "()"))) + tidyvpc_theme(legend.position = legend.position) + # add labels + if (is.null(xlab)) { + xlab <- "TIME" + } + + if (is.null(ylab)) { + ylab <- + sprintf("Observed/Simulated probabilities and associated %s%% CI", + 100 * vpc$conf.level) + if (isTRUE(vpc$predcor)) { + ylab <- paste0(ylab, "\nPrediction Corrected") + } + } + + g <- g + ggplot2::xlab(xlab) + g <- g + ggplot2::ylab(ylab) + + # blq/alq plot censoring.type <- match.arg(censoring.type) censoring.output <- match.arg(censoring.output) grid_args <- as.list(substitute(list(...))) - if (vpc.type == "continuous" && censoring.type != "none") { + if (vpc_type == "continuous" && censoring.type != "none") { g_blq <- g_alq <- NULL if (censoring.type %in% c("both", "blq")) { @@ -274,8 +145,10 @@ plot.tidyvpcobj <- function(x, is.null(x) || is.symbol(x))] if (censoring.output == "grid") { + #Return egg g <- do.call(egg::ggarrange, grid_list) } else { + #Return list g <- setdiff(grid_list, grid_args) } } @@ -284,18 +157,306 @@ plot.tidyvpcobj <- function(x, } +plot_continuous <- + function(vpc, + show.stats, + show.points, + show.boundaries, + show.binning, + ribbon.alpha, + color, + linetype, + facet, + facet.scales, + point.size, + point.shape, + point.stroke, + point.alpha) { + alq <-bin <- blq <- hi <-l.ypc <-lo <- md <- pname <- qname <- x <- xleft <- xright <- y <- ypc <- NULL + . <- list + method <- vpc$vpc.method$method + qlvls <- levels(vpc$stats$qname) + qlbls <- paste0(100 * as.numeric(sub("^q", "", qlvls)), "%") + point_shape_vec <- .get_point_shapes() + if (!point.shape %in% names(point_shape_vec)) + stop(paste0("point.shape must be one of ", paste0(names(point_shape_vec), collapse = ", "))) + point.shape <- + as.numeric(point_shape_vec[names(point_shape_vec) == point.shape]) + + if (method == "binning") { + xvar <- "xbin" + } else { + xvar <- "x" + } + + if (show.stats) { + g <- ggplot2::ggplot(vpc$stats, ggplot2::aes(x = !!sym(xvar))) + + ggplot2::geom_ribbon( + ggplot2::aes( + ymin = lo, + ymax = hi, + fill = qname, + col = qname, + group = qname + ), + alpha = ribbon.alpha, + col = NA + ) + + ggplot2::geom_line(ggplot2::aes(y = md, col = qname, group = qname)) + + ggplot2::geom_line(ggplot2::aes(y = y, linetype = qname), linewidth = + 1) + + ggplot2::scale_colour_manual( + name = sprintf( + "Simulated Percentiles\nMedian (lines) %s%% CI (areas)", + 100 * vpc$conf.level + ), + values = color, + breaks = qlvls, + labels = qlbls + ) + + ggplot2::scale_fill_manual( + name = sprintf( + "Simulated Percentiles\nMedian (lines) %s%% CI (areas)", + 100 * vpc$conf.level + ), + values = color, + breaks = qlvls, + labels = qlbls + ) + + ggplot2::scale_linetype_manual( + name = "Observed Percentiles\n(black lines)", + values = linetype, + breaks = qlvls, + labels = qlbls + ) + + ggplot2::guides( + fill = ggplot2::guide_legend(order = 2), + colour = ggplot2::guide_legend(order = 2), + linetype = ggplot2::guide_legend(order = 1) + ) + } else { + g <- ggplot2::ggplot(vpc$strat) + } + + if (show.points) { + points.dat <- copy(vpc$obs) + if (isTRUE(vpc$predcor) && method == "binless") { + points.dat[, y := l.ypc] + } else if (isTRUE(vpc$predcor)) { + points.dat[, y := ypc] + } + if (show.binning) { + reorder2 <- function(y, x) { + y <- stats::reorder(y, x) + (1:nlevels(y))[y] + } + points.dat[, color := reorder2(factor(bin), x), by = vpc$strat] + points.dat[, color := factor(color)] + points.dat <- points.dat[!(blq | alq)] + g <- + g + ggplot2::geom_point( + data = points.dat, + ggplot2::aes(x = x, y = y, color = color), + size = point.size, + alpha = point.alpha, + shape = point.shape, + stroke = point.stroke, + show.legend = FALSE + ) + + ggplot2::scale_color_brewer(palette = "Set1") + } else { + points.dat <- points.dat[!(blq | alq)] + g <- + g + ggplot2::geom_point( + data = points.dat, + ggplot2::aes(x = x, y = y), + size = point.size, + shape = point.shape, + stroke = point.stroke, + alpha = point.alpha + ) + } + } + + if (show.boundaries && method == "binning") { + if (!is.null(vpc$strat)) { + boundaries <- + bininfo(vpc)[, .(x = sort(unique(c(xleft, xright)))), by = names(vpc$strat)] + } else { + boundaries <- bininfo(vpc)[, .(x = sort(unique(c(xleft, xright))))] + } + if (show.binning) { + g <- + g + ggplot2::geom_vline( + data = boundaries, + ggplot2::aes(xintercept = x), + linewidth = ggplot2::rel(0.5), + col = "gray80" + ) + + ggplot2::theme(panel.grid = ggplot2::element_blank()) + } + g <- + g + ggplot2::geom_rug( + data = boundaries, + ggplot2::aes(x = x), + sides = "t", + linewidth = 1 + ) + } + + if (facet) { + if (!is.null(vpc$strat)) { + g <- + g + ggplot2::facet_grid(as.formula(paste( + "qname ~", paste0(names(vpc$strat), collapse = " + "), sep = " " + )), + scales = facet.scales, + as.table = FALSE) + } else { + g <- + g + ggplot2::facet_grid(qname ~ ., scales = facet.scales, as.table = FALSE) + } + } else { + if (!is.null(vpc$strat)) { + if (length(as.list(vpc$strat.formula)) == 3) { + g <- g + ggplot2::facet_grid(vpc$strat.formula, scales = facet.scales) + } else { + g <- g + ggplot2::facet_wrap(names(vpc$strat), scales = facet.scales) + } + } + } + g + } + + +plot_categorical <- + function(vpc, + ribbon.alpha, + facet, + facet.scales, + point.size, + point.shape, + point.stroke, + point.alpha) { + + y <- md <- pname <- hi <- lo <- NULL + + method <- vpc$vpc.method$method + if (method == "binning") { + xvar <- "xbin" + } else { + xvar <- "x" + } + + point_shape_vec <- .get_point_shapes() + if (!point.shape %in% names(point_shape_vec)) + stop(paste0("point.shape must be one of ", paste0(names(point_shape_vec), collapse = ", "))) + point.shape <- + as.numeric(point_shape_vec[names(point_shape_vec) == point.shape]) + + g <- ggplot(vpc$stats, aes(x = !!sym(xvar))) + + geom_ribbon( + aes( + ymin = lo, + ymax = hi, + fill = pname, + col = pname, + group = pname + ), + alpha = ribbon.alpha, + col = NA + ) + + geom_line(aes(y = md, col = pname, group = pname)) + + geom_line(aes(y = y, linetype = pname), linewidth = 1) + + geom_point( + aes(x = !!sym(xvar), y = y), + size = point.size, + alpha = point.alpha, + shape = point.shape, + stroke = point.stroke + ) + + scale_colour_manual( + name = sprintf( + "Simulated \nMedian (lines) %s%% CI (areas)", + 100 * vpc$conf.level + ) , + breaks = levels(vpc$stats$pname), + values = .get_colors(length(levels(vpc$stats$pname))), + labels = levels(vpc$stats$pname) + ) + + scale_fill_manual( + name = sprintf( + "Simulated \nMedian (lines) %s%% CI (areas)", + 100 * vpc$conf.level + ), + breaks = levels(vpc$stats$pname), + values = .get_colors(length(levels(vpc$stats$pname))), + labels = levels(vpc$stats$pname) + ) + + scale_linetype_manual( + name = "Observed \nMedian (lines)", + breaks = levels(vpc$stats$pname), + values = .get_lines(length(levels(vpc$stats$pname))), + labels = levels(vpc$stats$pname) + ) + + guides( + fill = guide_legend(order = 2), + colour = guide_legend(order = 2), + linetype = guide_legend(order = 1) + ) + + if (facet) { + if (!is.null(vpc$strat)) { + g <- + g + ggplot2::facet_grid( + as.formula(paste( + paste0(names(vpc$strat), collapse = " + "), "~", "pname", sep = " " + )), + scales = facet.scales, + as.table = TRUE, + labeller = label_both + ) + } else { + g <- + g + ggplot2::facet_grid( + ~ pname, + scales = facet.scales, + as.table = FALSE, + labeller = label_both + ) + } + } else { + if (!is.null(vpc$strat)) { + g <- + g + ggplot2::facet_wrap(names(vpc$strat), scales = facet.scales, label = label_both) + } + } + + return(g) + + } + + plot_censored <- - function(x, + function(vpc, type = c("blq", "alq"), facet.scales = c("free", "fixed"), ...) { - stopifnot(inherits(x, "tidyvpcobj")) + + stopifnot(inherits(vpc, "tidyvpcobj")) hi <- lo <- md <- xbin <- y <- NULL + method <- vpc$vpc.method$method + if(method == "binning") { + xvar <- "xbin" + } else { + xvar <- "x" + } + type <- match.arg(type) df_name <- paste0("pct", type) - df <- x[[df_name]] + df <- vpc[[df_name]] if (is.null(df)) { stop( df_name, @@ -307,20 +468,20 @@ plot_censored <- g <- ggplot(df) - if (!is.null(x$strat)) { - if (length(as.list(x$strat.formula)) == 3) { - g <- g + ggplot2::facet_grid(x$strat.formula, scales = facet.scales) + if (!is.null(vpc$strat)) { + if (length(as.list(vpc$strat.formula)) == 3) { + g <- g + ggplot2::facet_grid(vpc$strat.formula, scales = facet.scales) } else { - g <- g + ggplot2::facet_wrap(names(x$strat), scales = facet.scales) + g <- g + ggplot2::facet_wrap(names(vpc$strat), scales = facet.scales) } } g <- g + - geom_ribbon(aes(x = xbin, ymin = lo, ymax = hi), + geom_ribbon(aes(x = !!sym(xvar), ymin = lo, ymax = hi), fill = "red", alpha = .2) + - geom_line(aes(x = xbin, y = md, color = "simulated")) + - geom_line(aes(x = xbin, y = y, color = "observed")) + + geom_line(aes(x = !!sym(xvar), y = md, color = "simulated")) + + geom_line(aes(x = !!sym(xvar), y = y, color = "observed")) + ggplot2::scale_colour_manual( name = paste0( "Percentage of ", @@ -358,9 +519,15 @@ plot_censored <- lines[1:n] } +.get_point_shapes <- function(){ + point_shape_vec <- c("circle" = 1, "circle-fill" = 19, "diamond" = 5, "diamond-fill" = 18, + "square" = 0, "square-fill" = 15, "triangle-fill" = 17, "triangle" = 2) +} + tidyvpc_theme <- function(legend.position) { ggplot2::theme( - legend.text = ggplot2::element_text(size = 6), + legend.title = ggplot2::element_text(size = 10), + legend.text = ggplot2::element_text(size = 7), legend.position = legend.position, legend.spacing = unit(.1, "cm"), legend.direction = "horizontal", From 87cd11f169b42acf1ae3d2ba9556818d6d044755 Mon Sep 17 00:00:00 2001 From: certara-jcraig <61294078+certara-jcraig@users.noreply.github.com> Date: Wed, 16 Aug 2023 10:14:46 -0700 Subject: [PATCH 2/3] support custom.theme arg as function or object of class theme --- R/plot.R | 48 ++++++++++++++++++++++++++++++------------ man/plot.tidyvpcobj.Rd | 4 ++-- 2 files changed, 36 insertions(+), 16 deletions(-) diff --git a/R/plot.R b/R/plot.R index 2643394..9ab30dd 100644 --- a/R/plot.R +++ b/R/plot.R @@ -23,7 +23,7 @@ #' \code{"top", "bottom", "left", "right"}. #' @param facet.scales A character string specifying the \code{scales} argument to use for faceting. Options #' are \code{"free", "fixed"}. -#' @param custom.theme A character string specifying theme from ggplot2 package. +#' @param custom.theme A custom ggplot2 theme supplied either as a character string, function, or object of class \code{"theme"}. #' @param censoring.type A character string specifying additional blq/alq plots to include. Only applicable if #' \code{\link{censoring}} was performed. #' @param censoring.output A character string specifying whether to return percentage of blq/alq plots as an @@ -50,7 +50,7 @@ plot.tidyvpcobj <- function(x, ribbon.alpha = 0.1, legend.position="top", facet.scales="free", - custom.theme = "ggplot2::theme_bw", + custom.theme = NULL, censoring.type = c("none", "both", "blq", "alq"), censoring.output = c("grid", "list"), ...) { @@ -94,22 +94,31 @@ plot.tidyvpcobj <- function(x, } - - # add theme - g <- g + eval(parse(text = paste0(custom.theme, "()"))) + - tidyvpc_theme(legend.position = legend.position) + + # add theme + if (is.null(custom.theme)) { + g <- g + ggplot2::theme_bw() + tidyvpc_theme(legend.position = legend.position) + } else if (is.character(custom.theme)) { + g <- g + eval(parse(text = paste0(custom.theme, "()"))) + } else if (is.function(custom.theme)) { + g <- g + custom.theme() + } else if (inherits(custom.theme, "theme")) { + g <- g + custom.theme + } # add labels if (is.null(xlab)) { xlab <- "TIME" } - + if (is.null(ylab)) { ylab <- sprintf("Observed/Simulated probabilities and associated %s%% CI", 100 * vpc$conf.level) if (isTRUE(vpc$predcor)) { - ylab <- paste0(ylab, "\nPrediction Corrected") + ylab <- ifelse(length(ylab) == 0, + "Prediction Corrected", + paste0(ylab, "\nPrediction Corrected")) } } @@ -126,15 +135,13 @@ plot.tidyvpcobj <- function(x, g_blq <- g_alq <- NULL if (censoring.type %in% c("both", "blq")) { - g_blq <- plot_censored(vpc, type = "blq", facet.scales) + - eval(parse(text = paste0(custom.theme, "()"))) + - tidyvpc_theme(legend.position = legend.position) + g_blq <- + plot_censored(vpc, type = "blq", facet.scales, custom.theme, legend.position) } if (censoring.type %in% c("both", "alq")) { - g_alq <- plot_censored(vpc, type = "alq", facet.scales) + - eval(parse(text = paste0(custom.theme, "()"))) + - tidyvpc_theme(legend.position = legend.position) + g_alq <- + plot_censored(vpc, type = "alq", facet.scales, custom.theme, legend.position) } grid_list <- @@ -441,6 +448,8 @@ plot_censored <- function(vpc, type = c("blq", "alq"), facet.scales = c("free", "fixed"), + custom.theme, + legend.position, ...) { stopifnot(inherits(vpc, "tidyvpcobj")) @@ -494,6 +503,17 @@ plot_censored <- ) + labs(x = "TIME", y = paste0("% ", toupper(type))) + # add theme + if (is.null(custom.theme)) { + g <- g + ggplot2::theme_bw() + tidyvpc_theme(legend.position = legend.position) + } else if (is.character(custom.theme)) { + g <- g + eval(parse(text = paste0(custom.theme, "()"))) + } else if (is.function(custom.theme)) { + g <- g + custom.theme() + } else if (inherits(custom.theme, "theme")) { + g <- g + custom.theme + } + return(g) } diff --git a/man/plot.tidyvpcobj.Rd b/man/plot.tidyvpcobj.Rd index 1044eff..f6c8169 100644 --- a/man/plot.tidyvpcobj.Rd +++ b/man/plot.tidyvpcobj.Rd @@ -22,7 +22,7 @@ ribbon.alpha = 0.1, legend.position = "top", facet.scales = "free", - custom.theme = "ggplot2::theme_bw", + custom.theme = NULL, censoring.type = c("none", "both", "blq", "alq"), censoring.output = c("grid", "list"), ... @@ -67,7 +67,7 @@ category (categorical VPC).} \item{facet.scales}{A character string specifying the \code{scales} argument to use for faceting. Options are \code{"free", "fixed"}.} -\item{custom.theme}{A character string specifying theme from ggplot2 package.} +\item{custom.theme}{A custom ggplot2 theme supplied either as a character string, function, or object of class \code{"theme"}.} \item{censoring.type}{A character string specifying additional blq/alq plots to include. Only applicable if \code{\link{censoring}} was performed.} From 23079985d5a06776d615b3ec8d48c507404104c5 Mon Sep 17 00:00:00 2001 From: certara-jcraig <61294078+certara-jcraig@users.noreply.github.com> Date: Wed, 16 Aug 2023 10:17:04 -0700 Subject: [PATCH 3/3] add snapshot tests for plot.tidyvpcobj --- DESCRIPTION | 3 +- .../_snaps/plot/bins-without-stats.svg | 548 ++++ .../_snaps/plot/bins-ypc-without-stats.svg | 538 ++++ .../_snaps/plot/censored-plot-with-aql.svg | 1876 +++++++++++++ .../plot/censored-plot-with-bql-aql.svg | 2436 +++++++++++++++++ .../_snaps/plot/censored-plot-with-bql.svg | 1890 +++++++++++++ ...ne-sided-strat-formula-with-facet-wrap.svg | 891 ++++++ ...wo-sided-strat-formula-with-facet-grid.svg | 895 ++++++ tests/testthat/test-plot.R | 106 + 9 files changed, 9182 insertions(+), 1 deletion(-) create mode 100644 tests/testthat/_snaps/plot/bins-without-stats.svg create mode 100644 tests/testthat/_snaps/plot/bins-ypc-without-stats.svg create mode 100644 tests/testthat/_snaps/plot/censored-plot-with-aql.svg create mode 100644 tests/testthat/_snaps/plot/censored-plot-with-bql-aql.svg create mode 100644 tests/testthat/_snaps/plot/censored-plot-with-bql.svg create mode 100644 tests/testthat/_snaps/plot/one-sided-strat-formula-with-facet-wrap.svg create mode 100644 tests/testthat/_snaps/plot/two-sided-strat-formula-with-facet-grid.svg create mode 100644 tests/testthat/test-plot.R diff --git a/DESCRIPTION b/DESCRIPTION index 981bbe9..875c73e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -52,7 +52,8 @@ Suggests: remotes, vpc, rmarkdown, - testthat (>= 2.1.0) + testthat (>= 2.1.0), + vdiffr (>= 1.0.0) License: MIT + file LICENSE LazyData: true Encoding: UTF-8 diff --git a/tests/testthat/_snaps/plot/bins-without-stats.svg b/tests/testthat/_snaps/plot/bins-without-stats.svg new file mode 100644 index 0000000..2a49aa1 --- /dev/null +++ b/tests/testthat/_snaps/plot/bins-without-stats.svg @@ -0,0 +1,548 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +50 +100 +150 +200 +250 + + + + + + + + + + +0 +5 +10 +15 +TIME +Bins without stats + + diff --git a/tests/testthat/_snaps/plot/bins-ypc-without-stats.svg b/tests/testthat/_snaps/plot/bins-ypc-without-stats.svg new file mode 100644 index 0000000..ba80b35 --- /dev/null +++ b/tests/testthat/_snaps/plot/bins-ypc-without-stats.svg @@ -0,0 +1,538 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +100 +200 + + + + + + + +0 +5 +10 +15 +TIME +Prediction Corrected +Bins ypc without stats + + diff --git a/tests/testthat/_snaps/plot/censored-plot-with-aql.svg b/tests/testthat/_snaps/plot/censored-plot-with-aql.svg new file mode 100644 index 0000000..3c3c60b --- /dev/null +++ b/tests/testthat/_snaps/plot/censored-plot-with-aql.svg @@ -0,0 +1,1876 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +50 +100 +150 + + + + + + + + +Observed/Simulated probabilities and associated 95% CI + + + + + + + + + + + + + + + + + + + + + + +0 +10 +20 +30 + + + + + + + + +% ALQ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Study A + + + + + + + + + + +Study B + + + + + + + + + + + + + + + + + +Observed Percentiles +(black lines) + + + + + + +10% +50% +90% + +Simulated Percentiles +Median (lines) 95% CI (areas) + + + + + + + + + +10% +50% +90% + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Study A + + + + + + + + + + +Study B + + + + + + + + + + + + + + + + + +Percentage of ALQ +Median (lines) 95% CI (areas) + + + + + + +observed +simulated + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +50 +100 +150 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +20 +40 + + + + + + + + + + + + + + + + + + + + + + + + +0 +5 +10 +15 + + + + + + + +0 +5 +10 + + + + +TIME + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +2.5 +5.0 +7.5 +10.0 +12.5 + + + + + + + + + +0.0 +2.5 +5.0 +7.5 +10.0 + + + + +TIME + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +50 +100 +150 + + + + + + + + +Observed/Simulated probabilities and associated 95% CI + + + + + + + + + + + + +0 +10 +20 +30 + + + + + + + + +% ALQ + + + + + + + + + + + + + + + + + + + + + +Study A + + + + + +Study B + + + + + + + + + + + + + + + + + +Observed Percentiles +(black lines) + + + + + + +10% +50% +90% + +Simulated Percentiles +Median (lines) 95% CI (areas) + + + + + + + + + +10% +50% +90% + + + + + + + + + + + + + + + + + + + + + +Study A + + + + + +Study B + + + + + + + + + + + + + + + + + +Percentage of ALQ +Median (lines) 95% CI (areas) + + + + + + +observed +simulated + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +50 +100 +150 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +20 +40 + + + + + + + + + + + + + + + + + + + +0 +5 +10 +15 + + + + + + + +0 +5 +10 + + + + +TIME + + + + + + + + + + + + + + + + + + + + + + +0.0 +2.5 +5.0 +7.5 +10.0 +12.5 + + + + + + + + + +0.0 +2.5 +5.0 +7.5 +10.0 + + + + +TIME + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/plot/censored-plot-with-bql-aql.svg b/tests/testthat/_snaps/plot/censored-plot-with-bql-aql.svg new file mode 100644 index 0000000..75e8e94 --- /dev/null +++ b/tests/testthat/_snaps/plot/censored-plot-with-bql-aql.svg @@ -0,0 +1,2436 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +50 +100 +150 + + + + + + + + +Observed/Simulated probabilities and associated 95% CI + + + + + + + + + + + + + + + + + + + + + + +0 +25 +50 +75 +100 + + + + + + + + + +% BLQ + + + + + + + + + + + + + + + + + + + + + + +0 +10 +20 +30 + + + + + + + + +% ALQ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Study A + + + + + + + + + + +Study B + + + + + + + + + + + + + + + + + +Observed Percentiles +(black lines) + + + + + + +10% +50% +90% + +Simulated Percentiles +Median (lines) 95% CI (areas) + + + + + + + + + +10% +50% +90% + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Study A + + + + + + + + + + +Study B + + + + + + + + + + + + + + + + + +Percentage of BLQ +Median (lines) 95% CI (areas) + + + + + + +observed +simulated + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Study A + + + + + + + + + + +Study B + + + + + + + + + + + + + + + + + +Percentage of ALQ +Median (lines) 95% CI (areas) + + + + + + +observed +simulated + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +50 +100 +150 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +20 +40 +60 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +20 +40 + + + + + + + + + + + + + + + + + + + + + + + + +0 +5 +10 +15 + + + + + + + +0 +5 +10 + + + + +TIME + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +2.5 +5.0 +7.5 +10.0 +12.5 + + + + + + + + + +0.0 +2.5 +5.0 +7.5 +10.0 + + + + +TIME + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +2.5 +5.0 +7.5 +10.0 +12.5 + + + + + + + + + +0.0 +2.5 +5.0 +7.5 +10.0 + + + + +TIME + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +50 +100 +150 + + + + + + + + +Observed/Simulated probabilities and associated 95% CI + + + + + + + + + + + + +0 +25 +50 +75 +100 + + + + + + + + + +% BLQ + + + + + + + + + + + + +0 +10 +20 +30 + + + + + + + + +% ALQ + + + + + + + + + + + + + + + + + + + + + + + + + +Study A + + + + + +Study B + + + + + + + + + + + + + + + + + +Observed Percentiles +(black lines) + + + + + + +10% +50% +90% + +Simulated Percentiles +Median (lines) 95% CI (areas) + + + + + + + + + +10% +50% +90% + + + + + + + + + + + + + + + + + + + + + +Study A + + + + + +Study B + + + + + + + + + + + + + + + + + +Percentage of BLQ +Median (lines) 95% CI (areas) + + + + + + +observed +simulated + + + + + + + + + + + + + + + + + + + + + +Study A + + + + + +Study B + + + + + + + + + + + + + + + + + +Percentage of ALQ +Median (lines) 95% CI (areas) + + + + + + +observed +simulated + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +50 +100 +150 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +20 +40 +60 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +20 +40 + + + + + + + + + + + + + + + + + + + +0 +5 +10 +15 + + + + + + + +0 +5 +10 + + + + +TIME + + + + + + + + + + + + + + + + + + + + + + +0.0 +2.5 +5.0 +7.5 +10.0 +12.5 + + + + + + + + + +0.0 +2.5 +5.0 +7.5 +10.0 + + + + +TIME + + + + + + + + + + + + + + + + + + + + + + +0.0 +2.5 +5.0 +7.5 +10.0 +12.5 + + + + + + + + + +0.0 +2.5 +5.0 +7.5 +10.0 + + + + +TIME + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/plot/censored-plot-with-bql.svg b/tests/testthat/_snaps/plot/censored-plot-with-bql.svg new file mode 100644 index 0000000..e6d9fb5 --- /dev/null +++ b/tests/testthat/_snaps/plot/censored-plot-with-bql.svg @@ -0,0 +1,1890 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +50 +100 +150 + + + + + + + + +Observed/Simulated probabilities and associated 95% CI + + + + + + + + + + + + + + + + + + + + + + +0 +25 +50 +75 +100 + + + + + + + + + +% BLQ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Study A + + + + + + + + + + +Study B + + + + + + + + + + + + + + + + + +Observed Percentiles +(black lines) + + + + + + +10% +50% +90% + +Simulated Percentiles +Median (lines) 95% CI (areas) + + + + + + + + + +10% +50% +90% + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Study A + + + + + + + + + + +Study B + + + + + + + + + + + + + + + + + +Percentage of BLQ +Median (lines) 95% CI (areas) + + + + + + +observed +simulated + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +50 +100 +150 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +20 +40 +60 + + + + + + + + + + + + + + + + + + + + + + + + + +0 +5 +10 +15 + + + + + + + +0 +5 +10 + + + + +TIME + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +2.5 +5.0 +7.5 +10.0 +12.5 + + + + + + + + + +0.0 +2.5 +5.0 +7.5 +10.0 + + + + +TIME + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +50 +100 +150 + + + + + + + + +Observed/Simulated probabilities and associated 95% CI + + + + + + + + + + + + +0 +25 +50 +75 +100 + + + + + + + + + +% BLQ + + + + + + + + + + + + + + + + + + + + + +Study A + + + + + +Study B + + + + + + + + + + + + + + + + + +Observed Percentiles +(black lines) + + + + + + +10% +50% +90% + +Simulated Percentiles +Median (lines) 95% CI (areas) + + + + + + + + + +10% +50% +90% + + + + + + + + + + + + + + + + + + + + + +Study A + + + + + +Study B + + + + + + + + + + + + + + + + + +Percentage of BLQ +Median (lines) 95% CI (areas) + + + + + + +observed +simulated + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +50 +100 +150 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +20 +40 +60 + + + + + + + + + + + + + + + + + + + + +0 +5 +10 +15 + + + + + + + +0 +5 +10 + + + + +TIME + + + + + + + + + + + + + + + + + + + + + + +0.0 +2.5 +5.0 +7.5 +10.0 +12.5 + + + + + + + + + +0.0 +2.5 +5.0 +7.5 +10.0 + + + + +TIME + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/plot/one-sided-strat-formula-with-facet-wrap.svg b/tests/testthat/_snaps/plot/one-sided-strat-formula-with-facet-wrap.svg new file mode 100644 index 0000000..06b43d9 --- /dev/null +++ b/tests/testthat/_snaps/plot/one-sided-strat-formula-with-facet-wrap.svg @@ -0,0 +1,891 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +M + +Study A + + + + + + + + + + +M + +Study B + + + + + + + + + + +F + +Study A + + + + + + + + + + +F + +Study B + + + + + + +0 +5 +10 +15 + + + +0 +5 +10 + + + + +0 +5 +10 +15 + + + + + + +0.0 +2.5 +5.0 +7.5 +10.0 +12.5 +50 +100 +150 +200 + + + + +0 +50 +100 + + + +0 +50 +100 +150 +200 +250 + + + + + + +0 +30 +60 +90 + + + + +TIME +Observed/Simulated probabilities and associated 95% CI + +Observed Percentiles +(black lines) + + + + + + +10% +50% +90% + +Simulated Percentiles +Median (lines) 95% CI (areas) + + + + + + + + + +10% +50% +90% +One sided strat formula with facet_wrap + + diff --git a/tests/testthat/_snaps/plot/two-sided-strat-formula-with-facet-grid.svg b/tests/testthat/_snaps/plot/two-sided-strat-formula-with-facet-grid.svg new file mode 100644 index 0000000..026a9ed --- /dev/null +++ b/tests/testthat/_snaps/plot/two-sided-strat-formula-with-facet-grid.svg @@ -0,0 +1,895 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Study A + + + + + + + + + + +Study B + + + + + + + + + + +F + + + + + + + + + + +M + + + + + + +0 +5 +10 +15 + + + +0 +5 +10 +0 +50 +100 +150 +200 +250 + + + + + + +0 +50 +100 +150 + + + + +TIME +Observed/Simulated probabilities and associated 95% CI + +Observed Percentiles +(black lines) + + + + + + +10% +50% +90% + +Simulated Percentiles +Median (lines) 95% CI (areas) + + + + + + + + + +10% +50% +90% +Two sided strat formula with facet_grid + + diff --git a/tests/testthat/test-plot.R b/tests/testthat/test-plot.R new file mode 100644 index 0000000..72c4e38 --- /dev/null +++ b/tests/testthat/test-plot.R @@ -0,0 +1,106 @@ +get_os <- function(){ + sysinf <- Sys.info() + if (!is.null(sysinf)){ + os <- sysinf['sysname'] + if (os == 'Darwin') + os <- "osx" + } else { ## mystery machine + os <- .Platform$OS.type + if (grepl("^darwin", R.version$os)) + os <- "osx" + if (grepl("linux-gnu", R.version$os)) + os <- "linux" + } + tolower(os) +} + +test_that("plot.tidyvpcobj plots binning without stats", { + testthat::skip_if_not(get_os() == "windows") + testthat::skip_on_cran() + + obs_data <- obs_data[MDV == 0] + sim_data <- sim_data[MDV == 0] + obs_data$PRED <- sim_data[REP == 1, PRED] + + vpc <- observed(obs_data, x = TIME, y = DV) + vpc <- simulated(vpc, sim_data, y = DV) + vpc <- binning(vpc, bin = NTIME) + + options(warn = -1) + vdiffr::expect_doppelganger("Bins without stats", + plot(vpc)) + + vpc <- predcorrect(vpc, pred = PRED) + vdiffr::expect_doppelganger("Bins ypc without stats", + plot(vpc)) + options(warn = 0) + +}) + + +test_that("plot.tidyvpcobj plots censoring", { + testthat::skip_if_not(get_os() == "windows") + testthat::skip_on_cran() + + obs_data <- obs_data[MDV == 0] + sim_data <- sim_data[MDV == 0] + obs_data$LLOQ <- obs_data[, ifelse(STUDY == "Study A", 50, 25)] + obs_data$ULOQ <- obs_data[, ifelse(STUDY == "Study A", 125, 100)] + + vpc <- observed(obs_data, x = TIME, y = DV) + vpc <- simulated(vpc, sim_data, y = DV) + vpc <- censoring(vpc, blq = DV < LLOQ, lloq = LLOQ, alq = DV > ULOQ, uloq = ULOQ) + vpc <-stratify(vpc, ~ STUDY) + vpc <- binning(vpc, bin = NTIME) + vpc <- vpcstats(vpc, qpred = c(0.1, 0.5, 0.9)) + + options(warn = -1) + vdiffr::expect_doppelganger("Censored plot with bql", + plot(vpc, censoring.type = "blq")) + + vdiffr::expect_doppelganger("Censored plot with aql", + plot(vpc, censoring.type = "alq")) + + vdiffr::expect_doppelganger("Censored plot with bql aql", + plot(vpc, censoring.type = "both")) + + plot_list <- plot(vpc, censoring.type = "both", censoring.output = "list") + testthat::expect_true(length(plot_list) == 3) + testthat::expect_true(all(sapply(plot_list, ggplot2::is.ggplot))) + + plot_grid <- plot(vpc, censoring.type = "both", censoring.output = "grid", nrow = 1, ncol = 3) + testthat::expect_true(inherits(plot_grid, "egg")) + options(warn = 0) + +}) + +test_that("plot.tidyvpcobj plots stratified", { + testthat::skip_if_not(get_os() == "windows") + testthat::skip_on_cran() + + obs_data <- obs_data[MDV == 0] + sim_data <- sim_data[MDV == 0] + + options(warn = -1) + #two-sided strat formula + vpc <- observed(obs_data, x = TIME, y = DV) + vpc <- simulated(vpc, sim_data, y = DV) + vpc <- stratify(vpc, GENDER ~ STUDY) + vpc <- binning(vpc, bin = NTIME) + vpc <- vpcstats(vpc, qpred = c(0.1, 0.5, 0.9), quantile.type = 6) + + vdiffr::expect_doppelganger("Two sided strat formula with facet_grid", + plot(vpc)) + + #one-sided strat formula + vpc <- observed(obs_data, x = TIME, y = DV) + vpc <- simulated(vpc, sim_data, y = DV) + vpc <- stratify(vpc, ~ GENDER + STUDY) + vpc <- binless(vpc) + vpc <- vpcstats(vpc, qpred = c(0.1, 0.5, 0.9), quantile.type = 6) + + vdiffr::expect_doppelganger("One sided strat formula with facet_wrap", + plot(vpc)) + options(warn = 0) +}) + \ No newline at end of file