Improve subplot()'s handling of annotations, shapes, and images

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). 

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")
     }
 
 

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