Merge pull request #773 from zeehio/fix_tooltip_on_geom_line_group

Fix wrong tooltip when ggplotly with geom_line(group=)

Author: cpsievert

NEWS.md

@@ -17,6 +17,7 @@
 * When `height`/`width` are specified in `ggplotly()`, relative sizes are now translated correctly. Fixes #489 and #510.
 * More careful handling of font when expanding annotation arrays. Fixes #738.
 * Ignore data arrays of non-tidy traces. Fixes #737.
+* When using `ggplotly()` on a plot with `geom_line` and `group` aesthetic wrong tooltip information was shown. Fixes #774.
 
 # 4.5.5 -- 28 September 2016
 

R/ggplotly.R

@@ -174,7 +174,19 @@ gg2list <- function(p, width = NULL, height = NULL, tooltip = "all",
 
   # Compute aesthetics to produce data with generalised variable names
   data <- by_layer(function(l, d) l$compute_aesthetics(d, plot))
-  
+
+  # The computed aesthetic codes the groups as integers
+  # Here we build a map each of the integer values to the group label
+  group_maps <- Map(function(x, y) {
+    tryCatch({
+      x_group <- x[["group"]]
+      names(x_group) <- y
+      x_group <- x_group[!duplicated(x_group)]
+      x_group
+    }, error = function(e) NULL
+    )
+  }, data, groupDomains)
+
   # Transform all scales
   data <- lapply(data, ggfun("scales_transform_df"), scales = scales)
 
@@ -205,7 +217,17 @@ gg2list <- function(p, width = NULL, height = NULL, tooltip = "all",
 
   # Reparameterise geoms from (e.g.) y and width to ymin and ymax
   data <- by_layer(function(l, d) l$compute_geom_1(d))
-  
+
+  # compute_geom_1 can reorder the rows from `data`, making groupDomains
+  # invalid. We rebuild groupDomains based on the current `data` and the
+  # group map we built before.
+  groupDomains <- Map(function(x, y) {
+    tryCatch({
+      names(y)[match(x$group, y)]
+    }, error = function(e) NULL
+    )
+  }, data, group_maps)
+
   # Apply position adjustments
   data <- by_layer(function(l, d) l$compute_position(d, layout))
 

tests/testthat/test-ggplot-tooltip.R

@@ -69,6 +69,27 @@ test_that("group domain is included in hovertext", {
   expect_true(all(grepl(pattern, txt)))
 })
 
+test_that("tooltip elements are not crossed", {
+  # Tooltips with y == 10 should belong to Sample2 in this example
+  mydata <- data.frame(id = paste0("Sample", rep(1:2, times = 4)),
+                       x = rep(1:4, each = 2),
+                       y = rep(c(1, 10), times = 4),
+                       stringsAsFactors = FALSE)
+  #        id x  y
+  # 1 Sample1 1  1
+  # 2 Sample2 1 10
+  # 3 Sample1 2  1
+  # 4 Sample2 2 10
+  # 5 Sample1 3  1
+  # 6 Sample2 3 10
+  # 7 Sample1 4  1
+  # 8 Sample2 4 10
+  gplt <- ggplot(mydata) + geom_line(aes(x=x, y = y, group = id))
+  pltly <- plotly::ggplotly(gplt)
+  y_equal_ten <- grepl("y: 10", pltly$x$data[[1]]$text)
+  sample_2 <- grepl("id: Sample2", pltly$x$data[[1]]$text)
+  expect_equal(y_equal_ten, sample_2)
+})
 
 labelDF <- data.frame(
   label = paste0(("label"), c(1:10)),