Close #2193: Accomodate breaking changes in ggplot2 3.4.0

Author: cpsievert

DESCRIPTION

@@ -81,3 +81,5 @@ LazyData: true
 RoxygenNote: 7.2.1
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
+Remotes:
+    tidyverse/ggplot2

R/ggplotly.R

@@ -305,6 +305,12 @@ gg2list <- function(p, width = NULL, height = NULL,
       d
     })
 
+    layers <- lapply(layers, function(l) {
+      l$stat$dropped_aes <- c(l$stat$dropped_aes, "x_plotlyDomain")
+      l$stat$dropped_aes <- c(l$stat$dropped_aes, "y_plotlyDomain")
+      l
+    })
+    
     # Transform all scales
     data <- lapply(data, ggfun("scales_transform_df"), scales = scales)
 

R/layers2traces.R

@@ -387,9 +387,13 @@ to_basic.GeomHex <- function(data, prestats_data, layout, params, p, ...) {
   dy <- resolution(data[["y"]], FALSE)/sqrt(3)/2 * 1.15
   hexC <- hexbin::hexcoords(dx, dy, n = 1)
   n <- nrow(data)
-  data$size <- ifelse(data$size < 1, data$size ^ (1 / 6), data$size ^ 6)
-  x <- rep.int(hexC[["x"]], n) * rep(data$size, each = 6) + rep(data[["x"]], each = 6)
-  y <- rep.int(hexC[["y"]], n) * rep(data$size, each = 6) + rep(data[["y"]], each = 6)
+  size_var <- if ("linewidth" %in% names(data)) "linewidth" else "size"
+  size <- data[[size_var]]
+  data[[size_var]] <- ifelse(
+    size < 1, size ^ (1 / 6), size ^ 6
+  )
+  x <- rep.int(hexC[["x"]], n) * rep(data[[size_var]], each = 6) + rep(data[["x"]], each = 6)
+  y <- rep.int(hexC[["y"]], n) * rep(data[[size_var]], each = 6) + rep(data[["y"]], each = 6)
   data <- data[rep(seq_len(n), each = 6), ]
   data[["x"]] <- x
   data[["y"]] <- y
@@ -558,7 +562,12 @@ to_basic.GeomSpoke <- function(data, prestats_data, layout, params, p, ...) {
 #' @export
 to_basic.GeomCrossbar <- function(data, prestats_data, layout, params, p, ...) {
   # from GeomCrossbar$draw_panel()
-  middle <- base::transform(data, x = xmin, xend = xmax, yend = y, size = size * params$fatten, alpha = NA)
+  middle <- base::transform(data, x = xmin, xend = xmax, yend = y, alpha = NA)
+  data <- if ("linewidth" %in% names(middle)) {
+    base::transform(data, linewidth = linewidth * params$fatten)
+  } else {
+    base::transform(data, size = size * params$fatten)
+  }
   list(
     prefix_class(to_basic.GeomRect(data), "GeomCrossbar"),
     prefix_class(to_basic.GeomSegment(middle), "GeomCrossbar")
@@ -697,6 +706,10 @@ geom2trace.GeomBlank <- function(data, params, p) {
 #' @export
 geom2trace.GeomPath <- function(data, params, p) {
   data <- group2NA(data)
+  
+  # ggplot2 >3.4.0 changed from size to linewidth for controlling line width
+  width_var <- if ("linewidth" %in% names(data)) "linewidth" else "size"
+  
   L <- list(
     x = data[["x"]],
     y = data[["y"]],
@@ -710,7 +723,7 @@ geom2trace.GeomPath <- function(data, params, p) {
     name = if (inherits(data, "GeomSmooth")) "fitted values",
     line = list(
       # TODO: line width array? -- https://github.com/plotly/plotly.js/issues/147
-      width = aes2plotly(data, params, "size")[1],
+      width = aes2plotly(data, params, width_var)[1],
       color = toRGB(
         aes2plotly(data, params, "colour"),
         aes2plotly(data, params, "alpha")
@@ -976,12 +989,13 @@ geom2trace.default <- function(data, params, p) {
 # since plotly.js can't draw two polygons with different fill in a single trace
 split_on <- function(dat) {
   lookup <- list(
-    GeomHline = c("linetype", "colour", "size"),
-    GeomVline = c("linetype", "colour", "size"),
-    GeomAbline = c("linetype", "colour", "size"),
-    GeomPath = c("fill", "colour", "size"),
-    GeomPolygon = c("fill", "colour", "size"),
+    GeomHline = c("linetype", "colour", "size", "linewidth"),
+    GeomVline = c("linetype", "colour", "size", "linewidth"),
+    GeomAbline = c("linetype", "colour", "size", "linewidth"),
+    GeomPath = c("fill", "colour", "size", "linewidth"),
+    GeomPolygon = c("fill", "colour", "size", "linewidth"),
     GeomBar = "fill",
+    # TODO: add linetype here?
     GeomBoxplot = c("colour", "fill", "size"),
     GeomErrorbar = "colour",
     GeomErrorbarh = "colour",
@@ -1093,7 +1107,8 @@ aes2plotly <- function(data, params, aes = "size") {
   vals <- uniq(data[[aes]]) %||% params[[aes]] %||% defaults[[aes]] %||% NA
   converter <- switch(
     aes, 
-    size = mm2pixels, 
+    size = mm2pixels,
+    linewidth = mm2pixels,
     stroke = mm2pixels, 
     colour = toRGB, 
     fill = toRGB, 

tests/testthat/test-ggplot-abline.R

@@ -15,12 +15,14 @@ expect_traces <- function(gg, n.traces, name) {
 }
 
 test_that("Second trace be the a-b line", {
+  skip_if_not_installed("ggplot2", "3.4.0") # linewidth introduced in 3.4.0
+  
   x <- seq(0, 3.5, by = 0.5)
   y <- x * 0.95
   df <- data.frame(x, y)
 
   gg <- ggplot(df) + geom_point(aes(x, y, size = x)) +
-    geom_abline(intercept = 1.1, slope = 0.9, colour = "red", size = 4)
+    geom_abline(intercept = 1.1, slope = 0.9, colour = "red", linewidth = 4)
 
   L <- expect_traces(gg, 2, "single-abline")
 

tests/testthat/test-ggplot-blank.R

@@ -1,6 +1,7 @@
 
 test_that("geom_blank", {
-  l <- ggplotly(qplot())$x
+  qp <- expect_warning(qplot(), "deprecated")
+  l <- ggplotly(qp)$x
 
   expect_length(l$data, 1)
   expect_false(l$data[[1]]$visible)

tests/testthat/test-ggplot-density.R

@@ -51,10 +51,10 @@ test_that("geom_density() respects colour aesthetic", {
 })
 
 g <- base + 
-  geom_histogram(aes(y = ..density..), binwidth = 0.5, fill = "pink") +
+  geom_histogram(aes(y = after_stat(density)), binwidth = 0.5, fill = "pink") +
   geom_density(fill = "lightblue", alpha = 0.1)
 
-test_that("geom_histogram(aes(y = ..density..)) + geom_density() works", {
+test_that("geom_histogram(aes(y = after_stat(density))) + geom_density() works", {
   info <- expect_traces(g, 2, "histogram")
   trs <- info$data
   type <- unique(sapply(trs, "[[", "type"))

tests/testthat/test-ggplot-density2d.R

@@ -14,7 +14,7 @@ test_that("geom_density2d translates to path(s)", {
 
 faithful$col <- factor(sample(1:20, nrow(faithful), replace = T))
 m <- ggplot(faithful, aes(x = eruptions, y = waiting)) +
-  stat_density_2d(aes(fill = ..level..), geom = "polygon") +
+  stat_density_2d(aes(fill = after_stat(level)), geom = "polygon") +
   geom_point(aes(colour = col)) +
   xlim(0.5, 6) + ylim(40, 110)
 

tests/testthat/test-ggplot-dynamicTicks.R

@@ -96,7 +96,7 @@ test_that("Time axis inverse transforms correctly", {
 test_that("Inverse maps colorbar data", {
 
   p <- ggplot(mpg, aes(hwy, manufacturer)) + 
-    stat_bin2d(aes(fill = ..density..), binwidth = c(3,1))
+    stat_bin2d(aes(fill = after_stat(density)), binwidth = c(3,1))
 
   l <- ggplotly(p, dynamicTicks = TRUE)$x
 

tests/testthat/test-ggplot-histogram.R

@@ -21,8 +21,8 @@ test_that("geom_histogram() is a bar chart of counts with no bargap", {
   expect_equivalent(info$layout$barmode, "relative")
 })
 
-test_that("geom_histogram(aes(y = ..density..)) displays a density", { 
-  info <- expect_traces(base + geom_histogram(aes(y=..density..)), 1, "density")
+test_that("geom_histogram(aes(y = after_stat(density))) displays a density", { 
+  info <- expect_traces(base + geom_histogram(aes(y=after_stat(density))), 1, "density")
   tr <- info$data[[1]]
   expect_identical(tr$type, "bar")
   #default binwidth
@@ -33,8 +33,8 @@ test_that("geom_histogram(aes(y = ..density..)) displays a density", {
   expect_equal(area, 1, tolerance = 0.1)
 })
 
-test_that("geom_histogram(aes(fill = ..count..)) works", {
-  info <- expect_traces(base + geom_histogram(aes(fill = ..count..)), 6, "fill")
+test_that("geom_histogram(aes(fill = after_stat(count))) works", {
+  info <- expect_traces(base + geom_histogram(aes(fill = after_stat(count))), 6, "fill")
   # grab just the bar traces (there should also be a colorbar)
   bars <- info$data[sapply(info$data, "[[", "type") == "bar"]
   # each traces should have the same value of y
@@ -53,7 +53,7 @@ test_that("Histogram with fixed colour/fill works", {
 })
 
 test_that("Specify histogram binwidth", {
-  gg <- base + geom_histogram(aes(y=..density..), binwidth = 0.3)
+  gg <- base + geom_histogram(aes(y=after_stat(density)), binwidth = 0.3)
   info <- expect_traces(gg, 1, "density-binwidth")
   tr <- info$data[[1]]
   area <- sum(tr$y) * 0.3
@@ -95,8 +95,10 @@ test_that("geom_histogram() with facets", {
 })
 
 test_that("vline overlaid histogram", {
+  skip_if_not_installed("ggplot2", "3.4.0") # linewidth introduced in 3.4.0
+  
   gg <- base + geom_histogram() +
-    geom_vline(aes(xintercept=mean(wt)), color="red", linetype="dashed", size=1)
+    geom_vline(aes(xintercept=mean(wt)), color="red", linetype="dashed", linewidth=1)
   info <- expect_traces(gg, 2, "vline")
   trs <- info$data
   type <- unique(sapply(trs, "[[", "type"))

tests/testthat/test-ggplot-hline.R

@@ -5,7 +5,9 @@ df <- data.frame(x, y)
 gg <- ggplot(df) + geom_point(aes(x, y))
 
 test_that("second trace be the hline", {
-  p <- gg + geom_hline(yintercept = 1.1, colour = "green", size = 3)
+  skip_if_not_installed("ggplot2", "3.4.0") # linewidth introduced in 3.4.0
+  
+  p <- gg + geom_hline(yintercept = 1.1, colour = "green", linewidth = 3)
 
   L <- expect_doppelganger_built(p, "hline")
   expect_equivalent(length(L$data), 2)
@@ -18,7 +20,9 @@ test_that("second trace be the hline", {
 })
 
 test_that("vector yintercept results in multiple horizontal lines", {
-  p <- gg + geom_hline(yintercept = 1:3, colour = "red", size = 3)
+  skip_if_not_installed("ggplot2", "3.4.0") # linewidth introduced in 3.4.0
+  
+  p <- gg + geom_hline(yintercept = 1:3, colour = "red", linewidth = 3)
 
   L <- expect_doppelganger_built(p, "hline-multiple")
   expect_equivalent(length(L$data), 2)
@@ -47,14 +51,16 @@ test_that("hline can be drawn over range of factors", {
 
 
 test_that("hline/vline/abline split on linetype/colour/size", {
+  skip_if_not_installed("ggplot2", "3.4.0") # linewidth introduced in 3.4.0
+  
   d <- tibble::tibble(
     x = seq(0, 3.5, by = 0.5), 
     y = x * 0.95
   )
   gg <- ggplot(d, aes(x, y)) +
     geom_point() +
     geom_vline(xintercept = c(2.5, 3, 3.5), linetype = 1:3) +
-    geom_hline(yintercept = c(2.5, 3, 3.5), size = 1:3) +
+    geom_hline(yintercept = c(2.5, 3, 3.5), linewidth = 1:3) +
     geom_abline(slope = -1, intercept = c(2.5, 3, 3.5), colour = 1:3)
 
   l <- expect_doppelganger_built(gg, "split-hline-vline-abline")

tests/testthat/test-ggplot-polygons.R

@@ -120,9 +120,11 @@ test_that("geom_polygon(aes(linetype), fill, color)", {
   expect_equivalent(traces.by.name[[2]]$line$dash, "dash")
 })
 
-test_that("geom_polygon(aes(size), fill, colour)", {
+test_that("geom_polygon(aes(linewidth), fill, colour)", {
+  skip_if_not_installed("ggplot2", "3.4.0") # linewidth introduced in 3.4.0
+  
   gg <- ggplot(poly.df) +
-    geom_polygon(aes(x, y, size = lab), fill = "orange", colour = "black") +
+    geom_polygon(aes(x, y, linewidth = lab), fill = "orange", colour = "black") +
     scale_size_manual(values = c(left = 2, right = 3))
   info <- expect_traces(gg, 2, "color-fill-aes-size")
   traces.by.name <- list()

tests/testthat/test-ggplot-tooltip.R

@@ -47,7 +47,7 @@ test_that("can hide x values in tooltip", {
 })
 
 cars <- ggplot(mtcars, aes(mpg, factor(cyl)))
-p <- cars + stat_bin2d(aes(fill = ..density..), binwidth = c(3,1))
+p <- cars + stat_bin2d(aes(fill = after_stat(density)), binwidth = c(3,1))
 
 test_that("geom_tile() displays correct info in tooltip with discrete y", {
   L <- expect_doppelganger_built(p, "heatmap-discrete-tooltip")

tests/testthat/test-plotly-group.R

@@ -56,7 +56,7 @@ test_that("Missing values are preserved for lines within a color variable", {
 m <- mtcars
 m$rowname <- rownames(mtcars)
 p <- m %>% 
-  dplyr::group_by_("rowname") %>%
+  dplyr::group_by(rowname) %>%
   plot_ly(x = ~wt, y = ~mpg) %>% 
   add_markers()