Merge pull request #1343 from ropensci/style-partial

add support for partial updates in style(), fixes #1342

Author: cpsievert

NEWS.md

@@ -9,6 +9,7 @@
 
 * Upgraded to plotly.js v1.41.3.
 * The `orca()` function now supports conversion of much larger figures (#1322) and works without a mapbox api token (#1314).
+* 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).
 
 ## BUG FIXES
 

R/style.R

@@ -13,22 +13,64 @@
 #' @export
 #' @examples 
 #' 
-#' p <- qplot(data = mtcars, wt, mpg, geom = c("point", "smooth"))
-#' # keep the hover info for points, but remove it for the line/ribbon
+#' # style() is especially useful in conjunction with ggplotly()
+#' # It allows you to leverage the underlying plotly.js library to change 
+#' # the return result of ggplotly()
+#' (p <- ggplotly(qplot(data = mtcars, wt, mpg, geom = c("point", "smooth"))))
+#' 
+#' # removes hoverinfo for the line/ribbon traces (use `plotly_json()` to verify!)
 #' style(p, hoverinfo = "none", traces = c(2, 3))
 #' 
+#' # another example with plot_ly() instead of ggplotly()
+#' marker <- list(
+#'   color = "red",
+#'   line = list(
+#'     width = 20, 
+#'     color = "black"
+#'  )
+#' )
+#' (p <- plot_ly(x = 1:10, y = 1:10, marker = marker))
+#' 
+#' # note how the entire (marker) object is replaced if a list is provided
+#' style(p, marker = list(line = list(color = "blue")))
+#' 
+#' # similar to plotly.js, you can update a particular attribute like so 
+#' # https://github.com/plotly/plotly.js/issues/1866#issuecomment-314115744
+#' style(p, marker.line.color = "blue") 
+#' # this clobbers the previously supplied marker.line.color
+#' style(p, marker.line = list(width = 2.5), marker.size = 10)
+#' 
 style <- function(p, ..., traces = NULL) {
   p <- plotly_build(p)
-  nTraces <- length(p$x$data)
-  traces <- traces %||% seq_len(nTraces)
-  idx <- traces > nTraces
-  traces <- traces[!idx]
-  if (any(idx)) warning("You've referenced non-existent traces", call. = FALSE)
-  argz <- list(...)
-  for (i in traces) {
-    for (j in names(argz)) {
-      p$x$data[[i]][[j]] <- argz[[j]]
-    }
+  n_traces <- length(p$x$data)
+  trace_idx <- traces %||% seq_len(n_traces)
+  if (any(trace_idx > n_traces)) {
+    warning("You've referenced non-existent traces", call. = FALSE)
   }
+  
+  values <- list(...)
+  paths <- strsplit(names(values), "\\.")
+  
+  p$x$data[trace_idx] <- lapply(p$x$data[trace_idx], function(trace) {
+    for (i in seq_along(paths)) {
+      trace <- trace_replace(trace, paths[[i]], values[[i]])
+    }
+    trace
+  })
+  
   p
 }
+
+#' @param trace a single plotly trace
+#' @param path character vector of path elements pointing to a trace property: c("marker", "line", "size")
+#' @param value a value to assign to that trace property
+trace_replace <- function(trace, path, value) {
+  if (length(path) == 0) return(trace)
+  if (length(path) == 1) {
+    trace[[path]] <- value
+    return(trace)
+  }
+  trace[[path[1]]] <- trace[[path[1]]] %||% setNames(list(NULL), path[2])
+  trace[[path[1]]] <- trace_replace(trace[[path[1]]], path[-1], value)
+  trace
+}

man/style.Rd

@@ -0,0 +1,65 @@
+context("style/restyle functionality")
+
+p1 <- plot_ly(x = 1:10, y = 1:10, symbol = I(15))
+marker1 <- plotly_build(p1)$x$data[[1]]$marker
+
+test_that("Whole update works as expected", {
+  p2 <- style(p1, marker = list(color = "red"))
+  marker2 <- plotly_build(p2)$x$data[[1]]$marker
+  expect_equal(marker2, list(color = "red"))
+  
+  p3 <- style(p1, marker = list(line = list(color = "red", width = 10)))
+  marker3 <- plotly_build(p3)$x$data[[1]]$marker
+  expect_equal(marker3, list(line = list(color = "red", width = 10)))
+})
+
+
+test_that("Partial update works as expected", {
+  p4 <- style(p1, marker.color = "red")
+  marker4 <- plotly_build(p4)$x$data[[1]]$marker
+  expect_equal(marker4, modifyList(marker4, list(color = "red")))
+  
+  p5 <- style(p1, marker.line.color = "red")
+  marker5 <- plotly_build(p5)$x$data[[1]]$marker
+  expect_equal(marker5, modifyList(marker5, list(line = list(color = "red"))))
+})
+
+test_that("Partial update works as expected", {
+  p4 <- style(p1, marker.color = "red")
+  marker4 <- plotly_build(p4)$x$data[[1]]$marker
+  expect_equal(marker4, modifyList(marker4, list(color = "red")))
+  
+  p5 <- style(p1, marker.line.color = "red")
+  marker5 <- plotly_build(p5)$x$data[[1]]$marker
+  expect_equal(marker5, modifyList(marker5, list(line = list(color = "red"))))
+})
+
+
+test_that("Partial update works as expected", {
+  trace <- list(
+    x = 1:5,
+    y = 6:10,
+    marker = list(line = list(color = "red", width = 20))
+  )
+  
+  trace_new <- trace_replace(trace, c("marker", "line"), list(width = 10))
+  trace$marker$line <- list(width = 10)
+  expect_equal(trace_new, trace)
+  
+  trace <- list(
+    x = 1:5,
+    y = 6:10,
+    marker = list(line = list(color = "red", width = 20))
+  )
+  trace_new <- trace_replace(trace, c("marker", "line", "width"), 10)
+  trace$marker$line$width <- 10
+  expect_equal(trace_new, trace)
+  
+  trace <- list(
+    x = 1:5,
+    y = 6:10
+  )
+  trace_new <- trace_replace(trace, c("marker", "line", "width"), 10)
+  trace$marker$line$width <- 10
+  expect_equal(trace_new, trace)
+})