Merge pull request #1501 from alyst/fix_wrap_axes

ggplotly(): fix Xaxis anchor if the last row incomplete

Author: cpsievert

R/ggplotly.R

@@ -465,27 +465,41 @@ gg2list <- function(p, width = NULL, height = NULL,
 
   # panel -> plotly.js axis/anchor info
   # (assume a grid layout by default)
-  layout$layout$xaxis <- layout$layout$COL
-  layout$layout$yaxis <- layout$layout$ROW
-  layout$layout$xanchor <- nRows
-  layout$layout$yanchor <- 1
+  layout$layout <- dplyr::mutate(
+    layout$layout,
+    xaxis = COL,
+    yaxis = ROW,
+    xanchor = nRows,
+    yanchor = 1L
+  )
   if (inherits(plot$facet, "FacetWrap")) {
-    if (plot$facet$params$free$x) {
-      layout$layout$xaxis <- layout$layout$PANEL
-      layout$layout$xanchor <- layout$layout$ROW
-    }
-    if (plot$facet$params$free$y) {
-      layout$layout$yaxis <- layout$layout$PANEL
-      layout$layout$yanchor <- layout$layout$COL
-      layout$layout$xanchor <- nPanels
-    }
     if (plot$facet$params$free$x && plot$facet$params$free$y) {
-      layout$layout$xaxis <- layout$layout$PANEL
-      layout$layout$yaxis <- layout$layout$PANEL
-      layout$layout$xanchor <- layout$layout$PANEL
-      layout$layout$yanchor <- layout$layout$PANEL
+      layout$layout <- dplyr::mutate(
+        layout$layout,
+        xaxis = PANEL,
+        yaxis = PANEL,
+        xanchor = PANEL,
+        yanchor = PANEL
+      )
+    } else if (plot$facet$params$free$x) {
+      layout$layout <- dplyr::mutate(
+        layout$layout,
+        xaxis = PANEL,
+        xanchor = ROW
+      )
+    } else if (plot$facet$params$free$y) {
+      layout$layout <- dplyr::mutate(
+        layout$layout,
+        yaxis = PANEL,
+        yanchor = COL
+      )
     }
+    # anchor X axis to the lowest plot in its column
+    layout$layout <- dplyr::group_by_(layout$layout, "xaxis")
+    layout$layout <-  dplyr::mutate(layout$layout, xanchor = max(as.integer(yaxis)))
   }
+  layout$layout <- as.data.frame(layout$layout)
+
   # format the axis/anchor to a format plotly.js respects
   layout$layout$xaxis <- paste0("xaxis", sub("^1$", "", layout$layout$xaxis))
   layout$layout$yaxis <- paste0("yaxis", sub("^1$", "", layout$layout$yaxis))

inst/docker/Dockerfile.vtest

@@ -92,6 +92,7 @@ EXPOSE 3838
 
 RUN R -e "install.packages('assertthat')"
 RUN R -e "install.packages('testthat')"
+ARG CRANCACHE=1
 RUN R -e "update.packages(ask=FALSE)"
 
 # install any new dependencies, then either manage cases (the default) or run tests

tests/figs/facets/facet-wrap-free-y-2.svg

@@ -140,5 +140,5 @@ test_that("when y scales are free, x-axes are still anchored on exterior", {
   info <- expect_doppelganger_built(p, "facet_wrap-free_y-2")
   xaxes <- info$layout[grep("^xaxis", names(info$layout))]
   yaxes <- info$layout[grep("^yaxis", names(info$layout))]
-  expect_equivalent(unique(sapply(xaxes, "[[", "anchor")), "y5")
+  expect_equivalent(unique(sapply(xaxes, "[[", "anchor")), c("y5", "y4"))
 })