Merge pull request #73 from metrumresearchgroup/release/0.3.6

Release/0.3.6

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: pmplots
 Type: Package
 Title: Plots for Pharmacometrics
-Version: 0.3.5
+Version: 0.3.6
 Authors@R: c(
        person("Kyle T", "Baron", "", "kyleb@metrumrg.com", c("aut", "cre")),
        person("Metrum Research Group", role =  c("cph"))
@@ -34,8 +34,8 @@ Suggests:
   miniUI, 
   shiny, 
   rmarkdown
-Depends: ggplot2 (>= 3.3.5)
-RoxygenNote: 7.1.2
+Depends: ggplot2 (>= 3.4.0)
+RoxygenNote: 7.2.1
 Roxygen: list(markdown = TRUE)
 Collate: 
     'Aaaa.R'

NAMESPACE

@@ -159,7 +159,7 @@ importFrom(dplyr,summarize)
 importFrom(dplyr,ungroup)
 importFrom(forcats,fct_inorder)
 importFrom(ggplot2,aes)
-importFrom(ggplot2,aes_string)
+importFrom(ggplot2,after_stat)
 importFrom(ggplot2,element_text)
 importFrom(ggplot2,facet_wrap)
 importFrom(ggplot2,geom_abline)
@@ -183,6 +183,8 @@ importFrom(ggplot2,scale_linetype_manual)
 importFrom(ggplot2,scale_shape_discrete)
 importFrom(ggplot2,scale_shape_manual)
 importFrom(ggplot2,scale_x_continuous)
+importFrom(ggplot2,scale_x_discrete)
+importFrom(ggplot2,scale_y_continuous)
 importFrom(ggplot2,scale_y_log10)
 importFrom(ggplot2,stat_qq)
 importFrom(ggplot2,theme)

NEWS.md

@@ -1,3 +1,9 @@
+# pmplots 0.3.6
+
+- Update plotting code to work with new `ggplot2` behavior introduced 
+  in version 3.4.0; `pmplots` now depends on `ggplot2` version 3.4.0 
+  or greater (#71).
+
 # pmplots 0.3.5
 
 - Functions generating default axis titles now have arguments so that 

R/Aaaa.R

@@ -4,16 +4,18 @@
 #' @importFrom dplyr as_tibble
 #' @importFrom tidyselect all_of
 #' @importFrom grDevices pdf dev.off
-#' @importFrom ggplot2 ggplot aes_string geom_boxplot geom_line
+#' @importFrom ggplot2 ggplot geom_boxplot geom_line
 #' @importFrom ggplot2 ggtitle theme geom_point geom_smooth
 #' @importFrom ggplot2 geom_abline geom_hline geom_text margin
 #' @importFrom ggplot2 stat_qq facet_wrap geom_histogram
 #' @importFrom ggplot2 scale_color_brewer theme_bw theme_set
 #' @importFrom ggplot2 element_text labs aes waiver rel
-#' @importFrom ggplot2 scale_shape_discrete scale_x_continuous scale_y_log10
+#' @importFrom ggplot2 scale_y_continuous scale_x_continuous scale_y_log10
+#' @importFrom ggplot2 scale_x_discrete
 #' @importFrom ggplot2 geom_text position_jitter label_value
 #' @importFrom ggplot2 scale_color_manual scale_linetype_manual
-#' @importFrom ggplot2 scale_shape_manual
+#' @importFrom ggplot2 scale_shape_manual scale_shape_discrete
+#' @importFrom ggplot2 after_stat
 #' @importFrom stats as.formula qnorm quantile cor dnorm
 #' @importFrom rlang sym quo_text quos set_names quo_name as_list is_named
 #' @importFrom glue glue glue_data

R/box.R

@@ -84,7 +84,7 @@ boxwork <- function(df, x, y, xs=defcx(), ys=defy(),
   yscale <- do.call("scale_y_continuous", ys)
   xscale <- do.call("scale_x_discrete", xs)
 
-  p <- ggplot(data=df, aes_string(x=x,y=y))
+  p <- ggplot(data = df, aes(x = .data[[x]], y = .data[[y]]))
 
   do_points <- !missing(points) & !is.null(points)
   if(do_points) {
@@ -108,7 +108,7 @@ boxwork <- function(df, x, y, xs=defcx(), ys=defy(),
   if(is.numeric(hline)) {
     p <- p + geom_hline(
       yintercept = hline,
-      lwd = opts$boxplot.hline.lwd,
+      linewidth = opts$boxplot.hline.lwd,
       lty = opts$boxplot.hline.lty,
       col = opts$boxplot.hline.col
     )

R/cont.R

@@ -35,15 +35,28 @@ scatt <- function(df, x, y, xs = defx(), ys = defy(),
   xscale <- do.call("scale_x_continuous", xs)
   yscale <- do.call("scale_y_continuous", ys)
   locol <- .ggblue
-  if(is.null(col)) col <- glue("I('{scatter.col}')", .envir = pm_opts)
-  p <- ggplot(data = df, aes_string(x, y, col = col))
+
+  if(is.null(col)) {
+    col <- I(glue('{scatter.col}', .envir = pm_opts))
+  } else {
+    if(col %in% names(df)) {
+      col <- sym(col)
+    } else {
+      col <- I(glue('{col}'))
+    }
+  }
+
+  p <- ggplot(data = df, aes(x=.data[[x]], y=.data[[y]], col={{ col }}))
+
   if(plot_id) {
     require_column(df,"ID")
-    p <- p + geom_text(aes_string(label = "ID"), size = size, alpha = alpha)
+    p <- p + geom_text(aes(label = .data$ID), alpha = alpha, size = size)
   } else {
-    p <- p + geom_point(size = size, alpha = alpha)
+    p <- p + geom_point(alpha = alpha, size = size)
+  }
+  if(!is.null(group)) {
+    p <- p + geom_line(aes(group = .data[[group]]))
   }
-  if(!is.null(group)) p <- p + geom_line(aes_string(group = group))
   if(is.character(title)) p <- p + ggtitle(title)
   p + xscale + yscale + pm_theme()
 }

R/dv_pred.R

@@ -128,7 +128,7 @@ dv_pred <- function(df, x = pm_axis_pred(), y = pm_axis_dv(),
 #' @rdname dv_pred
 dv_ipred <- function(df, x = pm_axis_ipred(), ...) {
   out <- dv_pred(df, x = x, ...)
-  layer_as(out,...)
+  layer_as(out, ...)
 }
 
 #' @export

R/dv_pred_ipred.R

@@ -266,12 +266,12 @@ dv_pred_ipred_impl <- function(data,
     scale_color_manual(name = "", values = clrs) +
     scale_linetype_manual(name = "", values = lnes) +
     scale_shape_manual(name = "", values = shapes) +
-    geom_line(aes(lty =    .data$name, col = .data$name), lwd = lwd) +
+    geom_line(aes(lty =    .data$name, col = .data$name), linewidth = lwd) +
     geom_point(aes(shape = .data$name, col = .data$name), na.rm = TRUE, size = size)
 
   if(dv_line) {
     dfline <- filter(data, .data$name == dv)
-    p <- p + geom_line(data = dfline, col = dv_color, lwd = dv_lwd)
+    p <- p + geom_line(data = dfline, col = dv_color, linewidth = dv_lwd)
   }
 
   p <-

R/eta_pairs.R

@@ -26,7 +26,7 @@ pairs_lower_plot <- function(p) {
       color = opts$smooth.col,
       lty = opts$smooth.lty,
       se = FALSE,
-      lwd = opts$smooth.lwd
+      linewidth = opts$smooth.lwd
     )
 }
 

R/hist.R

@@ -7,7 +7,7 @@
 ##' @param df the data frame containing plotting data
 ##' @param x the x column for \code{geom_histogram}
 ##' @param y what to use for the y-axis on the histogram; can be
-##' \code{"..count.."} or \code{"..density.."}
+##' \code{"count"} or \code{"density"}
 ##' @param add_density if \code{TRUE}, a normal density line will
 ##' be plotted over the histogram using \code{\link{add_density}}
 ##' @param xs a list of information for the x axis
@@ -28,14 +28,14 @@
 ##'
 ##' @export
 cont_hist <- function(df, x, xs = defx(),
-                      y = "..count..",
-                      add_density = y=="..density..", add_layers=TRUE, ...) {
+                      y = "count",
+                      add_density = y=="density", add_layers=TRUE, ...) {
   xscale <- do.call("scale_x_continuous", xs)
   xx <- col_label(x)
   require_numeric(df,xx[1])
   out <-
-    ggplot(data=df, aes_string(x = xx[1])) +
-    pm_histogram(mapping = aes_string(y = y), ...) +
+    ggplot(data=df, aes(x = .data[[xx[1]]])) +
+    pm_histogram(mapping = aes(y = after_stat(!!sym(y))), ...) +
     xscale + pm_theme() + pm_labs(x = xx[2])
   if(add_density & add_layers) {
     out <- out + add_density(...)

R/layer.R

@@ -120,7 +120,7 @@ layer_dots <- function(x,...) {
 gs <- function(method=pm_opts$smooth.method, se=FALSE, lty=pm_opts$smooth.lty,
                lwd=pm_opts$smooth.lwd, col = pm_opts$smooth.col,...) {
   args <- list(...)
-  def <- list(method=method,se=se,lty=lty,lwd=lwd,col=col)
+  def <- list(method=method,se=se,lty=lty,linewidth=lwd,col=col)
   update_list(def,args)
 }
 
@@ -130,7 +130,7 @@ ga <- function(intercept=0, slope=1,
                lty = pm_opts$abline.lty,
                col=pm_opts$abline.col,...) {
   args <- list(...)
-  def <- list(intercept=intercept, slope=slope,col=col,lwd=lwd,lty=lty)
+  def <- list(intercept=intercept, slope=slope,col=col,linewidth=lwd,lty=lty)
   update_list(def,args)
 }
 
@@ -140,7 +140,7 @@ gh <- function(yintercept=0,
                lty = pm_opts$hline.lty,
                col = pm_opts$hline.col,...) {
   args <- list(...)
-  def <- list(yintercept=yintercept,lwd=lwd,col=col,lty=lty)
+  def <- list(yintercept=yintercept,linewidth=lwd,col=col,lty=lty)
   update_list(def,args)
 }
 
@@ -157,13 +157,13 @@ gh <- function(yintercept=0,
 ##'
 ##' @export
 geom_3s <- function(lwd = 1.35, lty=1, col = "darkgrey", yintercept = c(-3,3), ...) {
-  geom_hline(yintercept = yintercept, col = col, lwd = lwd, lty = lty, ...)
+  geom_hline(yintercept = yintercept, col = col, linewidth = lwd, lty = lty, ...)
 }
 
 ##' @export
 ##' @rdname geom_3s
 layer_3s <- function(x, lwd = 1.35, lty = 1, col = "darkgrey", yintercept = c(-3,3), ...) {
-  x + geom_hline(yintercept = yintercept, col = col, lwd = lwd, lty = lty,...)
+  x + geom_hline(yintercept = yintercept, col = col, linewidth = lwd, lty = lty,...)
 }
 
 
@@ -186,7 +186,7 @@ add_density <- function(fun = dnorm,
                         col = pm_opts$density.col,
                         lwd = pm_opts$density.lwd,
                         lty = pm_opts$density.lty, ...) {
-  ggplot2::stat_function(fun = fun, col = col, lwd = lwd, lty = lty, ...)
+  ggplot2::stat_function(fun = fun, col = col, linewidth = lwd, lty = lty, ...)
 }
 
 ##' @rdname add_density
@@ -204,5 +204,5 @@ layer_dnorm <- function(x, sd = 1, mean = 0, ...) {
 ##'
 ##' @export
 npde_ref <- function(y = 0, lwd = 1,...) {
-  c(list(yintercept = y, lwd = lwd),list(...))
+  c(list(yintercept = y, linewidth = lwd),list(...))
 }

R/pm_theme.R

@@ -18,7 +18,7 @@ theme_plain <- function(...) {
 pm_smooths <- function(method=opts$smooth.method, se=FALSE,
                        lty=opts$smooth.lty, lwd=opts$smooth.lwd,
                        col=opts$smooth.col,...) {
-  geom_smooth(method=method,se=se,lty=lty,lwd=lwd,col=col)
+  geom_smooth(method=method,se=se,lty=lty,linewidth=lwd,col=col)
 }
 
 ##' The standard pmplots theme

R/qq.R

@@ -44,7 +44,7 @@ wres_q <- function(df, x="WRES", xs = defx(), ys=defy(), abline=NULL,
   if(is.null(abline)) abline <- qq_reg_data(df[[x]])
   xscale <- do.call("scale_x_continuous", xs)
   yscale <- do.call("scale_y_continuous", ys)
-  p <- ggplot(data=df, aes_string(sample=x))
+  p <- ggplot(data = df, aes(sample = .data[[x]]))
   p <- p + stat_qq(color=col, alpha=alpha, distribution=qnorm,size=size)
   p <- p + xscale + yscale
   p <- p + pm_labs(x = "Standard normal quantile", y = paste0(x, " distribution quantile"))

inst/validation/build-validation-docs.R

@@ -12,11 +12,11 @@
 #######################################################
 
 PKGNAME <- "pmplots"
-PKGVERSION <- "0.3.4.9000"
+PKGVERSION <- "0.3.5"
 STYLE_REF_DIR <- "docx-ref-header-image" # set to NULL if not using style ref
 
 # set up directories and clear existing output dirs, if they exist
-val_dir <- system.file("validation", package = PKGNAME)
+val_dir <- getwd()#system.file("validation", package = PKGNAME)
 print(val_dir)
 
 style_ref_path <- NULL

tests/testthat/test-dv-pred-ipred.R

@@ -20,8 +20,8 @@ test_that("dv-pred-ipred basics [PMP-TEST-081]", {
   data2 <- p2$data[[2]]
   expect_equal(unique(data1$PANEL), factor(c(1, 2, 3, 4, 5)))
 
-  dd1 <- dplyr::distinct(data1, colour, linetype, group, size)
-  expect_true(all(dd1$size==0.5))
+  dd1 <- dplyr::distinct(data1, colour, linetype, group, linewidth)
+  expect_true(all(dd1$linewidth==0.5))
   expect_equal(dd1$group, c(1, 2, 3))
   expect_equal(dd1$colour, c("red2", "blue2", "black"))
   expect_equal(dd1$linetype, c(1, 2, 0))

tests/testthat/test-layer.R

@@ -9,13 +9,26 @@ p <- dv_pred(df)
 p <- ggplot(df, aes(TIME,DV)) + geom_point()
 
 test_that("layer_xx [PMP-TEST-009]", {
+  x0 <- layer_hs(p)
   x <- layer_hs(p, hline = NULL)
-  expect_equal(x, layer_s(p))
+  y <- layer_s(p)
+  expect_equal(length(x0$layers), 3)
+  expect_equal(length(x$layers), 2)
+  expect_equal(length(y$layers), 2)
+
+  x0 <- layer_hs(p)
   x <- layer_hs(p, smooth = NULL)
-  expect_equal(x, layer_h(p))
+  y <- layer_h(p)
+  expect_equal(length(x0$layers), 3)
+  expect_equal(length(x$layers), 2)
+  expect_equal(length(y$layers), 2)
+
+  x0 <- layer_sh(p)
   x <- layer_sh(p, hline = NULL)
-  expect_equal(x,layer_s(p))
-  expect_is(layer_sa(p),"gg")
+  y <- layer_s(p)
+  expect_equal(length(x0$layers), 3)
+  expect_equal(length(x$layers), 2)
+  expect_equal(length(y$layers), 2)
 
   x <- layer_a(p)
   expect_is(x,"gg")
@@ -42,35 +55,35 @@ test_that("extra layers [PMP-TEST-010]", {
 
 test_that("gh [PMP-TEST-011]", {
   x <- pmplots:::gh()
-  expect_identical(names(x), c("yintercept", "lwd", "col", "lty"))
+  expect_identical(names(x), c("yintercept", "linewidth", "col", "lty"))
   expect_identical(x$yintercept,0)
-  expect_identical(x$lwd,1.35)
+  expect_identical(x$linewidth,1.35)
   expect_identical(x$col,"darkgrey")
 })
 
 
 test_that("gs [PMP-TEST-012]", {
   x <- pmplots:::gs()
   expect_is(x,"list")
-  expect_identical(names(x), c("method", "se", "lty", "lwd", "col"))
+  expect_identical(names(x), c("method", "se", "lty", "linewidth", "col"))
   expect_identical(x$se,FALSE)
   expect_identical(x$lty,2)
-  expect_identical(x$lwd,1.35)
+  expect_identical(x$linewidth,1.35)
   expect_identical(x$col,"#3366FF")
 })
 
 test_that("ga [PMP-TEST-013]", {
   x <- pmplots:::ga()
   expect_is(x,"list")
-  expect_identical(names(x), c("intercept", "slope", "col", "lwd", "lty"))
-  expect_identical(x$lwd,1.35)
+  expect_identical(names(x), c("intercept", "slope", "col", "linewidth", "lty"))
+  expect_identical(x$linewidth,1.35)
   expect_identical(x$col,"darkgrey")
   expect_identical(x$slope,1)
 })
 
 test_that("npde_ref [PMP-TEST-014]", {
   x <- npde_ref()
   expect_is(x,"list")
-  expect_identical(names(x), c("yintercept", "lwd"))
+  expect_identical(names(x), c("yintercept", "linewidth"))
   expect_identical(x$yintercept, 0)
 })