Geom errorbar issure 1751 (#1779)

* Fix bug. If is.null(data_xy): Set data_xy to mean of data_xy_min and data_xy_max.

* Add test. Check geom_errorbar is rendered when y aes is not set.

* Fix bug. geom_errobar is now rendered with flipped aes. Add test.

* Minor fixes. Add explanation and reprex for flipped_aes in geom2trace.GeomErrorbar. Simplify code in make_error.

* Update R/layers2traces.R

* Add visual test to check that geom_errobar is rendered when y aes is not set.

* Add visual test to check that geom_errobar is rendered with flipped aes.

Author: trekonom

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"]],

tests/figs/errorbar/errobar-flipped-aes.svg

@@ -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)
+  
+})

tests/figs/errorbar/errobar-no-aes-y.svg

@@ -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)
+})