Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Updates for ggplot2 version 3.4.0 deprecation of size in favor of linewidth #39

Merged
merged 2 commits into from
Jul 18, 2023
Merged

Updates for ggplot2 version 3.4.0 deprecation of size in favor of linewidth #39

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
f70b17b
Updates for ggplot2 version 3.4.0 deprecation of `size` in favor of `…
billdenney Jul 18, 2023
84ba5d6
Merge branch 'master' into ggplot3.4.0
certara-jcraig Jul 18, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
1 change: 1 addition & 0 deletions NEWS.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@
* Support `headtails`, `maximum`, and `box` binning methods [#23](https://github.com/certara/tidyvpc/pull/23)
* Usage of `predcorrect()` may now occur either before or after call to `binless(loess.ypc=TRUE)`
* Additional unit tests
* Plotting updates were made for ggplot2 version 3.4.0 to use `linewidth` instead of `size` for lines.
* `simulated.tidyvpcobj()` detects if the number of simulated rows is not an integer multiple of the number of observed rows and adds the new `xsim` argument to test that x values match between replicated simulations. It will suggest that MDV filtering may not have occurred if either of these fails [#35](https://github.com/certara/tidyvpc/issues/35).

# tidyvpc 1.3.0
Expand Down
94 changes: 47 additions & 47 deletions R/plot.R
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,9 +1,9 @@
#' Plot a \code{tidyvpcobj}
#'
#'
#' Use ggplot2 graphics to plot and customize the appearance of VPC.
#'
#'
#' @param x A \code{tidyvpcobj}.
#' @param facet Set to \code{TRUE} to facet plot by quantile (continuous VPC) or
#' @param facet Set to \code{TRUE} to facet plot by quantile (continuous VPC) or
#' category (categorical VPC).
#' @param show.points Should the observed data points be plotted?
#' @param show.boundaries Should the bin boundary be displayed?
Expand All @@ -19,70 +19,70 @@
#' "square", "square-fill", "triangle-fill" , "triangle")}. Defaults to \code{"circle-fill"}.
#' @param point.stroke Numeric value specifying size of point stroke.
#' @param ribbon.alpha Numeric value specifying transparency of ribbon.
#' @param legend.position A character string specifying the position of the legend. Options are
#' @param legend.position A character string specifying the position of the legend. Options are
#' \code{"top", "bottom", "left", "right"}.
#' @param facet.scales A character string specifying the \code{scales} argument to use for faceting. Options
#' @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 ... Further arguments can be specified but are ignored.
#' @return A \code{ggplot} object.
#' @seealso
#' \code{ggplot}
#' @export
plot.tidyvpcobj <- function(x,
plot.tidyvpcobj <- function(x,
facet = FALSE,
show.points=TRUE,
show.boundaries=TRUE,
show.stats=!is.null(x$stats),
show.binning=isFALSE(show.stats),
xlab=NULL, ylab=NULL,
color=c("red", "blue", "red"),
show.points=TRUE,
show.boundaries=TRUE,
show.stats=!is.null(x$stats),
show.binning=isFALSE(show.stats),
xlab=NULL, ylab=NULL,
color=c("red", "blue", "red"),
linetype=c("dotted", "solid", "dashed"),
point.alpha = 0.4,
point.size = 1,
point.shape = "circle-fill",
point.stroke = 1,
ribbon.alpha = 0.1,
legend.position="top",
facet.scales="free",
legend.position="top",
facet.scales="free",
custom.theme = "ggplot2::theme_bw", #support function
...) {

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), size=1) +
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,
Expand All @@ -101,14 +101,14 @@ plot.tidyvpcobj <- function(x,
ggplot2::guides(
fill=ggplot2::guide_legend(order=2),
colour=ggplot2::guide_legend(order=2),
linetype=ggplot2::guide_legend(order=1)) +
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), size=1) +
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,
Expand All @@ -127,21 +127,21 @@ plot.tidyvpcobj <- function(x,
ggplot2::guides(
fill=ggplot2::guide_legend(order=2),
colour=ggplot2::guide_legend(order=2),
linetype=ggplot2::guide_legend(order=1)) +
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)
}


g <- g + eval(parse(text = paste0(custom.theme, "()"))) +
ggplot2::theme(
legend.key.width=ggplot2::unit(2, "lines"),
legend.position=legend.position) +
ggplot2::labs(x=xlab, y=ylab)

if (show.points) {
points.dat <- copy(vpc$obs)
if (isTRUE(vpc$predcor)) {
Expand All @@ -164,11 +164,11 @@ plot.tidyvpcobj <- function(x,
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),
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)) {
Expand All @@ -177,13 +177,13 @@ plot.tidyvpcobj <- function(x,
boundaries <- bininfo(vpc)[, .(x=sort(unique(c(xleft, xright))))]
}
if (show.binning) {
g <- g + ggplot2::geom_vline(data=boundaries, ggplot2::aes(xintercept=x), size=ggplot2::rel(0.5), col="gray80") +
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", size=1)
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)
Expand All @@ -199,13 +199,13 @@ plot.tidyvpcobj <- function(x,
}
}
}

} 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), size = 1) +
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") +
Expand All @@ -219,13 +219,13 @@ plot.tidyvpcobj <- function(x,
legend.position=legend.position,
legend.spacing=unit(.1, "cm"),
legend.direction = "horizontal",
legend.key.size = unit(.55, "cm"))
legend.key.size = unit(.55, "cm"))

} 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), size = 1) +
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") +
Expand All @@ -239,7 +239,7 @@ plot.tidyvpcobj <- function(x,
legend.position=legend.position,
legend.spacing=unit(.1, "cm"),
legend.direction = "horizontal",
legend.key.size = unit(.55, "cm"))
legend.key.size = unit(.55, "cm"))
}

if(facet){
Expand All @@ -253,31 +253,31 @@ plot.tidyvpcobj <- function(x,
g <- g + ggplot2::facet_wrap(names(vpc$strat), scales=facet.scales, label = label_both)
}
}


}

g
}


.get_colors <- function(n){
stopifnot(n > 1 && n < 11)

colors <- c("#59A14FE6","#4E79A7E6", "#E15759E6", "#F28E2BE6",
"#B07AA1E6", "#EDC948E6", "#FF9DA7E6", "#9C755FE6",
"#BAB0ACE6")

colors[1:n]
}



.get_lines <- function(n){
stopifnot(n > 1 && n < 11)

lines <- c("solid", "dashed", "dotted", "dotdash", "longdash",
"twodash", "solid", "dashed", "dotted", "dotdash")

lines[1:n]
}