diff --git a/NEWS.md b/NEWS.md
index 0ce47d2d8c..b93ad02989 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -15,8 +15,9 @@
## BUG FIXES
-* `subplot()` now bumps annotation `xref`/`yref` anchors correctly (#1181).
-* `subplot()` now accumulates images, repositions paper coordinates, and reanchors axis references (#1332).
+* `subplot()` now works much better with annotations, images, and shapes:
+ - When `xref`/`yref` references an x/y axis these references are bumped accordingly (#1181).
+ - When `xref`/`yref` references paper coordinates, these coordinates are updated accordingly (#1332).
* `event_data("plotly_selected")` is no longer too eager to clear. That is, it is no longer set to `NULL` when clicking on a plot *after* triggering the "plotly_selected" event (#1121) (#1122).
* The colorscale generated via the `color` argument in `plot_ly()` now uses an evenly spaced grid of values instead of quantiles (#1308).
* When using **shinytest** to test a **shiny** that contains **plotly** graph, false positive differences are no longer reported (rstudio/shinytest#174).
diff --git a/R/subplots.R b/R/subplots.R
index 40c8106119..0909ce3e17 100644
--- a/R/subplots.R
+++ b/R/subplots.R
@@ -207,30 +207,31 @@ subplot <- function(..., nrows = 1, widths = NULL, heights = NULL, margin = 0.02
map <- xMap[xMap %in% sub("x", "xaxis", yAxes[[i]][[j]]$anchor %||% "x")]
yAxes[[i]][[j]]$anchor <- sub("axis", "", names(map))
}
- # map trace xaxis/yaxis/geo attributes
+
for (key in c("geo", "subplot", "xaxis", "yaxis")) {
+ # bump trace axis references
oldAnchors <- unlist(lapply(traces[[i]], "[[", key))
if (!length(oldAnchors)) next
axisMap <- if (key == "yaxis") yMap else xMap
axisMap <- setNames(sub("axis", "", axisMap), sub("axis", "", names(axisMap)))
newAnchors <- names(axisMap)[match(oldAnchors, axisMap)]
traces[[i]] <- Map(function(tr, a) { tr[[key]] <- a; tr }, traces[[i]], newAnchors)
- # also map annotation and image xaxis/yaxis references
- # TODO: do this for shapes as well?
+
+ # bump annotation, image, shape xref/yref
+ # (none of these layout components have geo/subplot support)
ref <- list(xaxis = "xref", yaxis = "yref")[[key]]
if (is.null(ref)) next
- if (length(annotations[[i]])) {
- annotations[[i]] <- Map(function(x, y) {
- if (!identical(x[[ref]], "paper")) x[[ref]] <- y
- x
- }, annotations[[i]], newAnchors)
- }
- if (length(images[[i]])) {
- images[[i]] <- Map(function(x, y) {
- if (!identical(x[[ref]], "paper")) x[[ref]] <- y
- x
- }, images[[i]], newAnchors)
+ bump_axis_ref <- function(obj, ref_default = sub("ref", "", ref)) {
+ # TODO: throw error/warning if ref_default doesn't match axisMap?
+ obj[[ref]] <- obj[[ref]] %||% ref_default
+ if (identical(obj[[ref]], "paper")) return(obj)
+ refIdx <- match(obj[[ref]], axisMap)
+ if (!is.na(refIdx)) obj[[ref]] <- names(axisMap)[refIdx][1]
+ obj
}
+ annotations[[i]] <- lapply(annotations[[i]], bump_axis_ref)
+ shapes[[i]] <- lapply(shapes[[i]], bump_axis_ref)
+ images[[i]] <- lapply(images[[i]], bump_axis_ref, "paper")
}
diff --git a/tests/figs/deps.txt b/tests/figs/deps.txt
index ae13abdcb7..059d357267 100644
--- a/tests/figs/deps.txt
+++ b/tests/figs/deps.txt
@@ -1 +1,3 @@
-vdiffr-svg-engine: 0.9000
+- vdiffr-svg-engine: 1.0
+- vdiffr: 0.3.0
+- freetypeharfbuzz: 0.2.5
diff --git a/tests/figs/subplot/plotly-subplot-ggmatrix.svg b/tests/figs/subplot/plotly-subplot-ggmatrix.svg
index 5af6039154..066ad28f0d 100644
--- a/tests/figs/subplot/plotly-subplot-ggmatrix.svg
+++ b/tests/figs/subplot/plotly-subplot-ggmatrix.svg
@@ -1 +1 @@
-
+
diff --git a/tests/figs/subplot/subplot-bump-axis-annotation-shared.svg b/tests/figs/subplot/subplot-bump-axis-annotation-shared.svg
new file mode 100644
index 0000000000..2a26f1b6a2
--- /dev/null
+++ b/tests/figs/subplot/subplot-bump-axis-annotation-shared.svg
@@ -0,0 +1 @@
+
diff --git a/tests/figs/subplot/subplot-bump-axis-annotation-traces-shared.svg b/tests/figs/subplot/subplot-bump-axis-annotation-traces-shared.svg
new file mode 100644
index 0000000000..454b0aca8f
--- /dev/null
+++ b/tests/figs/subplot/subplot-bump-axis-annotation-traces-shared.svg
@@ -0,0 +1 @@
+
diff --git a/tests/figs/subplot/subplot-bump-axis-annotation-traces.svg b/tests/figs/subplot/subplot-bump-axis-annotation-traces.svg
new file mode 100644
index 0000000000..c75493bdb0
--- /dev/null
+++ b/tests/figs/subplot/subplot-bump-axis-annotation-traces.svg
@@ -0,0 +1 @@
+
diff --git a/tests/figs/subplot/subplot-bump-axis-annotation.svg b/tests/figs/subplot/subplot-bump-axis-annotation.svg
new file mode 100644
index 0000000000..cdb8f141ce
--- /dev/null
+++ b/tests/figs/subplot/subplot-bump-axis-annotation.svg
@@ -0,0 +1 @@
+
diff --git a/tests/figs/subplot/subplot-bump-axis-image.svg b/tests/figs/subplot/subplot-bump-axis-image.svg
new file mode 100644
index 0000000000..5fe892aeaf
--- /dev/null
+++ b/tests/figs/subplot/subplot-bump-axis-image.svg
@@ -0,0 +1 @@
+
diff --git a/tests/figs/subplot/subplot-bump-axis-shape-shared.svg b/tests/figs/subplot/subplot-bump-axis-shape-shared.svg
new file mode 100644
index 0000000000..0b12293cda
--- /dev/null
+++ b/tests/figs/subplot/subplot-bump-axis-shape-shared.svg
@@ -0,0 +1 @@
+
diff --git a/tests/figs/subplot/subplot-bump-axis-shape.svg b/tests/figs/subplot/subplot-bump-axis-shape.svg
new file mode 100644
index 0000000000..a6176c3bc0
--- /dev/null
+++ b/tests/figs/subplot/subplot-bump-axis-shape.svg
@@ -0,0 +1 @@
+
diff --git a/tests/figs/subplot/subplot-reposition-annotation.svg b/tests/figs/subplot/subplot-reposition-annotation.svg
new file mode 100644
index 0000000000..dfc5666565
--- /dev/null
+++ b/tests/figs/subplot/subplot-reposition-annotation.svg
@@ -0,0 +1 @@
+
diff --git a/tests/figs/subplot/subplot-reposition-image.svg b/tests/figs/subplot/subplot-reposition-image.svg
new file mode 100644
index 0000000000..4c23e1aa5a
--- /dev/null
+++ b/tests/figs/subplot/subplot-reposition-image.svg
@@ -0,0 +1 @@
+
diff --git a/tests/figs/subplot/subplot-reposition-shape.svg b/tests/figs/subplot/subplot-reposition-shape.svg
new file mode 100644
index 0000000000..e4ba416582
--- /dev/null
+++ b/tests/figs/subplot/subplot-reposition-shape.svg
@@ -0,0 +1 @@
+
diff --git a/tests/testthat/test-plotly-subplot.R b/tests/testthat/test-plotly-subplot.R
index 6784ce8f44..20e3fc03cb 100644
--- a/tests/testthat/test-plotly-subplot.R
+++ b/tests/testthat/test-plotly-subplot.R
@@ -134,40 +134,84 @@ test_that("subplot accepts a list of plots", {
expect_true(l$layout[[sub("y", "yaxis", xaxes[[1]]$anchor)]]$domain[1] == 0)
})
-# Ignore for now https://github.com/ggobi/ggally/issues/264
test_that("ggplotly understands ggmatrix", {
skip_if_not_installed("GGally")
L <- expect_doppelganger_built(GGally::ggpairs(iris), "plotly-subplot-ggmatrix")
})
-test_that("annotation xref/yref are bumped correctly", {
-
- p1 <- plot_ly(mtcars) %>%
- add_annotations(text = ~cyl, x = ~wt, y = ~mpg)
+test_that("annotation paper repositioning", {
+ p1 <- plot_ly() %>%
+ add_annotations(text = "foo", x = 0.5, y = 0.5, xref = "paper", yref = "paper")
p2 <- plot_ly(mtcars) %>%
- add_annotations(text = ~am, x = ~wt, y = ~mpg)
- s <- subplot(p1, p2)
- ann <- plotly_build(s)$x$layout$annotations
+ add_annotations(text = "bar", x = 0.5, y = 0.5, xref = "paper", yref = "paper")
- txt <- sapply(ann, "[[", "text")
+ s <- subplot(p1, p2, margin = 0)
+ ann <- expect_doppelganger_built(s, "subplot-reposition-annotation")$layout$annotations
+ expect_length(ann, 2)
+
+ text <- sapply(ann, "[[", "text")
+ x <- sapply(ann, "[[", "x")
+ y <- sapply(ann, "[[", "y")
xref <- sapply(ann, "[[", "xref")
yref <- sapply(ann, "[[", "yref")
- expect_length(ann, 64)
- expect_equal(txt, c(mtcars$cyl, mtcars$am))
- expect_equal(xref, rep(c("x", "x2"), each = 32))
- expect_equal(yref, rep(c("y", "y2"), each = 32))
+ expect_equal(x, c(0.25, 0.75))
+ expect_equal(y, c(0.5, 0.5))
+ expect_equal(xref, rep("paper", 2))
+ expect_equal(yref, rep("paper", 2))
+})
+
+test_that("shape paper repositioning", {
- s2 <- subplot(p1, p2, shareY = TRUE)
- ann2 <- plotly_build(s2)$x$layout$annotations
+ p1 <- plot_ly(mtcars) %>%
+ layout(
+ shapes = ~list(
+ type = "rect",
+ x0 = 0.25,
+ x1 = 0.75,
+ y0 = 0.25,
+ y1 = 0.75,
+ xref = "paper",
+ yref = "paper",
+ fillcolor = "red"
+ )
+ )
+ p2 <- plot_ly(mtcars) %>%
+ layout(
+ shapes = ~list(
+ type = "line",
+ type = "rect",
+ x0 = 0.25,
+ x1 = 0.75,
+ y0 = 0.25,
+ y1 = 0.75,
+ xref = "paper",
+ yref = "paper",
+ line = list(color = "blue")
+ )
+ )
- xref2 <- sapply(ann2, "[[", "xref")
- yref2 <- sapply(ann2, "[[", "yref")
- expect_equal(xref2, rep(c("x", "x2"), each = 32))
- expect_equal(yref2, rep(c("y", "y"), each = 32))
+ s <- subplot(p1, p2)
+ shapes <- expect_doppelganger_built(s, "subplot-reposition-shape")$layout$shapes
+ expect_length(shapes, 2)
+
+ x0 <- sapply(shapes, "[[", "x0")
+ x1 <- sapply(shapes, "[[", "x1")
+ y0 <- sapply(shapes, "[[", "y0")
+ y1 <- sapply(shapes, "[[", "y1")
+ xref <- sapply(shapes, "[[", "xref")
+ yref <- sapply(shapes, "[[", "yref")
+
+ expect_equal(x0, c(0.12, 0.64))
+ expect_equal(x1, c(0.36, 0.88))
+ expect_equal(y0, rep(0.25, 2))
+ expect_equal(y1, rep(0.75, 2))
+ expect_equal(xref, rep("paper", 2))
+ expect_equal(yref, rep("paper", 2))
})
-test_that("images accumulate and paper coordinates are repositioned", {
+
+test_that("image paper repositioning", {
skip_if_not_installed("png")
r <- as.raster(matrix(hcl(0, 80, seq(50, 80, 10)), nrow = 4, ncol = 5))
@@ -190,18 +234,125 @@ test_that("images accumulate and paper coordinates are repositioned", {
)
s <- subplot(p, p, nrows = 1, margin = 0.02)
- imgs <- plotly_build(s)$x$layout$images
- expect_true(imgs[[1]]$x == 0)
- expect_true(imgs[[1]]$y == 0)
- expect_true(imgs[[1]]$sizex == 0.24)
- expect_true(imgs[[1]]$sizey == 0.5)
- expect_true(imgs[[2]]$x == 0.52)
- expect_true(imgs[[2]]$y == 0)
- expect_true(imgs[[2]]$sizex == 0.24)
- expect_true(imgs[[2]]$sizey == 0.5)
+ imgs <- expect_doppelganger_built(s, "subplot-reposition-image")$layout$images
+
+ expect_length(imgs, 2)
+
+ x <- sapply(imgs, "[[", "x")
+ y <- sapply(imgs, "[[", "y")
+ sizex <- sapply(imgs, "[[", "sizex")
+ sizey <- sapply(imgs, "[[", "sizey")
+
+ expect_equal(x, c(0, 0.52))
+ expect_equal(y, c(0, 0))
+ expect_equal(sizex, rep(0.24, 2))
+ expect_equal(sizey, rep(0.5, 2))
+})
+
+test_that("annotation xref/yref bumping", {
+
+ p1 <- plot_ly(mtcars) %>%
+ add_annotations(text = ~cyl, x = ~wt, y = ~mpg)
+ p2 <- plot_ly(mtcars) %>%
+ add_annotations(text = ~am, x = ~wt, y = ~mpg)
+ s <- subplot(p1, p2)
+ ann <- expect_doppelganger_built(s, "subplot-bump-axis-annotation")$layout$annotations
+
+ txt <- sapply(ann, "[[", "text")
+ xref <- sapply(ann, "[[", "xref")
+ yref <- sapply(ann, "[[", "yref")
+
+ expect_length(ann, 64)
+ expect_equal(txt, c(mtcars$cyl, mtcars$am))
+ expect_equal(xref, rep(c("x", "x2"), each = 32))
+ expect_equal(yref, rep(c("y", "y2"), each = 32))
+
+ s2 <- subplot(p1, p2, shareY = TRUE)
+ ann2 <- expect_doppelganger_built(s2, "subplot-bump-axis-annotation-shared")$layout$annotations
+
+ xref2 <- sapply(ann2, "[[", "xref")
+ yref2 <- sapply(ann2, "[[", "yref")
+ expect_equal(xref2, rep(c("x", "x2"), each = 32))
+ expect_equal(yref2, rep(c("y", "y"), each = 32))
+
+ # now, with more traces than annotations
+ # https://github.com/ropensci/plotly/issues/1444
+ p1 <- plot_ly() %>%
+ add_markers(x = 1, y = 1) %>%
+ add_markers(x = 2, y = 2) %>%
+ add_annotations(text = "foo", x = 1.5, y = 1.5)
+ p2 <- plot_ly() %>%
+ add_markers(x = 1, y = 1) %>%
+ add_markers(x = 2, y = 2) %>%
+ add_annotations(text = "bar", x = 1.5, y = 1.5)
+ s <- subplot(p1, p2)
+ ann <- expect_doppelganger_built(s, "subplot-bump-axis-annotation-traces")$layout$annotations
+
+ txt <- sapply(ann, "[[", "text")
+ xref <- sapply(ann, "[[", "xref")
+ yref <- sapply(ann, "[[", "yref")
+
+ expect_length(ann, 2)
+ expect_equal(txt, c("foo", "bar"))
+ expect_equal(xref, c("x", "x2"))
+ expect_equal(yref, c("y", "y2"))
+
+ s2 <- subplot(p1, p2, shareY = TRUE)
+ ann2 <- expect_doppelganger_built(s2, "subplot-bump-axis-annotation-traces-shared")$layout$annotations
+
+ xref2 <- sapply(ann2, "[[", "xref")
+ yref2 <- sapply(ann2, "[[", "yref")
+ expect_equal(xref2, c("x", "x2"))
+ expect_equal(yref2, c("y", "y"))
})
-test_that("images axis references are remapped", {
+test_that("shape xref/yref bumping", {
+
+ p1 <- plot_ly(mtcars) %>%
+ layout(
+ shapes = ~list(
+ type = "rect",
+ x0 = min(cyl),
+ x1 = max(cyl),
+ y0 = min(am),
+ y1 = max(am),
+ fillcolor = "red"
+ )
+ )
+ p2 <- plot_ly(mtcars) %>%
+ layout(
+ shapes = ~list(
+ type = "line",
+ x0 = min(cyl),
+ x1 = max(cyl),
+ y0 = min(am),
+ y1 = max(am),
+ line = list(color = "blue")
+ )
+ )
+
+ s <- subplot(p1, p2)
+ shapes <- expect_doppelganger_built(s, "subplot-bump-axis-shape")$layout$shapes
+ expect_length(shapes, 2)
+
+ types <- sapply(shapes, "[[", "type")
+ expect_equal(types, c("rect", "line"))
+
+ xref <- sapply(shapes, "[[", "xref")
+ yref <- sapply(shapes, "[[", "yref")
+ expect_equal(xref, c("x", "x2"))
+ expect_equal(yref, c("y", "y2"))
+
+ s2 <- subplot(p1, p2, shareY = TRUE)
+ shapes2 <- expect_doppelganger_built(s2, "subplot-bump-axis-shape-shared")$layout$shapes
+
+ xref2 <- sapply(shapes2, "[[", "xref")
+ yref2 <- sapply(shapes2, "[[", "yref")
+ expect_equal(xref2, c("x", "x2"))
+ expect_equal(yref2, c("y", "y"))
+})
+
+test_that("image xref/yref bumping", {
skip_if_not_installed("png")
r <- as.raster(matrix(hcl(0, 80, seq(50, 80, 10)), nrow = 4, ncol = 5))
@@ -224,15 +375,19 @@ test_that("images axis references are remapped", {
)
s <- subplot(p, p, nrows = 1, margin = 0.02)
- imgs <- plotly_build(s)$x$layout$images
- expect_true(imgs[[1]]$x == 0)
- expect_true(imgs[[1]]$y == 0)
- expect_true(imgs[[1]]$xref == "x")
- expect_true(imgs[[1]]$yref == "y")
- expect_true(imgs[[2]]$x == 0)
- expect_true(imgs[[2]]$y == 0)
- expect_true(imgs[[2]]$xref == "x2")
- expect_true(imgs[[2]]$yref == "y2")
+ imgs <- expect_doppelganger_built(s, "subplot-bump-axis-image")$layout$images
+
+ expect_length(imgs, 2)
+
+ x <- sapply(imgs, "[[", "x")
+ y <- sapply(imgs, "[[", "y")
+ xref <- sapply(imgs, "[[", "xref")
+ yref <- sapply(imgs, "[[", "yref")
+
+ expect_equal(x, c(0, 0))
+ expect_equal(y, c(0, 0))
+ expect_equal(xref, c("x", "x2"))
+ expect_equal(yref, c("y", "y2"))
})