From 581ccab3d814b7a83ee01d88a8354fd12f12a444 Mon Sep 17 00:00:00 2001 From: Carson Sievert Date: Fri, 23 Sep 2016 15:27:08 -0500 Subject: [PATCH] implement trellis as argument in plot_ly() --- NAMESPACE | 1 + R/plotly.R | 5 ++++- R/plotly_build.R | 35 ++++++++++++++++++++++++++++++----- R/utils.R | 15 +++++++++++++-- man/plot_ly.Rd | 6 +++++- 5 files changed, 53 insertions(+), 9 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index a0c890e3bb..376373d747 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -22,6 +22,7 @@ S3method(groups,plotly) S3method(layout,matrix) S3method(layout,plotly) S3method(mutate_,plotly) +S3method(plotly_build,built) S3method(plotly_build,gg) S3method(plotly_build,list) S3method(plotly_build,plotly) diff --git a/R/plotly.R b/R/plotly.R index d8c7a4415e..aa49a47cf3 100644 --- a/R/plotly.R +++ b/R/plotly.R @@ -36,6 +36,8 @@ #' \code{\link{group_by}()}, but ensures at least one trace for each unique #' value. This replaces the functionality of the (now deprecated) #' \code{group} argument. +#' @param trellis A formula containing a name or expression. The result is +#' used as a conditioning variable for generating trellis displays. #' @param width Width in pixels (optional, defaults to automatic sizing). #' @param height Height in pixels (optional, defaults to automatic sizing). #' @param source Only relevant for \link{event_data}. @@ -89,7 +91,7 @@ plot_ly <- function(data = data.frame(), ..., type = NULL, color, colors = NULL, alpha = 1, symbol, symbols = NULL, size, sizes = c(10, 100), linetype, linetypes = NULL, - split, width = NULL, height = NULL, source = "A") { + split, trellis, width = NULL, height = NULL, source = "A") { if (!is.data.frame(data)) { stop("First argument, `data`, must be a data frame.", call. = FALSE) } @@ -120,6 +122,7 @@ plot_ly <- function(data = data.frame(), ..., type = NULL, attrs$linetype <- if (!missing(linetype)) linetype attrs$size <- if (!missing(size)) size attrs$split <- if (!missing(split)) split + attrs$trellis <- if (!missing(trellis)) trellis attrs$colors <- colors attrs$alpha <- alpha diff --git a/R/plotly_build.R b/R/plotly_build.R index cafdad20e1..40183b0c9e 100644 --- a/R/plotly_build.R +++ b/R/plotly_build.R @@ -30,6 +30,11 @@ plotly_build.gg <- function(p) { supply_defaults(p) } +#' @export +plotly_build.built <- function(p) { + structure(p, class = setdiff(class(p), "built")) +} + #' @export plotly_build.plotly <- function(p) { @@ -157,14 +162,12 @@ plotly_build.plotly <- function(p) { for (i in seq_along(tr)) { if (inherits(tr[[i]], "AsIs")) builtData[[i]] <- I(builtData[[i]]) } - if (NROW(builtData) > 0) { # Build the index used to split one "trace" into multiple traces isAsIs <- vapply(builtData, function(x) inherits(x, "AsIs"), logical(1)) isDiscrete <- vapply(builtData, is.discrete, logical(1)) # note: can only have one linetype per trace - isSplit <- names(builtData) %in% "split" - names(builtData) %in% "linetype" | + isSplit <- names(builtData) %in% c("linetype", "split", "trellis") | !isAsIs & isDiscrete & names(builtData) %in% c("symbol", "color") if (any(isSplit)) { paste2 <- function(x, y) if (identical(x, y)) x else paste(x, y, sep = "
") @@ -226,6 +229,7 @@ plotly_build.plotly <- function(p) { if (i == 1) traces[[1]] <- c(traces[[1]], d[scaleAttrs]) } + # insert NAs to differentiate groups traces <- lapply(traces, function(x) { d <- data.frame(x[names(x) %in% x$.plotlyVariableMapping], stringsAsFactors = FALSE) @@ -251,7 +255,8 @@ plotly_build.plotly <- function(p) { traces <- map_size(traces) traces <- map_symbol(traces) traces <- map_linetype(traces) - + traces <- map_trellis(traces) + # remove special mapping attributes for (i in seq_along(traces)) { mappingAttrs <- c( @@ -321,7 +326,7 @@ plotly_build.plotly <- function(p) { p <- verify_hovermode(p) # try to convert to webgl if toWebGl was used p <- verify_webgl(p) - p + if (length(missing_anchor_attrs(p$x))) subplot(prefix_class(p, "built")) else p } # ---------------------------------------------------------------- @@ -649,6 +654,26 @@ map_linetype <- function(traces) { traces } +# map the trellis variable to a sensible trace ID +map_trellis <- function(traces) { + anchors <- c("xaxis" = "x", "geo" = "geo", "subplot" = "mapbox") + domain <- unique(unlist(lapply(traces, "[[", "trellis"))) + for (i in seq_along(traces)) { + if (is.null(traces[[i]][["trellis"]])) next + for (j in seq_along(anchors)) { + key <- names(anchors)[[j]] + if (!has_attr(traces[[i]][["type"]], key)) next + range <- paste0( + rep(anchors[[j]], length(domain)), sub("^1$", "", seq_along(domain)) + ) + map <- setNames(range, domain) + traces[[i]][[key]] <- + setNames(map[as.character(traces[[i]][["trellis"]])], NULL) + } + } + traces +} + # break up a single trace into multiple traces according to values stored # a particular key name diff --git a/R/utils.R b/R/utils.R index 83fac23648..962bde92fe 100644 --- a/R/utils.R +++ b/R/utils.R @@ -49,7 +49,14 @@ getLevels <- function(x) { # currently implemented non-positional scales in plot_ly() npscales <- function() { - c("color", "symbol", "linetype", "size", "split") + c("color", "symbol", "linetype", "size", "split", "trellis") +} + +missing_anchor_attrs <- function(p) { + layoutAttrs <- c(names(p$layout), c("mapbox", "geo", "xaxis", "yaxis")) + xTraceAttrs <- sub("^x", "xaxis", sapply(p$data, function(tr) tr[["subplot"]] %||% tr[["geo"]] %||% tr[["xaxis"]])) + yTraceAttrs <- sub("^y", "yaxis", sapply(p$data, function(tr) tr[["subplot"]] %||% tr[["geo"]] %||% tr[["yaxis"]])) + setdiff(c(xTraceAttrs, yTraceAttrs), layoutAttrs) } # copied from https://github.com/plotly/plotly.js/blob/master/src/components/color/attributes.js @@ -110,12 +117,16 @@ is_subplot <- function(p) { isTRUE(p$x$subplot) } +subplot_ids <- function() { + # 3D is not yet working in subplot + c("xaxis", "yaxis", "geo", "mapbox") +} + supply_defaults <- function(p) { # no need to supply defaults for subplots if (is_subplot(p)) return(p) # supply trace anchor defaults anchors <- if (is_geo(p)) c("geo" = "geo") else if (is_mapbox(p)) c("subplot" = "mapbox") else c("xaxis" = "x", "yaxis" = "y") - p$x$data <- lapply(p$x$data, function(tr) { for (i in seq_along(anchors)) { key <- names(anchors)[[i]] diff --git a/man/plot_ly.Rd b/man/plot_ly.Rd index 427353c20c..ec99d2dfb2 100644 --- a/man/plot_ly.Rd +++ b/man/plot_ly.Rd @@ -6,7 +6,8 @@ \usage{ plot_ly(data = data.frame(), ..., type = NULL, color, colors = NULL, alpha = 1, symbol, symbols = NULL, size, sizes = c(10, 100), linetype, - linetypes = NULL, split, width = NULL, height = NULL, source = "A") + linetypes = NULL, split, trellis, width = NULL, height = NULL, + source = "A") } \arguments{ \item{data}{A data frame (optional).} @@ -53,6 +54,9 @@ Either valid \link{par} (lty) or plotly dash codes may be supplied.} value. This replaces the functionality of the (now deprecated) \code{group} argument.} +\item{trellis}{A formula containing a name or expression. The result is +used as a conditioning variable for generating trellis displays.} + \item{width}{Width in pixels (optional, defaults to automatic sizing).} \item{height}{Height in pixels (optional, defaults to automatic sizing).}