Skip to content

Add ggalluvial support #2061

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 12 commits into from
Nov 2, 2021
8 changes: 0 additions & 8 deletions .github/workflows/R-CMD-check.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -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 }}
Expand Down Expand Up @@ -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
Expand Down
1 change: 1 addition & 0 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -53,6 +53,7 @@ Suggests:
hexbin,
ggthemes,
GGally,
ggalluvial,
testthat,
knitr,
devtools,
Expand Down
1 change: 1 addition & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
29 changes: 29 additions & 0 deletions R/layers2traces.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Loading
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
1 change: 1 addition & 0 deletions tests/testthat/_snaps/ggalluvial/stratum-alluvium.svg
Loading
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
31 changes: 31 additions & 0 deletions tests/testthat/test-ggalluvial.R
Original file line number Diff line number Diff line change
@@ -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")
})