From 0b74e8db14ffec422ba7dd57c416a415c0b23af8 Mon Sep 17 00:00:00 2001 From: Alexey Stukalov Date: Mon, 18 Mar 2019 20:44:42 +0100 Subject: [PATCH 1/4] ggplotly: fix Xaxis anchor if the last row incomplete attach X axis to the last non-empty row in a column --- R/ggplotly.R | 42 +++++++++++++++++------------ tests/testthat/test-ggplot-facets.R | 2 +- 2 files changed, 26 insertions(+), 18 deletions(-) diff --git a/R/ggplotly.R b/R/ggplotly.R index 6e0c2d9009..0c2ee2fede 100644 --- a/R/ggplotly.R +++ b/R/ggplotly.R @@ -459,27 +459,35 @@ 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) %>% + dplyr::mutate(xanchor = max(as.integer(yaxis))) %>% + dplyr::ungroup() %>% + dplyr::mutate(xanchor = if (is.factor(yaxis)) levels(yaxis)[xanchor] else xanchor) } + 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)) diff --git a/tests/testthat/test-ggplot-facets.R b/tests/testthat/test-ggplot-facets.R index 70f3a931c0..2f0bb516e5 100644 --- a/tests/testthat/test-ggplot-facets.R +++ b/tests/testthat/test-ggplot-facets.R @@ -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")) }) From 414fbe1582e8b6e6bd2f602aeb2383001d754b16 Mon Sep 17 00:00:00 2001 From: Carson Sievert Date: Wed, 3 Apr 2019 12:02:31 -0500 Subject: [PATCH 2/4] stylistic changes --- R/ggplotly.R | 26 +++++++++++++++++--------- 1 file changed, 17 insertions(+), 9 deletions(-) diff --git a/R/ggplotly.R b/R/ggplotly.R index 0c2ee2fede..3db5968b9c 100644 --- a/R/ggplotly.R +++ b/R/ggplotly.R @@ -459,29 +459,37 @@ gg2list <- function(p, width = NULL, height = NULL, # panel -> plotly.js axis/anchor info # (assume a grid layout by default) - layout$layout <- dplyr::mutate(layout$layout, + layout$layout <- dplyr::mutate( + layout$layout, xaxis = COL, yaxis = ROW, xanchor = nRows, - yanchor = 1L) + yanchor = 1L + ) if (inherits(plot$facet, "FacetWrap")) { if (plot$facet$params$free$x && plot$facet$params$free$y) { - layout$layout <- dplyr::mutate(layout$layout, + layout$layout <- dplyr::mutate( + layout$layout, xaxis = PANEL, yaxis = PANEL, xanchor = PANEL, - yanchor = PANEL) + yanchor = PANEL + ) } else if (plot$facet$params$free$x) { - layout$layout <- dplyr::mutate(layout$layout, + layout$layout <- dplyr::mutate( + layout$layout, xaxis = PANEL, - xanchor = ROW) + xanchor = ROW + ) } else if (plot$facet$params$free$y) { - layout$layout <- dplyr::mutate(layout$layout, + layout$layout <- dplyr::mutate( + layout$layout, yaxis = PANEL, - yanchor = COL) + yanchor = COL + ) } # anchor X axis to the lowest plot in its column - layout$layout <- dplyr::group_by(layout$layout, xaxis) %>% + layout$layout <- dplyr::group_by_(layout$layout, "xaxis") %>% dplyr::mutate(xanchor = max(as.integer(yaxis))) %>% dplyr::ungroup() %>% dplyr::mutate(xanchor = if (is.factor(yaxis)) levels(yaxis)[xanchor] else xanchor) From 8a8878d8acc9064640653f0a874debecf3e46cef Mon Sep 17 00:00:00 2001 From: Carson Sievert Date: Wed, 3 Apr 2019 12:06:44 -0500 Subject: [PATCH 3/4] validate new visual baselines --- tests/figs/facets/facet-wrap-free-y-2.svg | 2 +- tests/figs/facets/facet-wrap-free-y.svg | 2 +- tests/figs/smooth/smooth-facet.svg | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/figs/facets/facet-wrap-free-y-2.svg b/tests/figs/facets/facet-wrap-free-y-2.svg index e066d012e6..07d8b1ddc7 100644 --- a/tests/figs/facets/facet-wrap-free-y-2.svg +++ b/tests/figs/facets/facet-wrap-free-y-2.svg @@ -1 +1 @@ -025005000750010000125005101519701980199020002010400080001200019701980199020002010200000240000280000320000510152025datevaluepcepoppsavertuempmedunemploy +025005000750010000125005101519701980199020002010400080001200020000024000028000032000019701980199020002010510152025datevaluepcepoppsavertuempmedunemploy diff --git a/tests/figs/facets/facet-wrap-free-y.svg b/tests/figs/facets/facet-wrap-free-y.svg index a570a157bb..0e5fe9be4d 100644 --- a/tests/figs/facets/facet-wrap-free-y.svg +++ b/tests/figs/facets/facet-wrap-free-y.svg @@ -1 +1 @@ -1015202530353.54.04.55.05.52.42.83.23.62.502.753.003.253.501015202530351.52.02.5mpgwt00011011 +3.54.04.55.05.51015202530352.42.83.23.62.502.753.003.253.501015202530351.52.02.5mpgwt00011011 diff --git a/tests/figs/smooth/smooth-facet.svg b/tests/figs/smooth/smooth-facet.svg index 58139fb24d..c42668b88e 100644 --- a/tests/figs/smooth/smooth-facet.svg +++ b/tests/figs/smooth/smooth-facet.svg @@ -1 +1 @@ -0500010000150002000012050001000015000200001212FairGoodVery GoodPremiumIdealcaratpriceFairGoodVery GoodPremiumIdealcut +0500010000150002000012050001000015000200001212FairGoodVery GoodPremiumIdealcaratpriceFairGoodVery GoodPremiumIdealcut From 3c8505230aca09c4adf4672f91ffc1e1cc4a32f0 Mon Sep 17 00:00:00 2001 From: Carson Sievert Date: Mon, 8 Apr 2019 14:09:29 -0500 Subject: [PATCH 4/4] Doesn't seem like we need to handle yaxis being a factor and if we do, it likely needs a different fix --- R/ggplotly.R | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/R/ggplotly.R b/R/ggplotly.R index 46e81d4be3..4bc0702194 100644 --- a/R/ggplotly.R +++ b/R/ggplotly.R @@ -495,10 +495,8 @@ gg2list <- function(p, width = NULL, height = NULL, ) } # anchor X axis to the lowest plot in its column - layout$layout <- dplyr::group_by_(layout$layout, "xaxis") %>% - dplyr::mutate(xanchor = max(as.integer(yaxis))) %>% - dplyr::ungroup() %>% - dplyr::mutate(xanchor = if (is.factor(yaxis)) levels(yaxis)[xanchor] else xanchor) + 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)