Skip to content

Commit 89f98be

Browse files
cpsievertcpsievert
committed
Document special arguments; change location of a few functions
1 parent f37d6d0 commit 89f98be

13 files changed

Lines changed: 343 additions & 255 deletions

‎NAMESPACE‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,6 @@ export("%>%")
66
export(add_trace)
77
export(embed_notebook)
88
export(get_figure)
9-
export(get_plot)
109
export(gg2list)
1110
export(ggplot_build2)
1211
export(ggplotly)
@@ -24,6 +23,7 @@ export(plotly_POST)
2423
export(plotly_build)
2524
export(renderPlotly)
2625
export(signup)
26+
export(stream)
2727
export(style)
2828
export(subplot)
2929
export(toRGB)

‎R/plotly.R‎

Lines changed: 233 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -6,21 +6,18 @@
66
#' Reference section (see below).
77
#'
88
#' @param data A data frame (optional).
9-
#' @param ... Visual properties.
10-
#' All arguments documented in the references section below are supported.
11-
#' In addition, there are special arguments which map variables to visual
12-
#' aethestics in a similar style to ggplot2 (such as \code{color}).
9+
#' @param ... These arguments are documented in the references section below.
10+
#' Note that acceptable arguments depend on the trace type.
1311
#' @param type A charater string describing the type of trace.
14-
#' @param group A variable name for mapping to group.
15-
#' If used, a different trace will be created for each unique value.
16-
#' @param color A variable name for mapping to color.
12+
#' @param group Map a variable to group. If used,
13+
#' a different trace will be created for each unique value of this variable.
14+
#' @param color Map a variable to color.
1715
#' @param colors Either a colorbrewer2.org palette name (e.g. "YlOrRd" or "Blues"),
1816
#' or a vector of colors to interpolate in hexadecimal "#RRGGBB" format,
1917
#' or a color interpolation function like \link{grDevices::colorRamp}.
2018
#' @param symbol A variable name for mapping to symbols.
2119
#' @param symbols A character vector of symbol types. Possible values:
2220
#' 'dot', 'cross', 'diamond', 'square', 'triangle-down', 'triangle-left', 'triangle-right', 'triangle-up'
23-
#'
2421
#' @param inherit should future traces inherit properties from this initial trace?
2522
#' @param evaluate logical. Evaluate arguments when this function is called?
2623
#' @seealso \code{\link{layout}()}, \code{\link{add_trace}()}, \code{\link{style}()}
@@ -46,20 +43,27 @@
4643
#' }
4744
#'
4845
plot_ly <- function(data = data.frame(), ..., type = "scatter",
46+
group, color, colors, symbol, symbols,
4947
inherit = TRUE, evaluate = FALSE) {
50-
# record trace information
48+
# "native" plotly arguments
49+
argz <- substitute(list(...))
50+
# tack on "special" arguments
51+
if (!missing(group)) argz$group <- substitute(group)
52+
if (!missing(color)) argz$color <- substitute(color)
53+
if (!missing(colors)) argz$colors <- substitute(colors)
54+
if (!missing(symbol)) argz$symbol <- substitute(symbol)
55+
if (!missing(symbols)) argz$symbols <- substitute(symbols)
56+
# trace information
5157
tr <- list(
5258
type = type,
53-
# TODO: verify/filter arguments based on trace type.
54-
args = substitute(list(...)),
55-
env = list2env(data),
56-
enclos = parent.frame(),
59+
args = argz,
60+
env = list2env(data), # environment in which to evaluate arguments
61+
enclos = parent.frame(), # if objects aren't found in env, look here
5762
inherit = inherit
5863
)
59-
# this info is sufficient for recreating the plot
64+
# plotly objects should always have a _list_ of trace(s)
6065
p <- list(
6166
data = list(tr),
62-
# Maybe provide an argument to keep layout?
6367
layout = NULL,
6468
url = NULL
6569
)
@@ -69,36 +73,59 @@ plot_ly <- function(data = data.frame(), ..., type = "scatter",
6973

7074
#' Add a trace to a plotly visualization
7175
#'
72-
#' @param p A plotly visualization.
73-
#' @param ... Visual properties.
74-
#' All arguments documented in the references section below are supported.
75-
#' In addition, there are special arguments which map variables to visual
76-
#' aethestics in a similar style to ggplot2 (such as \code{color}).
77-
#' @param data A data frame (optional).
76+
#' @param p A plotly object.
77+
#' @param ... These arguments are documented in the references section below.
78+
#' Note that acceptable arguments depend on the trace type.
79+
#' @param type A charater string describing the type of trace.
80+
#' @param group Map a variable to group. If used,
81+
#' a different trace will be created for each unique value of this variable.
82+
#' @param color Map a variable to color.
83+
#' @param colors Either a colorbrewer2.org palette name (e.g. "YlOrRd" or "Blues"),
84+
#' or a vector of colors to interpolate in hexadecimal "#RRGGBB" format,
85+
#' or a color interpolation function like \link{grDevices::colorRamp}.
86+
#' @param symbol A variable name for mapping to symbols.
87+
#' @param symbols A character vector of symbol types. Possible values:
88+
#' 'dot', 'cross', 'diamond', 'square', 'triangle-down', 'triangle-left', 'triangle-right', 'triangle-up'
89+
#' @param data A data frame to associate with this trace (optional). If not
90+
#' provided, arguments are evaluated using the data frame in \code{\link{plot_ly}()}.
7891
#' @param evaluate logical. Evaluate arguments when this function is called?
92+
#' @seealso \code{\link{plot_ly}()}
7993
#' @references \url{https://plot.ly/r/reference/}
8094
#' @author Carson Sievert
8195
#' @export
8296
#'
83-
add_trace <- function(p = get_plot(), ...,
97+
add_trace <- function(p = get_plot(), ..., type = "scatter",
98+
group, color, colors, symbol, symbols,
8499
data = NULL, evaluate = FALSE) {
85-
p <- get_plot(p)
100+
# "native" plotly arguments
101+
argz <- substitute(list(...))
102+
# tack on "special" arguments
103+
if (!missing(group)) argz$group <- substitute(group)
104+
if (!missing(color)) argz$color <- substitute(color)
105+
if (!missing(colors)) argz$colors <- substitute(colors)
106+
if (!missing(symbol)) argz$symbol <- substitute(symbol)
107+
if (!missing(symbols)) argz$symbols <- substitute(symbols)
86108
tr <- list(
87-
args = substitute(list(...)),
109+
args = argz,
88110
# if data is missing, adopt the most recent data environment
89111
env = if (is.null(data)) p$data[[length(p$data)]]$env else list2env(data),
90112
enclos = parent.frame()
91113
)
114+
p <- get_plot(p)
92115
p$data <- c(p$data, list(tr))
93116
if (evaluate) p <- plotly_build(p)
94117
hash_plot(data, p)
95118
}
96119

97120
#' Add and/or modify layout of a plotly
98121
#'
99-
#' @inheritParams add_trace
122+
#' @param p A plotly object.
123+
#' @param ... Arguments to the layout object. For documentation,
124+
#' see \url{https://plot.ly/r/reference/#Layout_and_layout_style_objects}
125+
#' @param data A data frame to associate with this layout (optional). If not
126+
#' provided, arguments are evaluated using the data frame in \code{\link{plot_ly}()}.
127+
#' @param evaluate logical. Evaluate arguments when this function is called?
100128
#' @author Carson Sievert
101-
#' @references \url{https://plot.ly/r/reference/#Layout_and_layout_style_objects}
102129
#' @export
103130
#'
104131
layout <- function(p = get_plot(), ...,
@@ -144,25 +171,191 @@ style <- function(p = get_plot(strict = FALSE), ..., traces = 1, evaluate = FALS
144171
hash_plot(data, p)
145172
}
146173

147-
#' Obtain underlying data of plotly object
174+
175+
#' Build a plotly object before viewing it
148176
#'
149-
#' Given a data frame with a class of plotly, this function returns the arguments
150-
#' and/or data used to create the plotly. If no data frame is provided,
151-
#' the last plotly object created in this R session is returned (if it exists).
177+
#' For convenience and efficiency purposes, plotly objects are subject to lazy
178+
#' evaluation. That is, the actual content behind a plotly object is not
179+
#' created until it is absolutely necessary. In some instances, you may want
180+
#' to perform this evaluation yourself, and work directly with the resulting
181+
#' list.
152182
#'
153-
#' @param data a data frame with a class of plotly (and a plotly_hash attribute).
183+
#' @param l a ggplot object, or a plotly object, or a list.
154184
#' @export
155-
get_plot <- function(data = NULL, strict = TRUE) {
156-
hash <- attr(data, "plotly_hash")
157-
if (!is.null(hash)) {
158-
get(hash, envir = plotlyEnv)
159-
} else if (is.data.frame(data)) {
160-
# safe to just grab the most recent environment?
161-
hash <- rev(ls(plotlyEnv))[1]
162-
plotlyEnv[[hash]]
185+
plotly_build <- function(l) {
186+
# ggplot objects don't need any special type of handling
187+
if (is.ggplot(l)) return(gg2list(l))
188+
l <- get_plot(l)
189+
nms <- names(l)
190+
# assume unnamed list elements are data/traces
191+
idx <- nms %in% ""
192+
l <- if (is.null(nms)) {
193+
list(data = l)
194+
} else if (any(idx)) {
195+
c(data = c(l$data, l[idx]), l[!idx])
196+
} else l
197+
dats <- list()
198+
for (i in seq_along(l$data)) {
199+
d <- l$data[[i]]
200+
# if appropriate, evaluate trace arguments in a suitable environment
201+
idx <- names(d) %in% c("args", "env")
202+
if (sum(idx) == 2) {
203+
dat <- c(d[!idx], eval(d$args, as.list(d$env), d$enclos))
204+
dat[c("args", "env", "enclos")] <- NULL
205+
} else {
206+
dat <- d
207+
}
208+
# process specially named arguments
209+
has_color <- !is.null(dat[["color"]]) || !is.null(dat[["z"]])
210+
has_symbol <- !is.null(dat[["symbol"]])
211+
has_group <- !is.null(dat[["group"]])
212+
if (has_color) dats <- c(dats, colorize(dat, as.list(d$args)[["color"]]))
213+
# TODO: add a legend title (is this only possible via annotations?!?)
214+
if (has_symbol) dats <- c(dats, symbolize(dat))
215+
if (has_group) dats <- c(dats, traceify(dat, "group"))
216+
if (!has_color && !has_symbol && !has_group) dats <- c(dats, list(dat))
217+
}
218+
x <- list(data = dats)
219+
# carry over properties/data from first trace (if appropriate)
220+
if (length(x$data) > 1 && isTRUE(l$data[[1]]$inherit)) {
221+
for (i in seq.int(2, length(x$data))) {
222+
x$data[[i]] <- modifyList(x$data[[1]], x$data[[i]])
223+
}
224+
}
225+
# plot_ly()/layout() may produce a unnamed list of layouts
226+
# in that case, we may want to evaluate layout arguments
227+
idx <- names(l$layout) == ""
228+
if (all(idx)) {
229+
nlayouts <- length(l$layout)
230+
layouts <- setNames(vector("list", nlayouts), names(l$layout))
231+
for (i in seq_len(nlayouts)) {
232+
layout <- l$layout[[i]]
233+
idx <- names(layout) %in% c("args", "env")
234+
layouts[[i]] <- if (sum(idx) == 2) {
235+
c(layout[!idx], eval(layout$args, as.list(layout$env), layout$enclos))
236+
} else {
237+
layout
238+
}
239+
}
240+
idx <- names(layouts) == ""
241+
x$layout <- if (any(idx)) {
242+
c(Reduce(c, layouts[idx]), layouts[!idx])
243+
} else {
244+
Reduce(c, layouts)
245+
}
246+
} else {
247+
x$layout <- l$layout
248+
}
249+
# if style is not null, use it to modify existing traces
250+
if (!is.null(l$style)) {
251+
for (i in seq_along(l$style)) {
252+
sty <- l$style[[i]]
253+
idx <- names(sty) %in% c("args", "env")
254+
new_sty <- if (sum(idx) == 2) c(sty[!idx], eval(sty$args, as.list(sty$env), sty$enclos)) else sty
255+
for (k in sty$traces) x$data[[k]] <- modifyList(x$data[[k]], new_sty)
256+
}
257+
}
258+
# add appropriate axis title (if they don't already exist)
259+
x <- axis_titles(x, l)
260+
# create a new plotly if no url is attached to this environment
261+
x$fileopt <- if (is.null(l$url)) "new" else "overwrite"
262+
# add plotly class mainly for printing method
263+
class(x) <- unique(c("plotly", class(x)))
264+
x
265+
}
266+
267+
# returns a _list of traces_.
268+
colorize <- function(dat, title = "") {
269+
cols <- dat[["color"]] %||% dat[["z"]]
270+
if (is.numeric(cols)) {
271+
# by default, use viridis::viridis(10) -> http://rud.is/b/2015/07/20/using-the-new-viridis-colormap-in-r-thanks-to-simon-garnier/
272+
colors <- dat[["colors"]] %||% viridis::viridis(10)
273+
cols <- as.vector(cols)
274+
rng <- range(cols, na.rm = TRUE)
275+
x <- seq(min(rng), max(rng), length.out = 10)
276+
colz <- scales::col_numeric(colors, rng, na.color = "transparent")(x)
277+
df <- if (length(cols) > 1) data.frame(scales::rescale(x), colz)
278+
else data.frame(c(0, 1), rep(colz, 2))
279+
col_list <- list(
280+
colorbar = list(title = as.character(title)),
281+
colorscale = setNames(df, NULL)
282+
)
283+
# scatter-like traces can have both line and marker objects
284+
if (grepl("scatter", dat[["type"]] %||% "scatter")) {
285+
col_list$color <- cols
286+
#mode <- dat[["mode"]] %||% "markers+lines"
287+
dat[["marker"]] <- modifyList(col_list, dat[["marker"]] %||% list())
288+
# doing this breaks
289+
#dat[["line"]] <- modifyList(col_list, dat[["line"]] %||% list())
290+
} else {
291+
dat <- c(dat, col_list)
292+
}
293+
dat <- list(dat)
294+
} else { # discrete color scale
295+
dat <- traceify(dat, "color")
296+
lvls <- unlist(lapply(dat, function(x) unique(x[["color"]])))
297+
N <- length(lvls)
298+
default <- if (is.ordered(cols)) viridis::viridis(N)
299+
else RColorBrewer::brewer.pal(N, "Set2")
300+
colors <- dat[[1]][["colors"]] %||% default
301+
colz <- scales::col_factor(colors, levels = lvls, na.color = "transparent")(lvls)
302+
dat <- Map(function(x, y) { x[["marker"]] <- c(x[["marker"]], list(color = y)); x },
303+
dat, colz)
304+
}
305+
dat <- lapply(dat, function(x) { x$color <- NULL; x$colors <- NULL; x })
306+
dat
307+
}
308+
309+
symbolize <- function(dat) {
310+
# symbols really only make sense when markers are in the mode, right?
311+
dat$mode <- dat$mode %||% "markers"
312+
dat <- traceify(dat, "symbol")
313+
dat <- lapply(dat, function(x) { x$symbol <- NULL; x })
314+
N <- length(dat)
315+
if (N > 8) warning("Plotly supports 8 different symbols, but you have ", N, " levels!")
316+
symbols <- c('dot', 'cross', 'diamond', 'square', 'triangle-down', 'triangle-left', 'triangle-right', 'triangle-up')
317+
sym <- symbols[seq_len(N)]
318+
dat <- Map(function(x, y) { x$marker$symbol <- y; x }, dat, sym)
319+
dat
320+
}
321+
322+
# break up a single trace into multiple traces according to values stored
323+
# a particular key name
324+
traceify <- function(dat, nm = "group") {
325+
x <- dat[[nm]]
326+
if (is.null(x)) {
327+
return(list(dat))
163328
} else {
164-
data
329+
# the order of lvls determines the order in which traces are drawn
330+
# for ordered factors at least, it makes sense to draw the highest level first
331+
# since that _should_ be the darkest color in a sequential pallette
332+
lvls <- if (is.factor(x)) rev(levels(x)) else unique(x)
333+
n <- length(x)
334+
# recursively search for a non-list of appropriate length (if it is, subset it)
335+
recurse <- function(z, n, idx) {
336+
if (is.list(z)) lapply(z, recurse, n, idx) else if (length(z) == n) z[idx] else z
337+
}
338+
new_dat <- list()
339+
for (j in seq_along(lvls)) {
340+
new_dat[[j]] <- lapply(dat, function(y) recurse(y, n, x %in% lvls[j]))
341+
new_dat[[j]]$name <- lvls[j]
342+
}
343+
return(new_dat)
344+
}
345+
}
346+
347+
axis_titles <- function(x, l) {
348+
for (i in c("x", "y", "z")) {
349+
s <- lapply(x$data, "[[", i)
350+
ax <- paste0(i, "axis")
351+
t <- x$layout[[ax]]$title
352+
if (is.null(t)) { # deparse the unevaluated expression from 1st trace
353+
argz <- as.list(l$data[[1]]$args)
354+
idx <- names(argz) %in% i
355+
if (any(idx)) x$layout[[ax]]$title <- deparse(argz[idx][[1]])
356+
}
165357
}
358+
x
166359
}
167360

168361
#' Main interface to plotly

‎R/plotly_POST.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -33,7 +33,7 @@ plotly_POST <- function(x) {
3333

3434
# search for keyword args in traces and take the first valid one
3535
kwargs2 <- Reduce(c, lapply(x$data, function(x) x[get_kwargs()]))
36-
kwargs <- modifyList(kwargs, if (is.null(kwargs2)) list() else kwargs2)
36+
kwargs <- modifyList(kwargs, kwargs %||% list())
3737

3838
# filename & fileopt are keyword arguments required by the API
3939
# (note they can also be specified by the user)

0 commit comments

Comments
 (0)