diff --git a/R/layers2traces.R b/R/layers2traces.R index 6920e6ce4c..3428ea67ac 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,17 @@ geom2trace.GeomTile <- function(data, params, p) { #' @export geom2trace.GeomErrorbar <- function(data, params, p) { - make_error(data, params, "y") + # Support of bi-directional GeomErrorbar introduced with ggplot2 3.3.0 + # g <- ggplot() + geom_errorbar(aes(y = "A", xmin = 1, xmax = 2)) + # ggplotly(g) +# 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") + } } #' @export @@ -951,6 +965,8 @@ 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 + data[[xy]] <- data[[xy]] %||% ((data[[paste0(xy, "min")]] + data[[paste0(xy, "max")]]) / 2) color <- aes2plotly(data, params, "colour") e <- list( x = data[["x"]], 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/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-flipped-aes.R b/tests/testthat/test-geom-errorbar-flipped-aes.R new file mode 100644 index 0000000000..9a6de5e4c1 --- /dev/null +++ b/tests/testthat/test-geom-errorbar-flipped-aes.R @@ -0,0 +1,28 @@ +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 + # 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) + + 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) + +}) 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..1b6c86a9cd --- /dev/null +++ b/tests/testthat/test-geom-errorbar-issue-1751.R @@ -0,0 +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") + ) + + # 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 + 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) +})