Reduce single-valued vectors to a constant when appropriate. Fixes #675 #817 #826

Author: cpsievert

NEWS.md

@@ -1,6 +1,6 @@
 # 4.5.6.9000
 
-## NEW FEATURES
+## NEW FEATURES & IMPROVEMENTS
 
 * Added a significant amount of support for "multiple linked views". For some relatively basic examples, see the demos (the ones prefixed with "highlight" are most relevant) -- `demo(package = "plotly")`. For a more comprehensive overview, see <https://cpsievert.github.io/plotly_book/linking-views-without-shiny.html>. For some more complex examples, see <https://cpsievert.github.io/pedestrians/>
 * Added the `highlight()` function for configuring selection modes/sequences.
@@ -13,6 +13,7 @@
 * Added a `plot_dendro()` function for a quick and dirty interactive dendrogram with support for hierarchial selection. For more, see -- <https://cpsievert.github.io/plotly_book/linking-views-without-shiny.html#nested-selections>
 * The `export()` function now tries it's best to export WebGL plots (via **RSelenium**). It also gains a `delay` argument.
 * The `plotlyOutput()` function gains a `inline` argument which makes it easier to place multiple plots in the same row (in a shiny application).
+* Better type checking of trace attributes will now automatically reduce a single-valued vector to a constant (when appropriate). This is particularly useful for anchoring multiple traces to a single legend entry via `legendgroup` (see #675, #817, #826).
 
 ## CHANGES
 

R/utils.R

@@ -255,24 +255,27 @@ supply_highlight_attrs <- function(p) {
 # make sure plot attributes adhere to the plotly.js schema
 verify_attr_names <- function(p) {
   # some layout attributes (e.g., [x-y]axis can have trailing numbers)
-  check_attrs(
+  attrs_name_check(
     sub("[0-9]+$", "", names(p$x$layout)),
     c(names(Schema$layout$layoutAttributes), c("barmode", "bargap", "mapType")),
     "layout"
   )
   for (tr in seq_along(p$x$data)) {
     thisTrace <- p$x$data[[tr]]
-    validAttrs <- Schema$traces[[thisTrace$type %||% "scatter"]]$attributes
-    check_attrs(
+    attrSpec <- Schema$traces[[thisTrace$type %||% "scatter"]]$attributes
+    # make sure attribute names are valid
+    attrs_name_check(
       names(thisTrace), 
-      c(names(validAttrs), "key", "set", "frame", "_isNestedKey", "_isSimpleKey"), 
+      c(names(attrSpec), "key", "set", "frame", "_isNestedKey", "_isSimpleKey"), 
       thisTrace$type
     )
+    # if it makes sense, reduce a single-valued vector to a constant 
+    p$x$data[[tr]] <- attrs_simplify(thisTrace, attrSpec)
   }
   invisible(p)
 }
 
-check_attrs <- function(proposedAttrs, validAttrs, type = "scatter") {
+attrs_name_check <- function(proposedAttrs, validAttrs, type = "scatter") {
   illegalAttrs <- setdiff(proposedAttrs, validAttrs)
   if (length(illegalAttrs)) {
     warning("'", type, "' objects don't have these attributes: '",
@@ -284,6 +287,15 @@ check_attrs <- function(proposedAttrs, validAttrs, type = "scatter") {
   invisible(proposedAttrs)
 }
 
+attrs_simplify <- function(trace, spec) {
+  for (attr in names(trace)) {
+    type <- tryCatch(spec[[attr]]$valType, error = function(e) NULL)
+    if (isTRUE(type %in% c("any", "data_array"))) next
+    trace[[attr]] <- uniq(trace[[attr]])
+  }
+  trace
+}
+
 # ensure both the layout and trace attributes are sent to plotly.js
 # as data_arrays
 verify_boxed <- function(p) {

inst/stars.R

@@ -0,0 +1,22 @@
+library(jsonlite)
+library(ggplot2)
+
+stars <- fromJSON(
+  "https://raw.githubusercontent.com/cpsievert/starline/master/data/stars.json", 
+  simplifyDataFrame = FALSE
+)
+
+dats <- lapply(stars$repos, function(r) {
+  starz <- unlist(r$stars$dates)
+  starz <- starz[sort(names(starz))]
+  data.frame(
+    date = as.Date(names(starz)),
+    value = cumsum(starz),
+    repo = r$uri, 
+    stringsAsFactors = FALSE
+  )
+})
+
+d <- dplyr::bind_rows(dats)
+ggplot(d, aes(date, value, color = repo)) + 
+  geom_line() + ylab("Number of stars")