From c2621ac5eb1917309d8b9ade224e0c433e406574 Mon Sep 17 00:00:00 2001 From: Abdessabour Moutik Date: Tue, 12 Oct 2021 14:10:57 -0700 Subject: [PATCH 01/10] Closes #1614. Implemented `to_basic` for the `geom_alluvium` and `geom_stratum` --- R/layers2traces.R | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/R/layers2traces.R b/R/layers2traces.R index 0387d34c5c..b137495f1b 100644 --- a/R/layers2traces.R +++ b/R/layers2traces.R @@ -613,6 +613,35 @@ to_basic.GeomQuantile <- function(data, prestats_data, layout, params, p, ...){ dat } +#' @export +to_basic.GeomStratum <- function (data, ...) { + to_basic.GeomRect(data, ...) +} + +#' @export +to_basic.GeomAlluvium <- function (data, ...) { + prefix_class(transform_alluvium(data), "GeomPolygon") +} + +# tranform the alluvium data into the corresponding polygons +transform_alluvium <- function(data) { + data <- data[order(data$x), ] + + if(unique(data$colour) == 0) data$colour <- NULL + + unused_aes <- ! names(data) %in% c("x", "y", "ymin", "ymax") + + row_number <- nrow(data) + + data_rev <- data[nrow(data):1L, ] + + structure(rbind( + cbind(x = data$x, y = data$ymin, data[unused_aes]), + cbind(x = data$x[row_number], y = data$ymin[row_number], data[row_number, unused_aes]), + cbind(x = data_rev$x, y = data_rev$ymax, data_rev[unused_aes]) + ), class = class(data)) +} + #' @export to_basic.default <- function(data, prestats_data, layout, params, p, ...) { data From 5d8ce0a0777ad54c9c5c8b150288688f704a3ff2 Mon Sep 17 00:00:00 2001 From: Abdessabour Moutik Date: Tue, 12 Oct 2021 14:11:38 -0700 Subject: [PATCH 02/10] Added visual tests for this implementation --- tests/testthat/_snaps/ggalluvial/alluvium.svg | 1 + .../_snaps/ggalluvial/stratum-alluvium.svg | 1 + tests/testthat/_snaps/ggalluvial/stratum.svg | 1 + tests/testthat/test-ggalluvial.R | 46 +++++++++++++++++++ 4 files changed, 49 insertions(+) create mode 100644 tests/testthat/_snaps/ggalluvial/alluvium.svg create mode 100644 tests/testthat/_snaps/ggalluvial/stratum-alluvium.svg create mode 100644 tests/testthat/_snaps/ggalluvial/stratum.svg create mode 100644 tests/testthat/test-ggalluvial.R diff --git a/tests/testthat/_snaps/ggalluvial/alluvium.svg b/tests/testthat/_snaps/ggalluvial/alluvium.svg new file mode 100644 index 0000000000..cfc05b43fa --- /dev/null +++ b/tests/testthat/_snaps/ggalluvial/alluvium.svg @@ -0,0 +1 @@ +0500100015002000SurvivedSexClass1st2nd3rdCrewTitanic survival by class and sexFreq diff --git a/tests/testthat/_snaps/ggalluvial/stratum-alluvium.svg b/tests/testthat/_snaps/ggalluvial/stratum-alluvium.svg new file mode 100644 index 0000000000..f50c0f8437 --- /dev/null +++ b/tests/testthat/_snaps/ggalluvial/stratum-alluvium.svg @@ -0,0 +1 @@ +NoYesMaleFemale1st2nd3rdCrew0500100015002000SurvivedSexClass1st2nd3rdCrewTitanic survival by class and sexFreq diff --git a/tests/testthat/_snaps/ggalluvial/stratum.svg b/tests/testthat/_snaps/ggalluvial/stratum.svg new file mode 100644 index 0000000000..e70d5d2762 --- /dev/null +++ b/tests/testthat/_snaps/ggalluvial/stratum.svg @@ -0,0 +1 @@ +NoYesMaleFemale1st2nd3rdCrew0500100015002000SurvivedSexClassTitanic survival by class and sexFreq diff --git a/tests/testthat/test-ggalluvial.R b/tests/testthat/test-ggalluvial.R new file mode 100644 index 0000000000..a0a87d74a9 --- /dev/null +++ b/tests/testthat/test-ggalluvial.R @@ -0,0 +1,46 @@ +library(ggalluvial) + +test_that("using both of `geom_alluvium` and `geom_stratum` gives the correct output", { + p <- ggplot(as.data.frame(Titanic), + aes(y = Freq, + axis1 = Survived, axis2 = Sex, axis3 = Class)) + + geom_alluvium(aes(fill = Class), + width = 0, knot.pos = 0, reverse = FALSE) + + guides(fill = "none") + + geom_stratum(width = 1/8, reverse = FALSE) + + geom_text(stat = "stratum", aes(label = after_stat(stratum)), + reverse = FALSE) + + scale_x_continuous(breaks = 1:3, labels = c("Survived", "Sex", "Class")) + + coord_flip() + + ggtitle("Titanic survival by class and sex") + # write_plotly_svg(p, "tests/testthat/_snaps/ggalluvial/stratum-alluvium.svg") + expect_doppelganger(ggplotly(p), "stratum-alluvium") +}) + +test_that("using `geom_stratum` gives the correct output", { + p <- ggplot(as.data.frame(Titanic), + aes(y = Freq, + axis1 = Survived, axis2 = Sex, axis3 = Class)) + + geom_stratum(width = 1/8, reverse = FALSE) + + geom_text(stat = "stratum", aes(label = after_stat(stratum)), + reverse = FALSE) + + scale_x_continuous(breaks = 1:3, labels = c("Survived", "Sex", "Class")) + + coord_flip() + + ggtitle("Titanic survival by class and sex") + #write_plotly_svg(p, "tests/testthat/_snaps/ggalluvial/stratum.svg") + expect_doppelganger(ggplotly(p), "stratum") +}) + +test_that("using `geom_alluvium` gives the correct output", { + p <- ggplot(as.data.frame(Titanic), + aes(y = Freq, + axis1 = Survived, axis2 = Sex, axis3 = Class)) + + geom_alluvium(aes(fill = Class), + width = 0, knot.pos = 0, reverse = FALSE) + + guides(fill = "none") + + scale_x_continuous(breaks = 1:3, labels = c("Survived", "Sex", "Class")) + + coord_flip() + + ggtitle("Titanic survival by class and sex") + #write_plotly_svg(p, "tests/testthat/_snaps/ggalluvial/alluvium.svg") + expect_doppelganger(ggplotly(p), "alluvium") +}) \ No newline at end of file From 5861f68daecc47f20a710c7d59a17fe95b7f62b8 Mon Sep 17 00:00:00 2001 From: Abdessabour Moutik Date: Tue, 12 Oct 2021 15:23:50 -0700 Subject: [PATCH 03/10] Conforming with the review Co-authored-by: Carson Sievert --- R/layers2traces.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/layers2traces.R b/R/layers2traces.R index b137495f1b..d9cefae373 100644 --- a/R/layers2traces.R +++ b/R/layers2traces.R @@ -633,7 +633,7 @@ transform_alluvium <- function(data) { row_number <- nrow(data) - data_rev <- data[nrow(data):1L, ] + data_rev <- data[rev(seq_len(row_number)), ] structure(rbind( cbind(x = data$x, y = data$ymin, data[unused_aes]), From bdef9397c57606a867f32cf303cdec9722907c5e Mon Sep 17 00:00:00 2001 From: Abdessabour Moutik Date: Tue, 12 Oct 2021 15:24:03 -0700 Subject: [PATCH 04/10] Conforming with the review Co-authored-by: Carson Sievert --- R/layers2traces.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/layers2traces.R b/R/layers2traces.R index d9cefae373..f85b1d8f3e 100644 --- a/R/layers2traces.R +++ b/R/layers2traces.R @@ -623,7 +623,7 @@ to_basic.GeomAlluvium <- function (data, ...) { prefix_class(transform_alluvium(data), "GeomPolygon") } -# tranform the alluvium data into the corresponding polygons +# transform the alluvium data into the corresponding polygons transform_alluvium <- function(data) { data <- data[order(data$x), ] From 391ba4c62e11f6d8e04c76eb3138baa289fe9f43 Mon Sep 17 00:00:00 2001 From: Carson Date: Mon, 1 Nov 2021 13:49:58 -0500 Subject: [PATCH 05/10] Improve tests and type safety --- R/layers2traces.R | 28 ++++---- tests/testthat/_snaps/ggalluvial/alluvium.svg | 1 - tests/testthat/_snaps/ggalluvial/stratum.svg | 1 - tests/testthat/test-ggalluvial.R | 65 +++++++------------ 4 files changed, 40 insertions(+), 55 deletions(-) delete mode 100644 tests/testthat/_snaps/ggalluvial/alluvium.svg delete mode 100644 tests/testthat/_snaps/ggalluvial/stratum.svg diff --git a/R/layers2traces.R b/R/layers2traces.R index f85b1d8f3e..f888b7d941 100644 --- a/R/layers2traces.R +++ b/R/layers2traces.R @@ -613,33 +613,35 @@ to_basic.GeomQuantile <- function(data, prestats_data, layout, params, p, ...){ dat } +# ggalluvial::GeomStratum #' @export -to_basic.GeomStratum <- function (data, ...) { +to_basic.GeomStratum <- function(data, ...) { to_basic.GeomRect(data, ...) } +# ggalluvial::GeomAlluvium #' @export -to_basic.GeomAlluvium <- function (data, ...) { - prefix_class(transform_alluvium(data), "GeomPolygon") -} - -# transform the alluvium data into the corresponding polygons -transform_alluvium <- function(data) { +to_basic.GeomAlluvium <- function(data, ...) { data <- data[order(data$x), ] - if(unique(data$colour) == 0) data$colour <- NULL + cols <- unique(data$colour) + if (length(cols) == 1 && cols[1] == 0) { + data$colour <- NULL + } + + unused_aes <- !names(data) %in% c("x", "y", "ymin", "ymax") - unused_aes <- ! names(data) %in% c("x", "y", "ymin", "ymax") - row_number <- nrow(data) - + data_rev <- data[rev(seq_len(row_number)), ] - - structure(rbind( + + d <- structure(rbind( cbind(x = data$x, y = data$ymin, data[unused_aes]), cbind(x = data$x[row_number], y = data$ymin[row_number], data[row_number, unused_aes]), cbind(x = data_rev$x, y = data_rev$ymax, data_rev[unused_aes]) ), class = class(data)) + + prefix_class(d, "GeomPolygon") } #' @export diff --git a/tests/testthat/_snaps/ggalluvial/alluvium.svg b/tests/testthat/_snaps/ggalluvial/alluvium.svg deleted file mode 100644 index cfc05b43fa..0000000000 --- a/tests/testthat/_snaps/ggalluvial/alluvium.svg +++ /dev/null @@ -1 +0,0 @@ -0500100015002000SurvivedSexClass1st2nd3rdCrewTitanic survival by class and sexFreq diff --git a/tests/testthat/_snaps/ggalluvial/stratum.svg b/tests/testthat/_snaps/ggalluvial/stratum.svg deleted file mode 100644 index e70d5d2762..0000000000 --- a/tests/testthat/_snaps/ggalluvial/stratum.svg +++ /dev/null @@ -1 +0,0 @@ -NoYesMaleFemale1st2nd3rdCrew0500100015002000SurvivedSexClassTitanic survival by class and sexFreq diff --git a/tests/testthat/test-ggalluvial.R b/tests/testthat/test-ggalluvial.R index a0a87d74a9..9f834d38ad 100644 --- a/tests/testthat/test-ggalluvial.R +++ b/tests/testthat/test-ggalluvial.R @@ -1,46 +1,31 @@ +skip_if_not_installed("ggalluvial") library(ggalluvial) - + test_that("using both of `geom_alluvium` and `geom_stratum` gives the correct output", { - p <- ggplot(as.data.frame(Titanic), - aes(y = Freq, - axis1 = Survived, axis2 = Sex, axis3 = Class)) + - geom_alluvium(aes(fill = Class), - width = 0, knot.pos = 0, reverse = FALSE) + - guides(fill = "none") + - geom_stratum(width = 1/8, reverse = FALSE) + - geom_text(stat = "stratum", aes(label = after_stat(stratum)), - reverse = FALSE) + - scale_x_continuous(breaks = 1:3, labels = c("Survived", "Sex", "Class")) + - coord_flip() + - ggtitle("Titanic survival by class and sex") - # write_plotly_svg(p, "tests/testthat/_snaps/ggalluvial/stratum-alluvium.svg") - expect_doppelganger(ggplotly(p), "stratum-alluvium") + p <- ggplot(as.data.frame(Titanic), + aes(y = Freq, axis1 = Survived, axis2 = Sex, axis3 = Class)) + + geom_alluvium(aes(fill = Class), + width = 0, knot.pos = 0, reverse = FALSE) + + guides(fill = "none") + + geom_stratum(width = 1/8, reverse = FALSE) + + geom_text(stat = "stratum", aes(label = after_stat(stratum)), + reverse = FALSE) + + scale_x_continuous(breaks = 1:3, labels = c("Survived", "Sex", "Class")) + + coord_flip() + + ggtitle("Titanic survival by class and sex") + expect_doppelganger(ggplotly(p), "stratum-alluvium") }) -test_that("using `geom_stratum` gives the correct output", { - p <- ggplot(as.data.frame(Titanic), - aes(y = Freq, - axis1 = Survived, axis2 = Sex, axis3 = Class)) + - geom_stratum(width = 1/8, reverse = FALSE) + - geom_text(stat = "stratum", aes(label = after_stat(stratum)), - reverse = FALSE) + - scale_x_continuous(breaks = 1:3, labels = c("Survived", "Sex", "Class")) + - coord_flip() + - ggtitle("Titanic survival by class and sex") - #write_plotly_svg(p, "tests/testthat/_snaps/ggalluvial/stratum.svg") - expect_doppelganger(ggplotly(p), "stratum") +test_that("color aesthetic works", { + p <- ggplot(as.data.frame(Titanic), + aes(y = Freq, axis1 = Survived, axis2 = Sex, axis3 = Class)) + + geom_alluvium(aes(color = Class), width = 0, knot.pos = 0, reverse = FALSE, alpha = 0.3) + + geom_stratum(width = 1/8, reverse = FALSE) + + geom_text(stat = "stratum", aes(label = after_stat(stratum)), + reverse = FALSE) + + scale_x_continuous(breaks = 1:3, labels = c("Survived", "Sex", "Class")) + + coord_flip() + + ggtitle("Titanic survival by class and sex") + expect_doppelganger(ggplotly(p), "stratum-alluvium-color") }) -test_that("using `geom_alluvium` gives the correct output", { - p <- ggplot(as.data.frame(Titanic), - aes(y = Freq, - axis1 = Survived, axis2 = Sex, axis3 = Class)) + - geom_alluvium(aes(fill = Class), - width = 0, knot.pos = 0, reverse = FALSE) + - guides(fill = "none") + - scale_x_continuous(breaks = 1:3, labels = c("Survived", "Sex", "Class")) + - coord_flip() + - ggtitle("Titanic survival by class and sex") - #write_plotly_svg(p, "tests/testthat/_snaps/ggalluvial/alluvium.svg") - expect_doppelganger(ggplotly(p), "alluvium") -}) \ No newline at end of file From 6a1e1a7a28a70699606a90518cc114990719e4cf Mon Sep 17 00:00:00 2001 From: Carson Date: Mon, 1 Nov 2021 14:01:02 -0500 Subject: [PATCH 06/10] Add new baseline --- tests/testthat/_snaps/ggalluvial/stratum-alluvium-color.svg | 1 + 1 file changed, 1 insertion(+) create mode 100644 tests/testthat/_snaps/ggalluvial/stratum-alluvium-color.svg diff --git a/tests/testthat/_snaps/ggalluvial/stratum-alluvium-color.svg b/tests/testthat/_snaps/ggalluvial/stratum-alluvium-color.svg new file mode 100644 index 0000000000..9c7c10850f --- /dev/null +++ b/tests/testthat/_snaps/ggalluvial/stratum-alluvium-color.svg @@ -0,0 +1 @@ +NoYesMaleFemale1st2nd3rdCrew0500100015002000SurvivedSexClassClass1st2nd3rdCrewTitanic survival by class and sexFreq From 8618911dfdac7e386bcf53dc86b4f78c2d2afc26 Mon Sep 17 00:00:00 2001 From: Carson Date: Mon, 1 Nov 2021 15:20:16 -0500 Subject: [PATCH 07/10] get rid of sessioninfo --- .github/workflows/R-CMD-check.yaml | 7 ------- 1 file changed, 7 deletions(-) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 9130ae3125..d6ac4c4b18 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -99,13 +99,6 @@ jobs: Rscript -e "reticulate::conda_install('r-reticulate', 'python-kaleido')" Rscript -e "reticulate::conda_install('r-reticulate', 'plotly', channel = 'plotly')" Rscript -e "reticulate::use_miniconda('r-reticulate')" - - - name: Session info - run: | - options(width = 100) - pkgs <- installed.packages()[, "Package"] - sessioninfo::session_info(pkgs, include_base = TRUE) - shell: Rscript {0} - name: Install shinytest deps if: matrix.config.shinytest == true From 1bf8b2a228ff5d10424a78884589b45e1f34e9f5 Mon Sep 17 00:00:00 2001 From: Carson Date: Mon, 1 Nov 2021 15:21:44 -0500 Subject: [PATCH 08/10] add ggalluvial to suggests --- DESCRIPTION | 3 +++ 1 file changed, 3 insertions(+) diff --git a/DESCRIPTION b/DESCRIPTION index 788fecba2d..5b50eca2cd 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -53,6 +53,7 @@ Suggests: hexbin, ggthemes, GGally, + ggalluvial, testthat, knitr, devtools, @@ -80,3 +81,5 @@ LazyData: true RoxygenNote: 7.1.2 Encoding: UTF-8 Roxygen: list(markdown = TRUE) +Config/Needs/coverage: + latex2exp From b6e251f7510c5b41180e574c21d98847f954f435 Mon Sep 17 00:00:00 2001 From: Carson Date: Mon, 1 Nov 2021 15:25:32 -0500 Subject: [PATCH 09/10] Update news; drop checks for R 3.4 --- .github/workflows/R-CMD-check.yaml | 1 - NEWS.md | 1 + 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index d6ac4c4b18..47e8c9085b 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -35,7 +35,6 @@ jobs: - {os: ubuntu-18.04, r: 'oldrel', rspm: "https://packagemanager.rstudio.com/cran/__linux__/bionic/latest"} - {os: ubuntu-18.04, r: '3.6', rspm: "https://packagemanager.rstudio.com/cran/__linux__/bionic/latest"} - {os: ubuntu-18.04, r: '3.5', rspm: "https://packagemanager.rstudio.com/cran/__linux__/bionic/latest"} - - {os: ubuntu-18.04, r: '3.4', rspm: "https://packagemanager.rstudio.com/cran/__linux__/bionic/latest"} env: RSPM: ${{ matrix.config.rspm }} diff --git a/NEWS.md b/NEWS.md index 56775ea13a..ebc649ab1f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,7 @@ ## Improvements +* `ggplotly()` now supports the `{ggalluvial}` package. (#2061, @moutikabdessabour) * `ggplotly()` does not issue warnings with `options(warnPartialMatchArgs = TRUE)` any longer. (#2046, @bersbersbers) # 4.10.0 From 22a112fc3226725b066dc34914a17735d8858fca Mon Sep 17 00:00:00 2001 From: Carson Date: Tue, 2 Nov 2021 10:47:04 -0500 Subject: [PATCH 10/10] Cleanup --- DESCRIPTION | 2 -- R/layers2traces.R | 8 +++----- 2 files changed, 3 insertions(+), 7 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 5b50eca2cd..42df6659f6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -81,5 +81,3 @@ LazyData: true RoxygenNote: 7.1.2 Encoding: UTF-8 Roxygen: list(markdown = TRUE) -Config/Needs/coverage: - latex2exp diff --git a/R/layers2traces.R b/R/layers2traces.R index a8f5121180..1546a66a80 100644 --- a/R/layers2traces.R +++ b/R/layers2traces.R @@ -631,18 +631,16 @@ to_basic.GeomStratum <- function(data, ...) { # ggalluvial::GeomAlluvium #' @export to_basic.GeomAlluvium <- function(data, ...) { - data <- data[order(data$x), ] - + # geom_alluvium by default generates a data.frame with a colour column and sets it to 0, which leads to an error when trying to get the colour from the number and grid::col2rgb complains that colors must be positive integers. cols <- unique(data$colour) if (length(cols) == 1 && cols[1] == 0) { data$colour <- NULL } - unused_aes <- !names(data) %in% c("x", "y", "ymin", "ymax") - + data <- data[order(data$x), ] row_number <- nrow(data) - data_rev <- data[rev(seq_len(row_number)), ] + unused_aes <- setdiff(names(data), c("x", "y", "ymin", "ymax")) d <- structure(rbind( cbind(x = data$x, y = data$ymin, data[unused_aes]),