From bcf65f07116ed37f273cabdc98583ab6b7af46c0 Mon Sep 17 00:00:00 2001 From: Carson Date: Wed, 2 Nov 2022 11:32:26 -0500 Subject: [PATCH 01/17] Close #2193: Accomodate breaking changes in ggplot2 3.4.0 --- DESCRIPTION | 2 ++ R/ggplotly.R | 8 +++++ R/layers2traces.R | 37 ++++++++++++++++------- tests/testthat/test-ggplot-abline.R | 4 ++- tests/testthat/test-ggplot-blank.R | 3 +- tests/testthat/test-ggplot-density.R | 4 +-- tests/testthat/test-ggplot-density2d.R | 2 +- tests/testthat/test-ggplot-dynamicTicks.R | 2 +- tests/testthat/test-ggplot-histogram.R | 14 +++++---- tests/testthat/test-ggplot-hline.R | 12 ++++++-- tests/testthat/test-ggplot-polygons.R | 11 +++++-- tests/testthat/test-ggplot-tooltip.R | 2 +- tests/testthat/test-plotly-group.R | 2 +- 13 files changed, 72 insertions(+), 31 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index fc8529bb3c..5afbc2eaf3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -82,3 +82,5 @@ LazyData: true RoxygenNote: 7.2.1 Encoding: UTF-8 Roxygen: list(markdown = TRUE) +Remotes: + tidyverse/ggplot2 diff --git a/R/ggplotly.R b/R/ggplotly.R index 6c0aad48eb..16b556ab75 100644 --- a/R/ggplotly.R +++ b/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) diff --git a/R/layers2traces.R b/R/layers2traces.R index 09323f6501..460002df43 100644 --- a/R/layers2traces.R +++ b/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, diff --git a/tests/testthat/test-ggplot-abline.R b/tests/testthat/test-ggplot-abline.R index 654e291d8b..d0d6f0b8e3 100644 --- a/tests/testthat/test-ggplot-abline.R +++ b/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") diff --git a/tests/testthat/test-ggplot-blank.R b/tests/testthat/test-ggplot-blank.R index 1f7d7660a4..24b69d4e8b 100644 --- a/tests/testthat/test-ggplot-blank.R +++ b/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) diff --git a/tests/testthat/test-ggplot-density.R b/tests/testthat/test-ggplot-density.R index 17b482f18d..823591a312 100644 --- a/tests/testthat/test-ggplot-density.R +++ b/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")) diff --git a/tests/testthat/test-ggplot-density2d.R b/tests/testthat/test-ggplot-density2d.R index 197dc20e70..ae43ab34b1 100644 --- a/tests/testthat/test-ggplot-density2d.R +++ b/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) diff --git a/tests/testthat/test-ggplot-dynamicTicks.R b/tests/testthat/test-ggplot-dynamicTicks.R index 488796da69..28459e48a6 100644 --- a/tests/testthat/test-ggplot-dynamicTicks.R +++ b/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 diff --git a/tests/testthat/test-ggplot-histogram.R b/tests/testthat/test-ggplot-histogram.R index 3e66d2787a..8a22770df5 100644 --- a/tests/testthat/test-ggplot-histogram.R +++ b/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")) diff --git a/tests/testthat/test-ggplot-hline.R b/tests/testthat/test-ggplot-hline.R index 3de01cc18a..9ed7af92a6 100644 --- a/tests/testthat/test-ggplot-hline.R +++ b/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,6 +51,8 @@ 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 @@ -54,7 +60,7 @@ test_that("hline/vline/abline split on linetype/colour/size", { 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") diff --git a/tests/testthat/test-ggplot-polygons.R b/tests/testthat/test-ggplot-polygons.R index 7efb53b421..cd618dedbf 100644 --- a/tests/testthat/test-ggplot-polygons.R +++ b/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){ diff --git a/tests/testthat/test-ggplot-tooltip.R b/tests/testthat/test-ggplot-tooltip.R index 1aea4acbc6..621ac1e261 100644 --- a/tests/testthat/test-ggplot-tooltip.R +++ b/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") diff --git a/tests/testthat/test-plotly-group.R b/tests/testthat/test-plotly-group.R index ea8b94dab6..6ffe097705 100644 --- a/tests/testthat/test-plotly-group.R +++ b/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() From 01f370e3355ca3892716a5fea1e537a27664ae2b Mon Sep 17 00:00:00 2001 From: Carson Date: Wed, 2 Nov 2022 14:03:46 -0500 Subject: [PATCH 02/17] Line-based theme elements now also use linewidth over size --- R/ggplotly.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ggplotly.R b/R/ggplotly.R index 16b556ab75..daad9d89e2 100644 --- a/R/ggplotly.R +++ b/R/ggplotly.R @@ -1199,7 +1199,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") } From 9324db9d7c6b02bac219692d454daf6f51196248 Mon Sep 17 00:00:00 2001 From: Carson Date: Wed, 2 Nov 2022 15:05:51 -0500 Subject: [PATCH 03/17] Support GeomBoxplot linewidth as well --- R/layers2traces.R | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/R/layers2traces.R b/R/layers2traces.R index 460002df43..33c9c8e6f1 100644 --- a/R/layers2traces.R +++ b/R/layers2traces.R @@ -573,7 +573,7 @@ to_basic.GeomCrossbar <- function(data, prestats_data, layout, params, p, ...) { 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, ...) { @@ -860,6 +860,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"]], @@ -886,7 +889,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) ) )) } From e1bc6368b22e252f58a65b908e73d8e33f2fff3e Mon Sep 17 00:00:00 2001 From: Carson Date: Wed, 2 Nov 2022 15:31:31 -0500 Subject: [PATCH 04/17] Support GeomPolygon linewidth as well --- R/layers2traces.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/R/layers2traces.R b/R/layers2traces.R index 33c9c8e6f1..634d1941a7 100644 --- a/R/layers2traces.R +++ b/R/layers2traces.R @@ -825,9 +825,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"]], @@ -839,7 +841,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") From 271cba35e016ae29ad6ee39c41d6fba1eb3d2b67 Mon Sep 17 00:00:00 2001 From: Carson Date: Wed, 2 Nov 2022 15:50:50 -0500 Subject: [PATCH 05/17] Support GeomBar linewidth as well --- R/layers2traces.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/R/layers2traces.R b/R/layers2traces.R index 634d1941a7..077a306c92 100644 --- a/R/layers2traces.R +++ b/R/layers2traces.R @@ -791,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", @@ -816,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") ) ) From a3e7df37bcf2f7c5eb7244d49662cb3281ef9f29 Mon Sep 17 00:00:00 2001 From: Carson Date: Wed, 2 Nov 2022 16:03:04 -0500 Subject: [PATCH 06/17] Handle more linewidth theme changes --- R/ggplotly.R | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/R/ggplotly.R b/R/ggplotly.R index daad9d89e2..6caa1f9a0b 100644 --- a/R/ggplotly.R +++ b/R/ggplotly.R @@ -684,7 +684,7 @@ 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, + size = panelGrid$linewidth %||% panelGrid$size, linetype = panelGrid$linetype ) grill <- geom2trace.GeomPath(d, params) @@ -966,7 +966,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) ) From 3705886516b8c00a3c49466d67121efaea2c8552 Mon Sep 17 00:00:00 2001 From: Carson Date: Wed, 2 Nov 2022 16:37:45 -0500 Subject: [PATCH 07/17] Use both linewidth and size for sf --- R/ggplotly.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/ggplotly.R b/R/ggplotly.R index 6caa1f9a0b..02e262f9f5 100644 --- a/R/ggplotly.R +++ b/R/ggplotly.R @@ -684,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$linewidth %||% panelGrid$size, + linewidth = panelGrid$linewidth, + size = panelGrid$size, linetype = panelGrid$linetype ) grill <- geom2trace.GeomPath(d, params) From 8da4c95b59230213bd396ab819b126f9d2a98fb2 Mon Sep 17 00:00:00 2001 From: Carson Date: Thu, 3 Nov 2022 09:48:49 -0500 Subject: [PATCH 08/17] geom_area() now has a different default for stat --- tests/testthat/test-ggplot-area.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-ggplot-area.R b/tests/testthat/test-ggplot-area.R index 265a97a0ad..bd0b10173c 100644 --- a/tests/testthat/test-ggplot-area.R +++ b/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") From efb492b20f3d1d3bff4cc8158c2e8eb420efe1d2 Mon Sep 17 00:00:00 2001 From: Carson Date: Thu, 3 Nov 2022 10:03:25 -0500 Subject: [PATCH 09/17] Approve differences due to changes in legend order --- tests/testthat/_snaps/ggplot-size/size-global-scaling.svg | 2 +- tests/testthat/_snaps/ggplot-theme/theme-marker-default.svg | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/_snaps/ggplot-size/size-global-scaling.svg b/tests/testthat/_snaps/ggplot-size/size-global-scaling.svg index 7be249954f..97ef59ffda 100644 --- a/tests/testthat/_snaps/ggplot-size/size-global-scaling.svg +++ b/tests/testthat/_snaps/ggplot-size/size-global-scaling.svg @@ -1 +1 @@ -2340.40.81.21.6countrypopulationParaguayPeruPhilippineseduilln +2340.40.81.21.6populationcountryParaguayPeruPhilippineseduilln diff --git a/tests/testthat/_snaps/ggplot-theme/theme-marker-default.svg b/tests/testthat/_snaps/ggplot-theme/theme-marker-default.svg index 4f7b23bbeb..1af59b7b80 100644 --- a/tests/testthat/_snaps/ggplot-theme/theme-marker-default.svg +++ b/tests/testthat/_snaps/ggplot-theme/theme-marker-default.svg @@ -1 +1 @@ -2340.40.81.21.6countrypopulationParaguayPeruPhilippineseduilln +2340.40.81.21.6populationcountryParaguayPeruPhilippineseduilln From 9f675840c4ab59786f31d0f5d4133949834f71ba Mon Sep 17 00:00:00 2001 From: Carson Date: Thu, 3 Nov 2022 14:15:05 -0500 Subject: [PATCH 10/17] Convert borderwidth correctly on colorbar --- R/ggplotly.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ggplotly.R b/R/ggplotly.R index 02e262f9f5..994d594293 100644 --- a/R/ggplotly.R +++ b/R/ggplotly.R @@ -1423,7 +1423,7 @@ gdef2trace <- function(gdef, theme, gglayout) { bgcolor = toRGB(theme$legend.background$fill), bordercolor = toRGB(theme$legend.background$colour), borderwidth = unitConvert( - theme$legend.background$size, "pixels", "width" + theme$legend.background$linewidth %||% theme$legend.background$size, "pixels", "width" ), thickness = unitConvert( theme$legend.key.width, "pixels", "width" From 7149f06017e8301088a5d77dc27a178c5be21881 Mon Sep 17 00:00:00 2001 From: Carson Date: Thu, 3 Nov 2022 15:57:28 -0500 Subject: [PATCH 11/17] Refactor/consolidate core logic --- NAMESPACE | 2 ++ R/ggplotly.R | 11 +++++---- R/layers2traces.R | 59 +++++++++++++++++++++++++---------------------- 3 files changed, 39 insertions(+), 33 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 25291e11f7..ec1fd23ced 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -26,6 +26,8 @@ S3method(highlight_key,plotly) S3method(layout,matrix) S3method(layout,plotly) S3method(layout,shiny.tag.list) +S3method(linewidth_or_size,Geom) +S3method(linewidth_or_size,element) S3method(plotly_build,"NULL") S3method(plotly_build,gg) S3method(plotly_build,list) diff --git a/R/ggplotly.R b/R/ggplotly.R index 994d594293..6c48833330 100644 --- a/R/ggplotly.R +++ b/R/ggplotly.R @@ -684,10 +684,10 @@ 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, - linewidth = panelGrid$linewidth, - size = panelGrid$size, linetype = panelGrid$linetype ) + nm <- linewidth_or_size(panelGrid) + params[[nm]] <- panelGrid[[nm]] grill <- geom2trace.GeomPath(d, params) grill$hoverinfo <- "none" grill$showlegend <- FALSE @@ -968,7 +968,7 @@ gg2list <- function(p, width = NULL, height = NULL, bgcolor = toRGB(theme$legend.background$fill), bordercolor = toRGB(theme$legend.background$colour), borderwidth = unitConvert( - theme$legend.background$linewidth %||% theme$legend.background$size, + theme$legend.background[[linewidth_or_size(theme$legend.background)]], "pixels", "width" ), font = text2font(theme$legend.text) @@ -1203,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$linewidth %||% u$size %||% 0, "points") + grid::unit(u[[linewidth_or_size(u)]] %||% 0, "points") } else { grid::unit(u %||% 0, "mm") } @@ -1423,7 +1423,8 @@ gdef2trace <- function(gdef, theme, gglayout) { bgcolor = toRGB(theme$legend.background$fill), bordercolor = toRGB(theme$legend.background$colour), borderwidth = unitConvert( - theme$legend.background$linewidth %||% theme$legend.background$size, "pixels", "width" + theme$legend.background[[linewidth_or_size(theme$legend.background)]], + "pixels", "width" ), thickness = unitConvert( theme$legend.key.width, "pixels", "width" diff --git a/R/layers2traces.R b/R/layers2traces.R index 077a306c92..e2109d6025 100644 --- a/R/layers2traces.R +++ b/R/layers2traces.R @@ -387,13 +387,11 @@ 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) - 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) + nm <- linewidth_or_size(GeomHex) + size <- data[[nm]] + data[[nm]] <- ifelse(size < 1, size ^ (1 / 6), size ^ 6) + x <- rep.int(hexC[["x"]], n) * rep(data[[nm]], each = 6) + rep(data[["x"]], each = 6) + y <- rep.int(hexC[["y"]], n) * rep(data[[nm]], each = 6) + rep(data[["y"]], each = 6) data <- data[rep(seq_len(n), each = 6), ] data[["x"]] <- x data[["y"]] <- y @@ -563,11 +561,8 @@ to_basic.GeomSpoke <- function(data, prestats_data, layout, params, p, ...) { to_basic.GeomCrossbar <- function(data, prestats_data, layout, params, p, ...) { # from GeomCrossbar$draw_panel() 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) - } + nm <- linewidth_or_size(GeomCrossbar) + data[[nm]] <- data[[nm]] * params$fatten list( prefix_class(to_basic.GeomRect(data), "GeomCrossbar"), prefix_class(to_basic.GeomSegment(middle), "GeomCrossbar") @@ -707,9 +702,6 @@ geom2trace.GeomBlank <- function(data, params, p) { 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"]], @@ -723,7 +715,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, width_var)[1], + width = aes2plotly(data, params, linewidth_or_size(GeomPath))[1], color = toRGB( aes2plotly(data, params, "colour"), aes2plotly(data, params, "alpha") @@ -791,9 +783,6 @@ 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", @@ -819,7 +808,7 @@ geom2trace.GeomBar <- function(data, params, p) { aes2plotly(data, params, "alpha") ), line = list( - width = aes2plotly(data, params, width_var), + width = aes2plotly(data, params, linewidth_or_size(GeomBar)), color = aes2plotly(data, params, "colour") ) ) @@ -830,9 +819,6 @@ geom2trace.GeomBar <- function(data, params, p) { 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"]], @@ -844,7 +830,7 @@ geom2trace.GeomPolygon <- function(data, params, p) { type = "scatter", mode = "lines", line = list( - width = aes2plotly(data, params, width_var), + width = aes2plotly(data, params, linewidth_or_size(GeomPolygon)), color = toRGB( aes2plotly(data, params, "colour"), aes2plotly(data, params, "alpha") @@ -865,9 +851,6 @@ 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"]], @@ -894,7 +877,7 @@ geom2trace.GeomBoxplot <- function(data, params, p) { ), line = list( color = aes2plotly(data, params, "colour"), - width = aes2plotly(data, params, width_var) + width = aes2plotly(data, params, linewidth_or_size(GeomBoxplot)) ) )) } @@ -1135,6 +1118,26 @@ aes2plotly <- function(data, params, aes = "size") { converter(vals) } + +# ggplot2 3.4.0 deprecated size in favor of linewidth in line-based geoms (e.g., +# GeomLine, GeomRect, etc) and elements (e.g., element_line(), element_rect(), +# etc). Note that, some geoms (e.g., GeomBoxplot, GeomSf) can have both +# linewidth and size +linewidth_or_size <- function(x) { + UseMethod("linewidth_or_size") +} + +#' @export +linewidth_or_size.Geom <- function(x) { + if ("linewidth" %in% x$aesthetics()) "linewidth" else "size" +} + +#' @export +linewidth_or_size.element <- function(x) { + if ("linewidth" %in% names(x)) "linewidth" else "size" +} + + # Convert R pch point codes to plotly "symbol" codes. pch2symbol <- function(x) { lookup <- list( From 8afa46fcabc47c5ff8b47c05faf321a90786546b Mon Sep 17 00:00:00 2001 From: Carson Date: Thu, 3 Nov 2022 16:37:16 -0500 Subject: [PATCH 12/17] Approve new sf baseline --- tests/testthat/_snaps/ggplot-sf/sf-geom-collection.svg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/_snaps/ggplot-sf/sf-geom-collection.svg b/tests/testthat/_snaps/ggplot-sf/sf-geom-collection.svg index 0c2b2ed82a..6873be188a 100644 --- a/tests/testthat/_snaps/ggplot-sf/sf-geom-collection.svg +++ b/tests/testthat/_snaps/ggplot-sf/sf-geom-collection.svg @@ -1 +1 @@ -1234567-0.5-0.4-0.3-0.2-0.1 0.0 +1234567-0.5-0.4-0.3-0.2-0.1 0.0 From 109e4ff8e3300f0d6e58d850538d0d1ab5f8175d Mon Sep 17 00:00:00 2001 From: Carson Date: Thu, 3 Nov 2022 16:51:38 -0500 Subject: [PATCH 13/17] Fix sf issue --- R/layers2traces.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/layers2traces.R b/R/layers2traces.R index e2109d6025..946bb81161 100644 --- a/R/layers2traces.R +++ b/R/layers2traces.R @@ -986,7 +986,6 @@ split_on <- function(dat) { 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", @@ -1084,7 +1083,7 @@ aes2plotly <- function(data, params, aes = "size") { # Hack to support this geom_sf hack # https://github.com/tidyverse/ggplot2/blob/505e4bfb/R/sf.R#L179-L187 defaults <- if (inherits(data, "GeomSf")) { - type <- if (any(grepl("point", class(data)))) "point" else if (any(grepl("line", class(data)))) "line" else "" + type <- if (any(grepl("[P-p]oint", class(data)))) "point" else if (any(grepl("[L-l]ine", class(data)))) "line" else "" ggfun("default_aesthetics")(type) } else { geom_obj <- ggfun(geom) From 61d68d5decc8589d05c24e416e3798dde2e37c35 Mon Sep 17 00:00:00 2001 From: Carson Date: Thu, 3 Nov 2022 17:23:50 -0500 Subject: [PATCH 14/17] Approve new sf baseline --- tests/testthat/_snaps/ggplot-sf/sf-geom-collection.svg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/_snaps/ggplot-sf/sf-geom-collection.svg b/tests/testthat/_snaps/ggplot-sf/sf-geom-collection.svg index 6873be188a..65338ebc5d 100644 --- a/tests/testthat/_snaps/ggplot-sf/sf-geom-collection.svg +++ b/tests/testthat/_snaps/ggplot-sf/sf-geom-collection.svg @@ -1 +1 @@ -1234567-0.5-0.4-0.3-0.2-0.1 0.0 +1234567-0.5-0.4-0.3-0.2-0.1 0.0 From ce9b7cb5eb3c8c5424d7bb4fff7aeebc61691521 Mon Sep 17 00:00:00 2001 From: Carson Date: Thu, 3 Nov 2022 18:13:09 -0500 Subject: [PATCH 15/17] break_positions() no longer contains post-transformed values https://github.com/tidyverse/ggplot2/issues/5029 --- R/ggplotly.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/ggplotly.R b/R/ggplotly.R index 6c48833330..cbbba09f4b 100644 --- a/R/ggplotly.R +++ b/R/ggplotly.R @@ -732,8 +732,8 @@ gg2list <- function(p, width = NULL, height = NULL, isDiscrete <- identical(sc$scale_name, "position_d") isDiscreteType <- isDynamic && isDiscrete - ticktext <- rng[[xy]]$get_labels %()% rng[[paste0(xy, ".labels")]] - tickvals <- rng[[xy]]$break_positions %()% rng[[paste0(xy, ".major")]] + ticktext <- rng[[paste0(xy, ".labels")]] %||% rng[[xy]]$get_labels() + tickvals <- rng[[paste0(xy, ".major")]] %||% rng[[xy]]$break_positions() # https://github.com/tidyverse/ggplot2/pull/3566#issuecomment-565085809 hasTickText <- !(is.na(ticktext) | is.na(tickvals)) From 96929efef3495ccdcd21ea91043f33048ed1ff2e Mon Sep 17 00:00:00 2001 From: Carson Date: Fri, 4 Nov 2022 10:07:20 -0500 Subject: [PATCH 16/17] Add comment; prefer dimension() of the scale over .range --- R/ggplotly.R | 6 +++++- R/layers2traces.R | 2 +- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/R/ggplotly.R b/R/ggplotly.R index cbbba09f4b..4f4117098a 100644 --- a/R/ggplotly.R +++ b/R/ggplotly.R @@ -732,6 +732,10 @@ gg2list <- function(p, width = NULL, height = NULL, isDiscrete <- identical(sc$scale_name, "position_d") isDiscreteType <- isDynamic && isDiscrete + # In 3.2.x .major disappeared in favor of break_positions() + # (tidyverse/ggplot2#3436), but with 3.4.x break_positions() no longer + # yields the actual final positions on a 0-1 scale, but .major does + # (tidyverse/ggplot2#5029) ticktext <- rng[[paste0(xy, ".labels")]] %||% rng[[xy]]$get_labels() tickvals <- rng[[paste0(xy, ".major")]] %||% rng[[xy]]$break_positions() @@ -744,7 +748,7 @@ gg2list <- function(p, width = NULL, height = NULL, # TODO: log type? type = if (isDateType) "date" else if (isDiscreteType) "category" else "linear", autorange = isDynamic, - range = rng[[paste0(xy, ".range")]] %||% rng[[paste0(xy, "_range")]], + range = rng[[xy]]$dimension %()% rng[[paste0(xy, ".range")]] %||% rng[[paste0(xy, "_range")]], tickmode = if (isDynamic) "auto" else "array", ticktext = ticktext, tickvals = tickvals, diff --git a/R/layers2traces.R b/R/layers2traces.R index 946bb81161..124d2fd595 100644 --- a/R/layers2traces.R +++ b/R/layers2traces.R @@ -701,7 +701,6 @@ geom2trace.GeomBlank <- function(data, params, p) { #' @export geom2trace.GeomPath <- function(data, params, p) { data <- group2NA(data) - L <- list( x = data[["x"]], y = data[["y"]], @@ -817,6 +816,7 @@ geom2trace.GeomBar <- function(data, params, p) { #' @export geom2trace.GeomPolygon <- function(data, params, p) { + data <- group2NA(data) L <- list( From 25a2c8d30ace9259633e770b5fc381946d61db30 Mon Sep 17 00:00:00 2001 From: Carson Date: Fri, 4 Nov 2022 10:23:41 -0500 Subject: [PATCH 17/17] Approve new log2-coord baseline (with more correct y-range) --- .../testthat/_snaps/cookbook-axes/cookbook-axes-log2-coord.svg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/_snaps/cookbook-axes/cookbook-axes-log2-coord.svg b/tests/testthat/_snaps/cookbook-axes/cookbook-axes-log2-coord.svg index ad7f36fa5c..436c8ff705 100644 --- a/tests/testthat/_snaps/cookbook-axes/cookbook-axes-log2-coord.svg +++ b/tests/testthat/_snaps/cookbook-axes/cookbook-axes-log2-coord.svg @@ -1 +1 @@ -0123451e+062e+063e+06xvalyval +0123451e+062e+063e+06xvalyval