diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml
index 9130ae3125..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 }}
@@ -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
diff --git a/DESCRIPTION b/DESCRIPTION
index 788fecba2d..42df6659f6 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -53,6 +53,7 @@ Suggests:
hexbin,
ggthemes,
GGally,
+ ggalluvial,
testthat,
knitr,
devtools,
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
diff --git a/R/layers2traces.R b/R/layers2traces.R
index 8ddd90c156..1546a66a80 100644
--- a/R/layers2traces.R
+++ b/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
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 @@
+
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 @@
+
diff --git a/tests/testthat/test-ggalluvial.R b/tests/testthat/test-ggalluvial.R
new file mode 100644
index 0000000000..9f834d38ad
--- /dev/null
+++ b/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")
+})
+