bug fixes for GeomTile, GeomPoint, and hoverinfo

Author: cpsievert

.Rbuildignore

@@ -4,3 +4,4 @@
 ^data-raw$
 CONDUCT.md
 CONTRIBUTING.md
+build_site.R

R/ggplotly.R

@@ -191,7 +191,7 @@ gg2list <- function(p, width = NULL, height = NULL, tooltip = "all", source = "A
     map <- sub("^\\.\\.", "", sub("\\.\\.$", "", map))
     # TODO: allow users to specify a _list_ of mappings?
     if (!identical(tooltip, "all")) {
-      map <- map[names(map) %in% tooltip]
+      map <- map[tooltip]
     }
     # tooltips for discrete positional scales are misleading
     if (scales$get_scales("x")$is_discrete()) {
@@ -220,12 +220,14 @@ gg2list <- function(p, width = NULL, height = NULL, tooltip = "all", source = "A
         if ("datetime" %in% scaleName) forMat <- function(x) as.POSIXct(x / 1000, origin = "1970-01-01")
         # convert "days from the UNIX epoch" to a date/datetime
         if ("date" %in% scaleName) forMat <- function(x) as.Date(as.POSIXct(x * 86400, origin = "1970-01-01"))
-      } else {
-        if (aesName != "text") aesName <- paste0(aesName, "_plotlyDomain")
       }
       # add a line break if hovertext already exists
       if ("hovertext" %in% names(x)) x$hovertext <- paste0(x$hovertext, "<br>")
-      x$hovertext <- paste0(x$hovertext, varName, ": ", forMat(x[[aesName]]))
+      x$hovertext <- paste0(
+        x$hovertext, 
+        varName, ": ", 
+        forMat(x[[paste0(aesName, "_plotlyDomain")]] %||% x[[aesName]])
+      )
     }
     x
   }, data, aesMap)

R/layers2traces.R

@@ -380,7 +380,8 @@ geom2trace.GeomPoint <- function(data, params) {
   )
   # fill is irrelevant for pch %in% c(1, 15:20)
   pch <- uniq(data$shape) %||% params$shape %||% GeomPoint$default_aes$shape
-  if (any(pch %in% c(1, 15:20))) {
+  if (any(pch %in% c(1, 15:20)) ||
+      all(grepl("open$", shape)) && all(L$marker$color %in% "transparent")) {
     L$marker$color <- L$marker$line$color
   }
   L
@@ -491,27 +492,23 @@ geom2trace.GeomText <- function(data, params) {
 #' @export
 geom2trace.GeomTile <- function(data, params) {
   # make sure order of value make sense before throwing z in matrix
-  data <- data[order(data$x, order(data$y, decreasing = T)), ]
+  data <- data[order(order(data$x), data$y), ]
   x <- sort(unique(data$x))
   y <- sort(unique(data$y))
-  fill <- data$fill_plotlyDomain
-  colorscale <- cbind(
-    c(0, 1),
-    data[c(which.min(fill), which.max(fill)), "fill"]
-  )
+  fill <- scales::rescale(data$fill_plotlyDomain)
+  txt <- data$hovertext
+  # create the colorscale, which should ignore NAs
+  data <- data[!is.na(fill), ]
+  o <- data[order(data$fill_plotlyDomain), "fill"]
+  n <- length(o)
+  qs <- seq(0, 1, length.out = min(n, 100))
+  idx <- o[pmax(1, round(n * qs))]
+  colorscale <- cbind(qs, idx)
   list(
     x = x,
     y = y,
-    z = matrix(
-      scales::rescale(fill), 
-      nrow = length(y), 
-      ncol = length(x)
-    ),
-    text = matrix(
-      data$hovertext, 
-      nrow = length(y), 
-      ncol = length(x)
-    ),
+    z = matrix(fill, nrow = length(y), ncol = length(x)),
+    text = matrix(txt, nrow = length(y), ncol = length(x)),
     colorscale = colorscale,
     type = "heatmap",
     showscale = FALSE,
@@ -619,10 +616,10 @@ make_error <- function(data, params, xy = "x") {
   e <- list(
     x = data$x,
     y = data$y,
+    text = data$hovertext,
     type = "scatter",
     mode = "lines",
     opacity = 0,
-    hoverinfo = "none",
     line = list(color = color)
   )
   e[[paste0("error_", xy)]] <- list(

tests/testthat/test-ggplot-density.R

@@ -1,7 +1,6 @@
 context("Probability density")
 
 expect_traces <- function(gg, n.traces, name) {
-  stopifnot(is.ggplot(gg))
   stopifnot(is.numeric(n.traces))
   L <- save_outputs(gg, paste0("density-", name))
   all.traces <- L$data
@@ -73,3 +72,12 @@ test_that("traces are ordered correctly in geom_density", {
   expect_identical(nms, c("4", "6", "8"))
 })
 
+test_that("tooltip argument respects ordering", {
+  p <- qplot(mpg, fill = factor(cyl), data = mtcars, geom = "density")
+  p <- ggplotly(p, tooltip = c("y", "x"))
+  info <- expect_traces(p, 3, "tooltip-order")
+  txt <- strsplit(info$data[[1]]$text, "<br>")
+  expect_true(all(grepl("^density", sapply(txt, "[[", 1))))
+  expect_true(all(grepl("^mpg", sapply(txt, "[[", 2))))
+})
+

tests/testthat/test-ggplot-point.R

@@ -23,6 +23,17 @@ test_that("geom_point size & alpha translate to a single trace", {
   expect_equal(length(mkr$opacity), nrow(mtcars))
 })
 
+test_that("marker color is non-transparent for open shapes", {
+  p <- ggplot(mtcars, aes(mpg, wt)) + geom_point(pch = 2)
+  info <- save_outputs(p, "open-shapes")
+  expect_true(
+    grepl("open$", info$data[[1]]$marker$symbol)
+  )
+  expect_true(
+    info$data[[1]]$marker$color == toRGB(GeomPoint$default_aes$colour)
+  )
+})
+
 test_that("can plot on sub-second time scale", {
   d <- data.frame(
     x = Sys.time() + 1e-3 * c(1:9, 5000),