don't inherit props by default; modularize evaluation; fix #280; fix #277

Author: cpsievert

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(...))
@@ -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,20 @@ 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 unevaluated arguments, if necessary
+  if (length(l$data) > 1 && isTRUE(l$data[[1]]$inherit) && should_eval(l$data[[1]])) {
+    for (i in seq.int(2, length(l$data))) {
+      l$data[[i]] <- modifyList(l$data[[i]], l$data[[1]])
+    }
+  }
+  # 'x' is the same as 'l', but with arguments evaluated
+  # this is ugly, but we don't know how many traces we'll have until
+  # we evaluate arguments 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,21 +312,14 @@ 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
@@ -334,24 +330,19 @@ plotly_build <- function(l = last_plot()) {
     # 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])
+  } else {
+    l$layout <- list(l$layout)
   }
   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)

R/utils.R

@@ -3,7 +3,7 @@
 #' @importFrom stats setNames
 
 is.plotly <- function(x) inherits(x, "plotly")
-
+  
 "%||%" <- function(x, y) {
   if (length(x) > 0) x else y
 }
@@ -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),