From 6556b9fbebfa02afa84891a82cdad562ba2963bd Mon Sep 17 00:00:00 2001 From: Stefan Moog Date: Wed, 27 May 2020 23:18:54 +0200 Subject: [PATCH 1/7] Fix bug. If is.null(data_xy): Set data_xy to mean of data_xy_min and data_xy_max. --- R/layers2traces.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/layers2traces.R b/R/layers2traces.R index 6920e6ce4c..aee43e2e93 100644 --- a/R/layers2traces.R +++ b/R/layers2traces.R @@ -951,6 +951,10 @@ hover_on <- function(data) { # make trace with errorbars make_error <- function(data, params, xy = "x") { + # if xy is NULL: set xy to mean of xy_min and xy_max + if (is.null(data[[xy]])) { + data[[xy]] <- (data[[paste0(xy, "min")]] + data[[paste0(xy, "max")]]) / 2 + } color <- aes2plotly(data, params, "colour") e <- list( x = data[["x"]], From 8e77da537b97bb64169ef61625712119b9b99059 Mon Sep 17 00:00:00 2001 From: Stefan Moog Date: Sat, 30 May 2020 01:12:40 +0200 Subject: [PATCH 2/7] Add test. Check geom_errorbar is rendered when y aes is not set. --- .../testthat/test-geom-errorbar-issue-1751.R | 35 +++++++++++++++++++ 1 file changed, 35 insertions(+) create mode 100644 tests/testthat/test-geom-errorbar-issue-1751.R diff --git a/tests/testthat/test-geom-errorbar-issue-1751.R b/tests/testthat/test-geom-errorbar-issue-1751.R new file mode 100644 index 0000000000..d1e5c838d5 --- /dev/null +++ b/tests/testthat/test-geom-errorbar-issue-1751.R @@ -0,0 +1,35 @@ +context("Errorbar") + +test_that("geom_errobar is rendered when y aes is not set", { + + # Example from issue #1751 + d <- data.frame(auc=c(0.268707482993197,0.571428571428571), + sup=c(0.407680628614317,0.648343533190079), + inf=c(0.129734337372078,0.494513609667063), + Names = c("Firmicutes","Spirochaetes")) + + # Plot with y aes set + p <- ggplot(d, aes(Names)) + + geom_errorbar(aes(y = auc, ymin = inf, ymax = sup)) + + L <- plotly_build(p) + + # Plot with y aes not set + p1 <- ggplot(d, aes(Names)) + + geom_errorbar(aes(ymin = inf, ymax = sup)) + + L1 <- plotly_build(p1) + + # Tests + ## array and arrayminus of L and L1 are equivalent + expect_equivalent(L[["x"]][["data"]][[1]][["error_y"]][["array"]], + L1[["x"]][["data"]][[1]][["error_y"]][["array"]]) + + expect_equivalent(L[["x"]][["data"]][[1]][["error_y"]][["arrayminus"]], + L1[["x"]][["data"]][[1]][["error_y"]][["arrayminus"]]) + + ## array equals difference between sup and auc, array equals difference between auc and inf + expect_equivalent(L1[["x"]][["data"]][[1]]$error_y$array, d$sup - d$auc) + expect_equivalent(L1[["x"]][["data"]][[1]]$error_y$arrayminus, d$auc - d$inf) + +}) From 198b2518acd70c7ed72e256c114ac2cea5436729 Mon Sep 17 00:00:00 2001 From: Stefan Moog Date: Sat, 30 May 2020 15:36:49 +0200 Subject: [PATCH 3/7] Fix bug. geom_errobar is now rendered with flipped aes. Add test. --- R/layers2traces.R | 12 +++++++-- .../testthat/test-geom-errorbar-flipped-aes.R | 26 +++++++++++++++++++ 2 files changed, 36 insertions(+), 2 deletions(-) create mode 100644 tests/testthat/test-geom-errorbar-flipped-aes.R diff --git a/R/layers2traces.R b/R/layers2traces.R index aee43e2e93..9bba136deb 100644 --- a/R/layers2traces.R +++ b/R/layers2traces.R @@ -451,7 +451,11 @@ to_basic.GeomErrorbar <- function(data, prestats_data, layout, params, p, ...) { # width for ggplot2 means size of the entire bar, on the data scale # (plotly.js wants half, in pixels) data <- merge(data, layout$layout, by = "PANEL", sort = FALSE) - data$width <- (data[["xmax"]] - data[["x"]]) /(data[["x_max"]] - data[["x_min"]]) + data$width <- if (params[["flipped_aes"]]) { + (data[["ymax"]] - data[["y"]]) /(data[["y_max"]] - data[["y_min"]]) + } else { + (data[["xmax"]] - data[["x"]]) /(data[["x_max"]] - data[["x_min"]]) + } data$fill <- NULL prefix_class(data, "GeomErrorbar") } @@ -873,7 +877,11 @@ geom2trace.GeomTile <- function(data, params, p) { #' @export geom2trace.GeomErrorbar <- function(data, params, p) { - make_error(data, params, "y") + if (params[["flipped_aes"]]) { + make_error(data, params, "x") + } else { + make_error(data, params, "y") + } } #' @export diff --git a/tests/testthat/test-geom-errorbar-flipped-aes.R b/tests/testthat/test-geom-errorbar-flipped-aes.R new file mode 100644 index 0000000000..02dcb1eb97 --- /dev/null +++ b/tests/testthat/test-geom-errorbar-flipped-aes.R @@ -0,0 +1,26 @@ +context("Errorbar") + +test_that("geom_errobar is rendered with flipped aes", { + + df <- dplyr::group_by(iris, Species) + df <- dplyr::summarise_if(df, is.numeric, list(m = mean, q1 = ~ quantile(.x, .25), q3 = ~ quantile(.x, .75))) + gp <- ggplot(df, aes(y = Species, xmin = Sepal.Width_q1, xmax = Sepal.Width_q3)) + + geom_errorbar() + + L <- plotly_build(gp) + + # Tests + # xmin and xmax equal to ggplot + expect_equivalent(L[["x"]][["data"]][[1]][["x"]] + L[["x"]][["data"]][[1]][["error_x"]][["array"]], + ggplot_build(gp)$data[[1]]$xmax) + + expect_equivalent(L[["x"]][["data"]][[1]][["x"]] - L[["x"]][["data"]][[1]][["error_x"]][["arrayminus"]], + ggplot_build(gp)$data[[1]]$xmin) + # xmin and xmax equal to data + expect_equivalent(L[["x"]][["data"]][[1]][["x"]] + L[["x"]][["data"]][[1]][["error_x"]][["array"]], + df$Sepal.Width_q3) + + expect_equivalent(L[["x"]][["data"]][[1]][["x"]] - L[["x"]][["data"]][[1]][["error_x"]][["arrayminus"]], + df$Sepal.Width_q1) + +}) From f66ab6f1e536524d4c8d583970e3d97f1caf2af0 Mon Sep 17 00:00:00 2001 From: Stefan Moog Date: Tue, 2 Jun 2020 10:20:36 +0200 Subject: [PATCH 4/7] Minor fixes. Add explanation and reprex for flipped_aes in geom2trace.GeomErrorbar. Simplify code in make_error. --- R/layers2traces.R | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/R/layers2traces.R b/R/layers2traces.R index 9bba136deb..32efa43f22 100644 --- a/R/layers2traces.R +++ b/R/layers2traces.R @@ -877,6 +877,9 @@ geom2trace.GeomTile <- function(data, params, p) { #' @export geom2trace.GeomErrorbar <- function(data, params, p) { + # Support of bi-directional GeomErrorbar introduced with ggplot2 3.3.0 + # g <- ggplot() + geom_errorbar(aes(y = "A", xmin = 1, xmax = 2)) + # ggplotly(g) if (params[["flipped_aes"]]) { make_error(data, params, "x") } else { @@ -960,9 +963,7 @@ hover_on <- function(data) { # make trace with errorbars make_error <- function(data, params, xy = "x") { # if xy is NULL: set xy to mean of xy_min and xy_max - if (is.null(data[[xy]])) { - data[[xy]] <- (data[[paste0(xy, "min")]] + data[[paste0(xy, "max")]]) / 2 - } + data[[xy]] <- data[[xy]] %||% ((data[[paste0(xy, "min")]] + data[[paste0(xy, "max")]]) / 2) color <- aes2plotly(data, params, "colour") e <- list( x = data[["x"]], From cc287e1a5f9dd948ee54f1ea931a9fcad70c69f9 Mon Sep 17 00:00:00 2001 From: Stefan Moog Date: Tue, 2 Jun 2020 23:00:35 +0200 Subject: [PATCH 5/7] Update R/layers2traces.R --- R/layers2traces.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/R/layers2traces.R b/R/layers2traces.R index 32efa43f22..3428ea67ac 100644 --- a/R/layers2traces.R +++ b/R/layers2traces.R @@ -880,7 +880,10 @@ geom2trace.GeomErrorbar <- function(data, params, p) { # Support of bi-directional GeomErrorbar introduced with ggplot2 3.3.0 # g <- ggplot() + geom_errorbar(aes(y = "A", xmin = 1, xmax = 2)) # ggplotly(g) - if (params[["flipped_aes"]]) { +# Support of bi-directional GeomErrorbar introduced with ggplot2 3.3.0: +# g <- ggplot() + geom_errorbar(aes(y = "A", xmin = 1, xmax = 2)) +# ggplotly(g) +if (params[["flipped_aes"]]) { make_error(data, params, "x") } else { make_error(data, params, "y") From 68ebe6a86b8fbd8e742262e29ae14cac41ad5fa9 Mon Sep 17 00:00:00 2001 From: Stefan Moog Date: Wed, 17 Jun 2020 23:20:10 +0200 Subject: [PATCH 6/7] Add visual test to check that geom_errobar is rendered when y aes is not set. --- tests/figs/errorbar/errobar-no-aes-y.svg | 1 + .../testthat/test-geom-errorbar-issue-1751.R | 35 ++++++++++--------- 2 files changed, 19 insertions(+), 17 deletions(-) create mode 100644 tests/figs/errorbar/errobar-no-aes-y.svg diff --git a/tests/figs/errorbar/errobar-no-aes-y.svg b/tests/figs/errorbar/errobar-no-aes-y.svg new file mode 100644 index 0000000000..607da31ac1 --- /dev/null +++ b/tests/figs/errorbar/errobar-no-aes-y.svg @@ -0,0 +1 @@ +FirmicutesSpirochaetes0.20.30.40.50.6Names diff --git a/tests/testthat/test-geom-errorbar-issue-1751.R b/tests/testthat/test-geom-errorbar-issue-1751.R index d1e5c838d5..1b6c86a9cd 100644 --- a/tests/testthat/test-geom-errorbar-issue-1751.R +++ b/tests/testthat/test-geom-errorbar-issue-1751.R @@ -1,35 +1,36 @@ context("Errorbar") test_that("geom_errobar is rendered when y aes is not set", { - + # Example from issue #1751 - d <- data.frame(auc=c(0.268707482993197,0.571428571428571), - sup=c(0.407680628614317,0.648343533190079), - inf=c(0.129734337372078,0.494513609667063), - Names = c("Firmicutes","Spirochaetes")) - + d <- data.frame( + auc = c(0.268707482993197, 0.571428571428571), + sup = c(0.407680628614317, 0.648343533190079), + inf = c(0.129734337372078, 0.494513609667063), + Names = c("Firmicutes", "Spirochaetes") + ) + # Plot with y aes set p <- ggplot(d, aes(Names)) + geom_errorbar(aes(y = auc, ymin = inf, ymax = sup)) - L <- plotly_build(p) - + # Plot with y aes not set p1 <- ggplot(d, aes(Names)) + geom_errorbar(aes(ymin = inf, ymax = sup)) - L1 <- plotly_build(p1) - + # Tests + # errobar is rendered + expect_doppelganger(L1, "errobar-no-aes-y") ## array and arrayminus of L and L1 are equivalent - expect_equivalent(L[["x"]][["data"]][[1]][["error_y"]][["array"]], - L1[["x"]][["data"]][[1]][["error_y"]][["array"]]) - - expect_equivalent(L[["x"]][["data"]][[1]][["error_y"]][["arrayminus"]], - L1[["x"]][["data"]][[1]][["error_y"]][["arrayminus"]]) - + lapply(c("array", "arrayminus"), function(x) { + expect_equivalent( + L[["x"]][["data"]][[1]][["error_y"]][[x]], + L1[["x"]][["data"]][[1]][["error_y"]][[x]] + ) + }) ## array equals difference between sup and auc, array equals difference between auc and inf expect_equivalent(L1[["x"]][["data"]][[1]]$error_y$array, d$sup - d$auc) expect_equivalent(L1[["x"]][["data"]][[1]]$error_y$arrayminus, d$auc - d$inf) - }) From 546d5e85afa14f3bf9b5964010a4dd8b3d3de7e1 Mon Sep 17 00:00:00 2001 From: Stefan Moog Date: Wed, 17 Jun 2020 23:20:40 +0200 Subject: [PATCH 7/7] Add visual test to check that geom_errobar is rendered with flipped aes. --- tests/figs/errorbar/errobar-flipped-aes.svg | 1 + tests/testthat/test-geom-errorbar-flipped-aes.R | 2 ++ 2 files changed, 3 insertions(+) create mode 100644 tests/figs/errorbar/errobar-flipped-aes.svg diff --git a/tests/figs/errorbar/errobar-flipped-aes.svg b/tests/figs/errorbar/errobar-flipped-aes.svg new file mode 100644 index 0000000000..00c3c60fe9 --- /dev/null +++ b/tests/figs/errorbar/errobar-flipped-aes.svg @@ -0,0 +1 @@ +2.502.753.003.253.50setosaversicolorvirginicaSpecies diff --git a/tests/testthat/test-geom-errorbar-flipped-aes.R b/tests/testthat/test-geom-errorbar-flipped-aes.R index 02dcb1eb97..9a6de5e4c1 100644 --- a/tests/testthat/test-geom-errorbar-flipped-aes.R +++ b/tests/testthat/test-geom-errorbar-flipped-aes.R @@ -10,6 +10,8 @@ test_that("geom_errobar is rendered with flipped aes", { L <- plotly_build(gp) # Tests + # errobar is rendered + expect_doppelganger(L, "errobar-flipped-aes") # xmin and xmax equal to ggplot expect_equivalent(L[["x"]][["data"]][[1]][["x"]] + L[["x"]][["data"]][[1]][["error_x"]][["array"]], ggplot_build(gp)$data[[1]]$xmax)