diff --git a/NEWS.md b/NEWS.md index 025922342b..818deae32a 100644 --- a/NEWS.md +++ b/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 diff --git a/R/style.R b/R/style.R index 427017bb04..3029017658 100644 --- a/R/style.R +++ b/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 +} diff --git a/man/style.Rd b/man/style.Rd index b418df38cd..58beec5a6f 100644 --- a/man/style.Rd +++ b/man/style.Rd @@ -20,10 +20,33 @@ conjunction with \code{\link[=get_figure]{get_figure()}}. } \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) + } \seealso{ \code{\link[=api_download_plot]{api_download_plot()}} diff --git a/tests/testthat/test-style.R b/tests/testthat/test-style.R new file mode 100644 index 0000000000..277552254a --- /dev/null +++ b/tests/testthat/test-style.R @@ -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) +})