Accommodate breaking changes in ggplot2 3.4.0

DESCRIPTION

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

R/ggplotly.R

@@ -304,6 +304,14 @@ gg2list <- function(p, width = NULL, height = NULL,
       d[["y_plotlyDomain"]] <- d[["y"]]
       d
     })
+    # And since we're essentially adding an "unknown" (to ggplot2) 
+    # aesthetic, add it to the dropped_aes field to avoid fals positive
+    # warnings (https://github.com/tidyverse/ggplot2/pull/4866)
+    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)
@@ -676,7 +684,8 @@ gg2list <- function(p, width = NULL, height = NULL,
           d$y <- scales::rescale(d$y, rng$y_range, from = c(0, 1))
           params <- list(
             colour = panelGrid$colour, 
-            size = panelGrid$size, 
+            linewidth = panelGrid$linewidth,
+            size = panelGrid$size,
             linetype = panelGrid$linetype
           )
           grill <- geom2trace.GeomPath(d, params)
@@ -958,7 +967,10 @@ gg2list <- function(p, width = NULL, height = NULL,
   gglayout$legend <- list(
     bgcolor = toRGB(theme$legend.background$fill),
     bordercolor = toRGB(theme$legend.background$colour),
-    borderwidth = unitConvert(theme$legend.background$size, "pixels", "width"),
+    borderwidth = unitConvert(
+      theme$legend.background$linewidth %||% theme$legend.background$size, 
+      "pixels", "width"
+    ),
     font = text2font(theme$legend.text)
   )
 
@@ -1191,7 +1203,7 @@ verifyUnit <- function(u) {
 
   ## the default unit in ggplot2 is millimeters (unless it's element_text())
   if (inherits(u, "element")) {
-    grid::unit(u$size %||% 0, "points")
+    grid::unit(u$linewidth %||% u$size %||% 0, "points")
   } else {
     grid::unit(u %||% 0, "mm")
   }

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,13 +562,18 @@ 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")
   )
 }
-utils::globalVariables(c("xmin", "xmax", "y", "size", "COL", "PANEL", "ROW", "yaxis"))
+utils::globalVariables(c("xmin", "xmax", "y", "size", "linewidth", "COL", "PANEL", "ROW", "yaxis"))
 
 #' @export
 to_basic.GeomRug  <- function(data, prestats_data, layout, params, p, ...) {
@@ -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")
@@ -778,6 +791,9 @@ geom2trace.GeomBar <- function(data, params, p) {
     base <- data[["ymin"]]
     x <- with(data, ymax - ymin)
   }
+
+  # ggplot2 >3.4.0 changed from size to linewidth for controlling line width
+  width_var <- if ("linewidth" %in% names(data)) "linewidth" else "size"
 
   compact(list(
     orientation = if (flip) "h" else "v",
@@ -803,7 +819,7 @@ geom2trace.GeomBar <- function(data, params, p) {
         aes2plotly(data, params, "alpha")
       ),
       line = list(
-        width = aes2plotly(data, params, "size"),
+        width = aes2plotly(data, params, width_var),
         color = aes2plotly(data, params, "colour")
       )
     )
@@ -812,9 +828,11 @@ geom2trace.GeomBar <- function(data, params, p) {
 
 #' @export
 geom2trace.GeomPolygon <- 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"]],
@@ -826,7 +844,7 @@ geom2trace.GeomPolygon <- function(data, params, p) {
     type = "scatter",
     mode = "lines",
     line = list(
-      width = aes2plotly(data, params, "size"),
+      width = aes2plotly(data, params, width_var),
       color = toRGB(
         aes2plotly(data, params, "colour"),
         aes2plotly(data, params, "alpha")
@@ -847,6 +865,9 @@ geom2trace.GeomPolygon <- function(data, params, p) {
 
 #' @export
 geom2trace.GeomBoxplot <- function(data, params, p) {
+  # ggplot2 >3.4.0 changed from size to linewidth for controlling line width
+  width_var <- if ("linewidth" %in% names(data)) "linewidth" else "size"
+
   compact(list(
     x = data[["x"]],
     y = data[["y"]],
@@ -873,7 +894,7 @@ geom2trace.GeomBoxplot <- function(data, params, p) {
     ),
     line = list(
       color = aes2plotly(data, params, "colour"),
-      width = aes2plotly(data, params, "size")
+      width = aes2plotly(data, params, width_var)
     )
   ))
 }
@@ -976,12 +997,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 +1115,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-area.R

@@ -19,7 +19,7 @@ huron <- data.frame(year = 1875:1972, level = as.vector(LakeHuron))
 # like getAnywhere(round_any.numeric)
 huron$decade <- floor(huron$year / 10) * 10 
 
-ar <- ggplot(huron) + geom_area(aes(x = year, y = level))
+ar <- ggplot(huron) + geom_area(aes(x = year, y = level), stat = "identity")
 
 test_that("sanity check for geom_area", {
   L <- expect_traces(ar, 1, "simple")
@@ -33,7 +33,7 @@ test_that("sanity check for geom_area", {
 })
 
 # Test alpha transparency in fill color
-gg <- ggplot(huron) + geom_area(aes(x = year, y = level), alpha = 0.4)
+gg <- ggplot(huron) + geom_area(aes(x = year, y = level), alpha = 0.4, stat = "identity")
 
 test_that("transparency alpha in geom_area is converted", {
   L <- expect_traces(gg, 1, "area-fillcolor")
@@ -54,7 +54,7 @@ df <- merge(x = df, y = temp, all.x = TRUE)
 df$freq <- df$n / df$sum.n
 # Generate ggplot object
 p <- ggplot(data = df, aes(x = carat, y = freq, fill = cut)) + 
-  geom_area() 
+  geom_area(stat = "identity")
 # Test 
 test_that("traces are ordered correctly in geom_area", {
   info <- expect_traces(p, 5, "traces_order")

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

@@ -121,9 +121,14 @@ test_that("geom_polygon(aes(linetype), fill, color)", {
 })
 
 test_that("geom_polygon(aes(size), fill, colour)", {
-  gg <- ggplot(poly.df) +
-    geom_polygon(aes(x, y, size = lab), fill = "orange", colour = "black") +
-    scale_size_manual(values = c(left = 2, right = 3))
+  size_plot <- function() {
+    ggplot(poly.df) +
+      geom_polygon(aes(x, y, size = lab), fill = "orange", colour = "black") +
+      scale_size_manual(values = c(left = 2, right = 3))
+  }
+  # ggplot2 3.4.0 deprecated size, but there is no scale_linewidth_manual(), 
+  # so I don't think it's currently possible to replicate this exact plot
+  gg <- expect_warning(size_plot(), "size")
   info <- expect_traces(gg, 2, "color-fill-aes-size")
   traces.by.name <- list()
   for(tr in info$data){

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")