diff --git a/DESCRIPTION b/DESCRIPTION index 0d6e4ef39d..edb788bd1e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: plotly Title: Create Interactive Web Graphics via Plotly's JavaScript Graphing Library -Version: 2.0.19 +Version: 2.1.0 Authors@R: c(person("Carson", "Sievert", role = c("aut", "cre"), email = "cpsievert1@gmail.com"), person("Chris", "Parmer", role = c("aut", "cph"), diff --git a/NEWS b/NEWS index 8dcace9960..409db3514f 100644 --- a/NEWS +++ b/NEWS @@ -1,3 +1,7 @@ +2.1.0 -- 29 Dec 2015 + +plot_ly() now defaults to inherit=FALSE and plotly_build() is now idempotent. Fixes #280 and #277. See #368 for details. + 2.0.19 -- 23 Dec 2015 Added as.widget() function for conveniency in converting plotly object to htmlwidget objects. See #294. diff --git a/R/plotly.R b/R/plotly.R index 8b6c988db4..4171812684 100644 --- a/R/plotly.R +++ b/R/plotly.R @@ -65,7 +65,7 @@ #' plot_ly <- function(data = data.frame(), ..., type = "scatter", group, color, colors, symbol, symbols, size, - width = NULL, height = NULL, inherit = TRUE, + width = NULL, height = NULL, inherit = FALSE, evaluate = FALSE) { # "native" plotly arguments argz <- substitute(list(...)) @@ -170,7 +170,7 @@ layout <- function(p = last_plot(), ..., enclos = parent.frame() ) p <- last_plot(p) - p$layout <- c(p$layout, list(layout)) + p$layout <- c(p$layout, list(layout = layout)) if (evaluate) p <- plotly_build(p) hash_plot(data, p) } @@ -265,9 +265,6 @@ plotly_build <- function(l = last_plot()) { # ggplot objects don't need any special type of handling if (is.ggplot(l)) return(gg2list(l)) l <- get_plot(l) - # plots without NSE don't need it either - nmz <- c(lapply(l$data, names), lapply(l$layout, names), lapply(l$style, names)) - if (!all(c("args", "env") %in% unlist(nmz))) return(structure(l, class = unique("plotly", class(l)))) # assume unnamed list elements are data/traces nms <- names(l) idx <- nms %in% "" @@ -276,14 +273,22 @@ plotly_build <- function(l = last_plot()) { } else if (any(idx)) { c(data = c(l$data, l[idx]), l[!idx]) } else l - dats <- list() + # carry over properties, if necessary (but don't carry over evaluation envir) + if (length(l$data) > 1 && isTRUE(l$data[[1]]$inherit)) { + d <- l$data[[1]] + d <- d[!names(d) %in% c("env", "enclos")] + for (i in seq.int(2, length(l$data))) { + l$data[[i]] <- modifyList(l$data[[i]], d) + } + } + # 'x' is the same as 'l', but with arguments evaluated + # this is ugly, but I think it is necessary, since we don't know how many + # traces we have until we evaluate args and call traceify() (or similar) + x <- list() for (i in seq_along(l$data)) { d <- l$data[[i]] - # if appropriate, evaluate trace arguments in a suitable environment - idx <- names(d) %in% c("args", "env", "enclos") - if (sum(idx) == 3) { - dat <- c(d[!idx], eval(d$args, as.list(d$env, all.names = TRUE), d$enclos)) - dat[c("args", "env", "enclos")] <- NULL + if (should_eval(d)) { + dat <- do_eval(d) # start processing specially named arguments s <- dat[["size"]] if (!is.null(s)) { @@ -309,49 +314,30 @@ plotly_build <- function(l = last_plot()) { has_group <- !is.null(dat[["group"]]) if (has_color) { title <- as.list(d$args)[["color"]] %||% as.list(d$args)[["z"]] %||% "" - dats <- c(dats, colorize(dat, title)) + x$data <- c(x$data, colorize(dat, title)) } # TODO: add a legend title (is this only possible via annotations?!?) - if (has_symbol) dats <- c(dats, symbolize(dat)) - if (has_group) dats <- c(dats, traceify(dat, "group")) - if (!has_color && !has_symbol && !has_group) dats <- c(dats, list(dat)) + if (has_symbol) x$data <- c(x$data, symbolize(dat)) + if (has_group) x$data <- c(x$data, traceify(dat, "group")) + if (!has_color && !has_symbol && !has_group) x$data <- c(x$data, list(dat)) } else { - dats <- c(dats, list(d)) - } - } - x <- list(data = dats) - # carry over properties/data from first trace (if appropriate) - if (length(x$data) > 1 && isTRUE(l$data[[1]]$inherit)) { - for (i in seq.int(2, length(x$data))) { - x$data[[i]] <- modifyList(x$data[[1]], x$data[[i]]) + x$data <- c(x$data, list(d)) } } - # layout() tacks on an unnamed list element to potentially pre-existing - # layout(s). Note that ggplotly() will return a named list - # of length n >= 1 (so we need to carefully merge them ). + # it's possible have nested layouts (e.g., plot_ly() %>% layout() %>% layout()) nms <- names(l$layout) - if (!is.null(nms) && any(idx <- nms %in% "")) { - # TODO: does this always preserve the correct order to layouts? - # (important since we use modifyList at a later point) - l$layout <- c(list(l$layout[!idx]), l$layout[idx]) - } + idx <- nms %in% "layout" + l$layout <- c(list(l$layout[!idx]), setNames(l$layout[idx], NULL)) for (i in seq_along(l$layout)) { - layout <- l$layout[[i]] - idx <- names(layout) %in% c("args", "env", "enclos") - x$layout[[i]] <- if (sum(idx) == 3) { - c(layout[!idx], eval(layout$args, as.list(layout$env, all.names = TRUE), layout$enclos)) - } else { - layout - } + x$layout[[i]] <- perform_eval(l$layout[[i]]) } x$layout <- Reduce(modifyList, x$layout) # if style is not null, use it to modify existing traces if (!is.null(l$style)) { for (i in seq_along(l$style)) { - sty <- l$style[[i]] - idx <- names(sty) %in% c("args", "env", "enclos") - new_sty <- if (sum(idx) == 3) c(sty[!idx], eval(sty$args, as.list(sty$env, all.names = TRUE), sty$enclos)) else sty - for (k in sty$traces) x$data[[k]] <- modifyList(x$data[[k]], new_sty) + sty <- perform_eval(l$style[[i]]) + for (k in l$style[[i]]$traces) + x$data[[k]] <- modifyList(x$data[[k]], sty) } } # add appropriate axis title (if they don't already exist) @@ -365,26 +351,6 @@ plotly_build <- function(l = last_plot()) { if (!is.null(a) && !is.null(names(a))) { x$layout$annotations <- list(x$layout$annotations) } - # search for keyword args in traces and place them at the top level - kwargs <- lapply(x$data, function(z) z[get_kwargs()]) - # 'top-level' keywords args take precedence - kwargs <- Reduce(modifyList, c(kwargs, list(x[get_kwargs()]))) - # empty keyword arguments can cause problems - kwargs <- kwargs[sapply(kwargs, length) > 0] - # try our damndest to assign a sensible filename - if (is.null(kwargs$filename)) { - kwargs$filename <- - as.character(kwargs$layout$title) %||% - paste( - c(kwargs$layout$xaxis$title, - kwargs$layout$yaxis$title, - kwargs$layout$zaxis$title), - collapse = " vs. " - ) %||% - "plot from api" - } - # tack on keyword arguments - x <- c(x, kwargs) # traces shouldn't have any names x$data <- setNames(x$data, NULL) # add plotly class mainly for printing method diff --git a/R/plotly_POST.R b/R/plotly_POST.R index 51b562f44c..c3b92cb303 100644 --- a/R/plotly_POST.R +++ b/R/plotly_POST.R @@ -26,7 +26,14 @@ plotly_POST <- function(x, filename, fileopt = "new", world_readable = TRUE) { x <- plotly_build(x) - if (!missing(filename)) x$filename <- filename + x$filename <- if (!missing(filename)) { + filename + } else { + # try our damndest to assign a sensible filename + x$filename %||% as.character(x$layout$title) %||% + paste(c(x$layout$xaxis$title, x$layout$yaxis$title, x$layout$zaxis$title), + collapse = " vs. ") %||% "plot from api" + } if (!is.null(x$fileopt)) warning("fileopt was specified in the wrong place. Please specify in plotly_POST()") x$fileopt <- fileopt diff --git a/R/process.R b/R/process.R index 13902faaf3..412f0a863e 100644 --- a/R/process.R +++ b/R/process.R @@ -28,6 +28,7 @@ process.figure <- function(resp) { fig <- con$payload$figure fig$url <- sub("apigetfile/", "~", resp$url) fig <- add_boxed(fig) + fig$data[[1]]$inherit <- FALSE # any reasonable way to return a data frame? hash_plot(data.frame(), fig) } diff --git a/R/utils.R b/R/utils.R index db38a59ee7..7b33882c71 100644 --- a/R/utils.R +++ b/R/utils.R @@ -190,6 +190,25 @@ plotly_headers <- function(type = "main") { httr::add_headers(.headers = h) } + +perform_eval <- function(x) { + if (should_eval(x)) do_eval(x) else x +} + +# env/enclos are special properties specific to the R API +# if they appear _and_ are environments, then evaluate arguments +# (sometimes figures return these properties but evaluation doesn't make sense) +should_eval <- function(x) { + any(vapply(x[c("env", "enclos")], is.environment, logical(1))) +} + +# perform evaluation of arguments, keeping other list elements +do_eval <- function(x) { + y <- c(x, eval(x$args, as.list(x$env, all.names = TRUE), x$enclos)) + y[c("args", "env", "enclos")] <- NULL + y +} + # try to write environment variables to an .Rprofile cat_profile <- function(key, value, path = "~") { r_profile <- file.path(normalizePath(path, mustWork = TRUE), diff --git a/tests/testthat/test-plotly-getfigure.R b/tests/testthat/test-plotly-getfigure.R index c614afff82..3bcbfb4450 100644 --- a/tests/testthat/test-plotly-getfigure.R +++ b/tests/testthat/test-plotly-getfigure.R @@ -28,3 +28,12 @@ test_that("retrieving a public figure ... works.", { p <- plotly_build(fig) expect_equivalent(p$data[[1]]$x, c("1", "2", "3")) }) + +test_that("can add traces to a subplot figure", { + skip_on_cran() + fig <- get_figure('chelsea_lyn', 6366) + p <- add_trace(fig, x=c(1, 2, 3), y=c(4, 2, 4)) + l <- plotly_build(p) + expect_equivalent(length(fig$data) + 1, length(l$data)) +}) + diff --git a/tests/testthat/test-plotly.R b/tests/testthat/test-plotly.R index fb425ef1ca..00bc271528 100644 --- a/tests/testthat/test-plotly.R +++ b/tests/testthat/test-plotly.R @@ -98,3 +98,16 @@ test_that("axis titles get attached to scene object for 3D plots", { expect_identical(scene$yaxis$title, "Petal.Width") expect_identical(scene$zaxis$title, "Sepal.Width") }) + +test_that("inheriting properties works as expected", { + library(dplyr) + p <- iris %>% + count(Species) %>% + plot_ly(x = Species, y = n, opacity = 0.5, type = "bar", inherit = TRUE) %>% + layout(barmode = "overlay", showlegend = FALSE) + s <- count(iris[sample(nrow(iris), 10), ], Species) + p2 <- add_trace(p, data = s) + l <- plotly_build(p2) + expect_equal(l$data[[2]]$opacity, 0.5) + expect_true(all(l$data[[1]]$y > l$data[[2]]$y)) +})