Add ggalluvial support (#2061)

Co-authored-by: Carson Sievert <[email protected]>
Co-authored-by: Abdessabour Moutik <[email protected]>

.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 }}
@@ -99,13 +98,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

DESCRIPTION

@@ -53,6 +53,7 @@ Suggests:
     hexbin,
     ggthemes,
     GGally,
+    ggalluvial,
     testthat,
     knitr,
     devtools,

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

R/layers2traces.R

@@ -622,6 +622,35 @@ to_basic.GeomQuantile <- function(data, prestats_data, layout, params, p, ...){
   dat
 }
 
+# ggalluvial::GeomStratum
+#' @export
+to_basic.GeomStratum <- function(data, ...) {
+  to_basic.GeomRect(data, ...)
+}
+
+# ggalluvial::GeomAlluvium
+#' @export 
+to_basic.GeomAlluvium <- function(data, ...) {
+  # 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
+  }
+
+  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]),
+    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
 to_basic.default <- function(data, prestats_data, layout, params, p, ...) {
   data

tests/testthat/test-ggalluvial.R

@@ -0,0 +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")
+  expect_doppelganger(ggplotly(p), "stratum-alluvium")
+})
+
+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")
+})
+