Merge branch 'master' into v1.42.2

Author: cpsievert

NEWS.md

@@ -12,15 +12,18 @@
 * The `style()` function now supports "partial updates" (i.e. modification of a particular property of an object, rather than the entire object). For example, notice how the first plot retains the original marker shape (a square): `p <- plot_ly(x = 1:10, y = 1:10, symbol = I(15)); subplot(style(p, marker.color = "red"), style(p, marker = list(color = "red")))` (#1342).
 * **plotly** objects can now be serialized and unserialized in different environments (i.e., you can now use `saveRDS()` to save an object as an rds file and restore it on another machine with `readRDS()`). Note this object is *dynamically* linked to JavaScript libraries, so one should take care to use consistent versions of **plotly** when serializing and unserializing (#1376).
 * The `plotly_example()` will now attempt to open the source file(s) used to run the example. Set `edit = FALSE` to prevent the source file(s) from opening.
+* The `event_data()` function now relays the (official plotly.js) `customdata` attribute in similar fashion to (unofficial) `key` attribute (#1423).
+
 
 ## CHANGES
 
 * The 'collaborate' button no longer appears in the modebar, and as a result, the `config()` function no longer has a `collaborate` argument.
 
 ## BUG FIXES
 
-* `subplot()` now bumps annotation `xref`/`yref` anchors correctly (#1181).
-* `subplot()` now accumulates images, repositions paper coordinates, and reanchors axis references (#1332).
+* `subplot()` now works much better with annotations, images, and shapes:
+  - When `xref`/`yref` references an x/y axis these references are bumped accordingly (#1181).
+  - When `xref`/`yref` references paper coordinates, these coordinates are updated accordingly (#1332).
 * `event_data("plotly_selected")` is no longer too eager to clear. That is, it is no longer set to `NULL` when clicking on a plot *after* triggering the "plotly_selected" event (#1121) (#1122).
 * The colorscale generated via the `color` argument in `plot_ly()` now uses an evenly spaced grid of values instead of quantiles (#1308).
 * When using **shinytest** to test a **shiny** that contains **plotly** graph, false positive differences are no longer reported (rstudio/shinytest#174). 
@@ -31,6 +34,7 @@
 * An articial marker no longer appears when clearing a crosstalk selection of a plot with a colorbar (#1406).
 * Clearing a highlight event via crosstalk no longer deletes all the traces added since initial draw (#1436).
 * Recursive attribute validation is now only performed on recursive objects (#1315).
+* The `text` attribute is no longer collapsed to a string when `hoveron='fills+points'` (#1448). 
 
 # 4.8.0
 

R/layers2traces.R

@@ -637,6 +637,7 @@ geom2trace.GeomPath <- function(data, params, p) {
     y = data[["y"]],
     text = uniq(data[["hovertext"]]),
     key = data[["key"]],
+    customdata = data[["customdata"]],
     frame = data[["frame"]],
     ids = data[["ids"]],
     type = "scatter",
@@ -667,6 +668,7 @@ geom2trace.GeomPoint <- function(data, params, p) {
     y = data[["y"]],
     text = if (isDotPlot) data[["key"]] else uniq(data[["hovertext"]]),
     key = data[["key"]],
+    customdata = data[["customdata"]],
     frame = data[["frame"]],
     ids = data[["ids"]],
     type = "scatter",
@@ -720,6 +722,7 @@ geom2trace.GeomBar <- function(data, params, p) {
     y = y,
     text = uniq(data[["hovertext"]]),
     key = data[["key"]],
+    customdata = data[["customdata"]],
     frame = data[["frame"]],
     ids = data[["ids"]],
     type = "bar",
@@ -747,6 +750,7 @@ geom2trace.GeomPolygon <- function(data, params, p) {
     y = data[["y"]],
     text = uniq(data[["hovertext"]]),
     key = data[["key"]],
+    customdata = data[["customdata"]],
     frame = data[["frame"]],
     ids = data[["ids"]],
     type = "scatter",
@@ -778,6 +782,7 @@ geom2trace.GeomBoxplot <- function(data, params, p) {
     y = data[["y"]],
     hoverinfo = "y",
     key = data[["key"]],
+    customdata = data[["customdata"]],
     frame = data[["frame"]],
     ids = data[["ids"]],
     type = "box",
@@ -812,6 +817,7 @@ geom2trace.GeomText <- function(data, params, p) {
     text = data[["label"]],
     hovertext = data[["hovertext"]],
     key = data[["key"]],
+    customdata = data[["customdata"]],
     frame = data[["frame"]],
     ids = data[["ids"]],
     textfont = list(
@@ -850,6 +856,7 @@ geom2trace.GeomTile <- function(data, params, p) {
     z = matrix(g$fill_plotlyDomain, nrow = length(y), ncol = length(x), byrow = TRUE),
     text = matrix(g$hovertext, nrow = length(y), ncol = length(x), byrow = TRUE),
     key = data[["key"]],
+    customdata = data[["customdata"]],
     frame = data[["frame"]],
     ids = data[["ids"]],
     colorscale = setNames(colScale, NULL),
@@ -945,6 +952,7 @@ make_error <- function(data, params, xy = "x") {
     y = data[["y"]],
     text = uniq(data[["hovertext"]]),
     key = data[["key"]],
+    customdata = data[["customdata"]],
     frame = data[["frame"]],
     ids = data[["ids"]],
     type = "scatter",

R/plotly_build.R

@@ -190,6 +190,8 @@ plotly_build.plotly <- function(p, registerFrames = TRUE) {
     tr <- trace[names(trace) %in% allAttrs]
     # TODO: does it make sense to "train" matrices/2D-tables (e.g. z)?
     tr <- tr[vapply(tr, function(x) is.null(dim(x)) && is.atomic(x), logical(1))]
+    # white-list customdata as this can be a non-atomic vector
+    tr$customdata <- trace$customdata
     builtData <- tibble::as_tibble(tr)
     # avoid clobbering I() (i.e., variables that shouldn't be scaled)
     for (i in seq_along(tr)) {
@@ -266,7 +268,7 @@ plotly_build.plotly <- function(p, registerFrames = TRUE) {
 
   # insert NAs to differentiate groups
   traces <- lapply(traces, function(x) {
-    d <- data.frame(x[names(x) %in% x$.plotlyVariableMapping], stringsAsFactors = FALSE)
+    d <- tibble::as_tibble(x[names(x) %in% x$.plotlyVariableMapping])
     d <- group2NA(
       d, if (has_group(x)) ".plotlyGroupIndex",
       ordered = if (inherits(x, "plotly_line")) "x",

R/subplots.R

@@ -207,30 +207,31 @@ subplot <- function(..., nrows = 1, widths = NULL, heights = NULL, margin = 0.02
       map <- xMap[xMap %in% sub("x", "xaxis", yAxes[[i]][[j]]$anchor %||% "x")]
       yAxes[[i]][[j]]$anchor <- sub("axis", "", names(map))
     }
-    # map trace xaxis/yaxis/geo attributes
+    
     for (key in c("geo", "subplot", "xaxis", "yaxis")) {
+      # bump trace axis references
       oldAnchors <- unlist(lapply(traces[[i]], "[[", key))
       if (!length(oldAnchors)) next
       axisMap <- if (key == "yaxis") yMap else xMap
       axisMap <- setNames(sub("axis", "", axisMap), sub("axis", "", names(axisMap)))
       newAnchors <- names(axisMap)[match(oldAnchors, axisMap)]
       traces[[i]] <- Map(function(tr, a) { tr[[key]] <- a; tr }, traces[[i]], newAnchors)
-      # also map annotation and image xaxis/yaxis references
-      # TODO: do this for shapes as well?
+      
+      # bump annotation, image, shape xref/yref
+      # (none of these layout components have geo/subplot support)
       ref <- list(xaxis = "xref", yaxis = "yref")[[key]]
       if (is.null(ref)) next
-      if (length(annotations[[i]])) {
-        annotations[[i]] <- Map(function(x, y) { 
-          if (!identical(x[[ref]], "paper")) x[[ref]] <- y 
-          x
-        }, annotations[[i]], newAnchors)
-      }
-      if (length(images[[i]])) {
-        images[[i]] <- Map(function(x, y) { 
-          if (!identical(x[[ref]], "paper")) x[[ref]] <- y 
-          x
-        }, images[[i]], newAnchors)
+      bump_axis_ref <- function(obj, ref_default = sub("ref", "", ref)) {
+        # TODO: throw error/warning if ref_default doesn't match axisMap?
+        obj[[ref]] <- obj[[ref]] %||% ref_default
+        if (identical(obj[[ref]], "paper")) return(obj)
+        refIdx <- match(obj[[ref]], axisMap)
+        if (!is.na(refIdx)) obj[[ref]] <- names(axisMap)[refIdx][1]
+        obj
       }
+      annotations[[i]] <- lapply(annotations[[i]], bump_axis_ref)
+      shapes[[i]] <- lapply(shapes[[i]], bump_axis_ref)
+      images[[i]] <- lapply(images[[i]], bump_axis_ref, "paper")
     }
 
 

R/utils.R

@@ -476,8 +476,9 @@ verify_attr <- function(proposed, schema) {
       proposed[[attr]] <- retain(proposed[[attr]], uniq)
     }
 
-    # plotly.js should really handle this logic
-    if (isTRUE(grepl("fill", proposed[["hoveron"]]))) {
+    # If we deliberately only want hover on fills, send a string to 
+    # plotly.js so it does something sensible 
+    if (identical(proposed[["hoveron"]], "fills")) {
       proposed[["text"]] <- paste(uniq(proposed[["text"]]), collapse = "\n")
     }
 

demo/ternary.R

@@ -51,7 +51,7 @@ plot_ly(
 
 plot_ly(
   df, a = ~clay, b = ~sand, c = ~silt, color = ~id, type = "scatterternary",
-  fill = "toself", mode = "lines", 
+  fill = "toself", mode = "lines"
 ) %>%
   layout(
     annotations = label("Ternary Contour"), ternary = ternaryAxes

inst/examples/shiny/event_data/app.R

@@ -15,10 +15,10 @@ server <- function(input, output, session) {
 
   output$plot <- renderPlotly({
     if (identical(input$plotType, "ggplotly")) {
-      p <- ggplot(mtcars, aes(x = mpg, y = wt, key = nms)) + geom_point()
+      p <- ggplot(mtcars, aes(x = mpg, y = wt, customdata = nms)) + geom_point()
       ggplotly(p) %>% layout(dragmode = "select")
     } else {
-      plot_ly(mtcars, x = ~mpg, y = ~wt, key = nms) %>%
+      plot_ly(mtcars, x = ~mpg, y = ~wt, customdata = nms) %>%
         layout(dragmode = "select")
     }
   })

inst/htmlwidgets/plotly.js

@@ -236,6 +236,10 @@ HTMLWidgets.widget({
           obj.z = pt.z;
         }
 
+        if (pt.hasOwnProperty("customdata")) {
+          obj.customdata = pt.customdata;
+        }
+        
         /* 
           TL;DR: (I think) we have to select the graph div (again) to attach keys...