From c2621ac5eb1917309d8b9ade224e0c433e406574 Mon Sep 17 00:00:00 2001 From: Abdessabour Moutik Date: Tue, 12 Oct 2021 14:10:57 -0700 Subject: [PATCH 1/4] 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 2/4] 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 3/4] 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 4/4] 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), ]