Skip to content

Commit dd9a3fa

Browse files
cpsievertcpsievert
committed
Merge pull request #526 from ropensci/fix/subplot
Better subplot interface
2 parents bc28595 + cd62ed5 commit dd9a3fa

19 files changed

+733
-217
lines changed

Diff for: ‎DESCRIPTION

+1-1
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
Package: plotly
22
Title: Create Interactive Web Graphics via 'plotly.js'
3-
Version: 3.5.7
3+
Version: 3.6.0
44
Authors@R: c(person("Carson", "Sievert", role = c("aut", "cre"),
55
email = "[email protected]"),
66
person("Chris", "Parmer", role = c("aut", "cph"),

Diff for: ‎NAMESPACE

+6
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,12 @@ S3method(geom2trace,GeomPolygon)
1111
S3method(geom2trace,GeomText)
1212
S3method(geom2trace,GeomTile)
1313
S3method(geom2trace,default)
14+
S3method(ggplotly,ggmatrix)
15+
S3method(ggplotly,ggplot)
16+
S3method(plotly_build,gg)
17+
S3method(plotly_build,plotly_built)
18+
S3method(plotly_build,plotly_hash)
19+
S3method(plotly_build,plotly_subplot)
1420
S3method(print,figure)
1521
S3method(print,plotly_built)
1622
S3method(print,plotly_hash)

Diff for: ‎NEWS

+17
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,20 @@
1+
3.6.0 -- 16 May 2016
2+
3+
NEW FEATURES & CHANGES:
4+
5+
* Many improvements to the subplot() function:
6+
* ggplot2 objects are now officially supported (#520).
7+
* Several new arguments allow one to synchronize x/y axes (#298), height/width (#376), hide/show x/y axis titles.
8+
* A list of plots can now be passed to the first argument.
9+
* A new vignette with examples and more explanation can be accessed via `vignette("subplot")`.
10+
11+
* ggplotly() is now a generic function with a method for ggmatrix objects.
12+
* plotly_build() is now a generic function.
13+
14+
BUG FIX:
15+
16+
Column facet strips will no longer be drawn when there is only one column.
17+
118
3.5.7 -- 13 May 2016
219

320
CHANGES:

Diff for: ‎R/ggplotly.R

+76-35
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,7 @@
1313
#' \code{tooltip = c("y", "x", "colour")} if you want y first, x second, and
1414
#' colour last.
1515
#' @param source Only relevant for \link{event_data}.
16+
#' @param ... arguments passed onto methods.
1617
#' @seealso \link{signup}, \link{plot_ly}
1718
#' @return a plotly object
1819
#' @export
@@ -31,7 +32,46 @@
3132
#' }
3233
#'
3334
ggplotly <- function(p = ggplot2::last_plot(), width = NULL, height = NULL,
34-
tooltip = "all", source = "A") {
35+
tooltip = "all", source = "A", ...) {
36+
UseMethod("ggplotly", p)
37+
}
38+
39+
#' @export
40+
ggplotly.ggmatrix <- function(p = ggplot2::last_plot(), width = NULL,
41+
height = NULL, tooltip = "all", source = "A", ...) {
42+
subplotList <- list()
43+
for (i in seq_len(p$ncol)) {
44+
columnList <- list()
45+
for (j in seq_len(p$nrow)) {
46+
thisPlot <- p[j, i]
47+
if (i == 1) {
48+
if (p$showYAxisPlotLabels) thisPlot <- thisPlot + ylab(p$yAxisLabels[j])
49+
} else {
50+
# y-axes are never drawn on the interior, and diagonal plots are densities,
51+
# so it doesn't make sense to synch zoom actions on y
52+
thisPlot <- thisPlot +
53+
theme(
54+
axis.ticks.y = element_blank(),
55+
axis.text.y = element_blank()
56+
)
57+
}
58+
columnList <- c(columnList, list(ggplotly(thisPlot, tooltip = tooltip)))
59+
}
60+
# conditioned on a column in a ggmatrix, the x-axis should be on the
61+
# same scale.
62+
s <- subplot(columnList, nrows = p$nrow, margin = 0.01, shareX = TRUE, titleY = TRUE)
63+
subplotList <- c(subplotList, list(s))
64+
}
65+
s <- layout(subplot(subplotList, nrows = 1), width = width, height = height)
66+
if (nchar(p$title) > 0) {
67+
s <- layout(s, title = p$title)
68+
}
69+
hash_plot(p$data, plotly_build(s))
70+
}
71+
72+
#' @export
73+
ggplotly.ggplot <- function(p = ggplot2::last_plot(), width = NULL,
74+
height = NULL, tooltip = "all", source = "A", ...) {
3575
l <- gg2list(p, width = width, height = height, tooltip = tooltip, source = source)
3676
hash_plot(p$data, l)
3777
}
@@ -44,9 +84,10 @@ ggplotly <- function(p = ggplot2::last_plot(), width = NULL, height = NULL,
4484
#' tooltip. The default, "all", means show all the aesthetic tooltips
4585
#' (including the unofficial "text" aesthetic).
4686
#' @param source Only relevant for \link{event_data}.
87+
#' @param ... currently not used
4788
#' @return a 'built' plotly object (list with names "data" and "layout").
4889
#' @export
49-
gg2list <- function(p, width = NULL, height = NULL, tooltip = "all", source = "A") {
90+
gg2list <- function(p, width = NULL, height = NULL, tooltip = "all", source = "A", ...) {
5091
# ------------------------------------------------------------------------
5192
# Our internal version of ggplot2::ggplot_build(). Modified from
5293
# https://github.com/hadley/ggplot2/blob/0cd0ba/R/plot-build.r#L18-L92
@@ -425,55 +466,55 @@ gg2list <- function(p, width = NULL, height = NULL, tooltip = "all", source = "A
425466
gglayout$annotations,
426467
make_label(
427468
faced(axisTitleText, axisTitle$face), x, y, el = axisTitle,
428-
xanchor = "center", yanchor = "middle"
469+
xanchor = "center", yanchor = "middle", annotationType = "axis"
429470
)
430471
)
431472
}
432473
}
433474
}
434-
435-
if (has_facet(p)) {
436-
gglayout[[axisName]]$title <- ""
437-
}
438-
475+
if (has_facet(p)) gglayout[[axisName]]$title <- ""
439476
} # end of axis loop
440477

478+
# theme(panel.border = ) -> plotly rect shape
441479
xdom <- gglayout[[lay[, "xaxis"]]]$domain
442480
ydom <- gglayout[[lay[, "yaxis"]]]$domain
443481
border <- make_panel_border(xdom, ydom, theme)
444482
gglayout$shapes <- c(gglayout$shapes, border)
445-
483+
446484
# facet strips -> plotly annotations
447-
if (!is_blank(theme[["strip.text.x"]]) &&
448-
(inherits(p$facet, "wrap") || inherits(p$facet, "grid") && lay$ROW == 1)) {
449-
vars <- ifelse(inherits(p$facet, "wrap"), "facets", "cols")
450-
txt <- paste(
451-
p$facet$labeller(lay[names(p$facet[[vars]])]), collapse = ", "
485+
if (has_facet(p)) {
486+
col_vars <- ifelse(inherits(p$facet, "wrap"), "facets", "cols")
487+
col_txt <- paste(
488+
p$facet$labeller(lay[names(p$facet[[col_vars]])]), collapse = ", "
452489
)
453-
lab <- make_label(
454-
txt, x = mean(xdom), y = max(ydom),
455-
el = theme[["strip.text.x"]] %||% theme[["strip.text"]],
456-
xanchor = "center", yanchor = "bottom"
457-
)
458-
gglayout$annotations <- c(gglayout$annotations, lab)
459-
strip <- make_strip_rect(xdom, ydom, theme, "top")
460-
gglayout$shapes <- c(gglayout$shapes, strip)
461-
}
462-
if (inherits(p$facet, "grid") && lay$COL == nCols && nRows > 1 &&
463-
!is_blank(theme[["strip.text.y"]])) {
464-
txt <- paste(
490+
if (is_blank(theme[["strip.text.x"]])) col_txt <- ""
491+
if (inherits(p$facet, "grid") && lay$ROW != 1) col_txt <- ""
492+
if (nchar(col_txt) > 0) {
493+
col_lab <- make_label(
494+
col_txt, x = mean(xdom), y = max(ydom),
495+
el = theme[["strip.text.x"]] %||% theme[["strip.text"]],
496+
xanchor = "center", yanchor = "bottom"
497+
)
498+
gglayout$annotations <- c(gglayout$annotations, col_lab)
499+
strip <- make_strip_rect(xdom, ydom, theme, "top")
500+
gglayout$shapes <- c(gglayout$shapes, strip)
501+
}
502+
row_txt <- paste(
465503
p$facet$labeller(lay[names(p$facet$rows)]), collapse = ", "
466504
)
467-
lab <- make_label(
468-
txt, x = max(xdom), y = mean(ydom),
469-
el = theme[["strip.text.y"]] %||% theme[["strip.text"]],
470-
xanchor = "left", yanchor = "middle"
471-
)
472-
gglayout$annotations <- c(gglayout$annotations, lab)
473-
strip <- make_strip_rect(xdom, ydom, theme, "right")
474-
gglayout$shapes <- c(gglayout$shapes, strip)
505+
if (is_blank(theme[["strip.text.y"]])) row_txt <- ""
506+
if (inherits(p$facet, "grid") && lay$COL != nCols) row_txt <- ""
507+
if (nchar(row_txt) > 0) {
508+
row_lab <- make_label(
509+
row_txt, x = max(xdom), y = mean(ydom),
510+
el = theme[["strip.text.y"]] %||% theme[["strip.text"]],
511+
xanchor = "left", yanchor = "middle"
512+
)
513+
gglayout$annotations <- c(gglayout$annotations, row_lab)
514+
strip <- make_strip_rect(xdom, ydom, theme, "right")
515+
gglayout$shapes <- c(gglayout$shapes, strip)
516+
}
475517
}
476-
477518
} # end of panel loop
478519

479520
# ------------------------------------------------------------------------

Diff for: ‎R/plotly.R

+41-10
Original file line numberDiff line numberDiff line change
@@ -221,20 +221,51 @@ style <- function(p = last_plot(), ..., traces = 1, evaluate = FALSE) {
221221
hash_plot(data, p)
222222
}
223223

224-
#' Build a plotly object before viewing it
224+
#' Create a 'plotly_built' object
225225
#'
226-
#' For convenience and efficiency purposes, plotly objects are subject to lazy
227-
#' evaluation. That is, the actual content behind a plotly object is not
228-
#' created until it is absolutely necessary. In some instances, you may want
229-
#' to perform this evaluation yourself, and work directly with the resulting
230-
#' list.
226+
#' This generic function creates the list object sent to plotly.js
227+
#' for rendering. Using this function can be useful for overriding defaults
228+
#' provided by \code{ggplotly}/\code{plot_ly} or for debugging rendering
229+
#' errors.
231230
#'
232-
#' @param l a ggplot object, or a plotly object, or a list.
231+
#' @param l a ggplot object, or a plotly_hash object, or a list.
233232
#' @export
233+
#' @examples
234+
#'
235+
#' p <- plot_ly()
236+
#' # data frame
237+
#' str(p)
238+
#' # the actual list of options sent to plotly.js
239+
#' str(plotly_build(p))
240+
#'
241+
#' p <- qplot(data = mtcars, wt, mpg, geom = c("point", "smooth"))
242+
#' l <- plotly_build(p)
243+
#' # turn off hoverinfo for the smooth (but keep it for the points)
244+
#' l$data[[2]]$hoverinfo <- "none"
245+
#' l$data[[3]]$hoverinfo <- "none"
246+
#' l
247+
#'
234248
plotly_build <- function(l = last_plot()) {
235-
#if (inherits(l, "ggmatrix"))
236-
# ggplot objects don't need any special type of handling
237-
if (ggplot2::is.ggplot(l)) return(gg2list(l))
249+
UseMethod("plotly_build")
250+
}
251+
252+
#' @export
253+
plotly_build.plotly_built <- function(l = last_plot()) {
254+
l
255+
}
256+
257+
#' @export
258+
plotly_build.plotly_subplot <- function(l = last_plot()) {
259+
prefix_class(get_plot(l), "plotly_built")
260+
}
261+
262+
#' @export
263+
plotly_build.gg <- function(l = last_plot()) {
264+
prefix_class(get_plot(ggplotly(l)), "plotly_built")
265+
}
266+
267+
#' @export
268+
plotly_build.plotly_hash <- function(l = last_plot()) {
238269
l <- get_plot(l)
239270
# assume unnamed list elements are data/traces
240271
nms <- names(l)

0 commit comments

Comments
 (0)