Use "label" attribute to store the default label for each aes (#200)

* Use "label" attribute to store the default label for each aes

* Add a NEWS

NEWS.md

@@ -3,6 +3,8 @@
 * Fix a bug about handling Geoms that have some non-primitive value as a default
  for an aesthetic (#195).
 
+* Fix an incompatibility about axis title with the upcoming release of ggplot2 (#200).
+
 # gghighlight 0.4.1
 
 * This is a maintenance release to update test expectations for the upcoming version of ggplot2.

R/gghighlight.R

@@ -319,6 +319,12 @@ calculate_group_info <- function(data, mapping, extra_vars = NULL) {
  data_evaluated <- dplyr::transmute(data, quasi_parallel(!!!mapping_wrapped, ..nrow = n()))
  data_evaluated <- dplyr::select(data_evaluated, where(~ !all(is.na(.))))
 
+ # As of ggplot2 3.6.0? (TBD), the plot-level mappings is no longer used for the default labels.
+ # We need to use the label attribute of each columns instead. cf. https://github.com/tidyverse/ggplot2/pull/5879
+ for (nm in colnames(data_evaluated)) {
+ attr(data_evaluated[[nm]], "label") <- make_label(mapping[[nm]])
+ }
+
  # Calculate group IDs as ggplot2 does.
  # (c.f. https://github.com/tidyverse/ggplot2/blob/8778b48b37d8b7e41c0f4f213031fb47810e70aa/R/grouping.r#L11-L28)
  if ("group" %in% names(data_evaluated)) {

R/util.R

@@ -26,3 +26,18 @@ quasi_parallel <- function(..., ..nrow) {
  }
  tibble::new_tibble(l, nrow = ..nrow)
 }
+
+# A simpler version of ggplot2:::make_labels().
+# The difference is that this doesn't strip after_stat() or ..
+make_label <- function(x) {
+ if (is.null(x) || is.atomic(x)) {
+ return(aesthetic)
+ }
+ if (is_quosure(x) && quo_is_symbol(x)) {
+ name <- as_string(quo_get_expr(x))
+ } else {
+ name <- quo_text(x)
+ name <- gsub("\n.*$", "...", name)
+ }
+ name
+}

tests/testthat/helpers.R

@@ -9,7 +9,14 @@ expect_equal_layer <- function(x, y) {
  y$mapping <- y$mapping[sort(names(y$mapping))]
  x$data <- tibble::as_tibble(x$data[, sort(colnames(x$data))])
  y$data <- tibble::as_tibble(y$data[, sort(colnames(y$data))])
- expect_equal(as.list(x), as.list(y), ignore_formula_env = TRUE)
+ expect_equal(as_no_label_list(x), as_no_label_list(x), ignore_formula_env = TRUE)
+}
+
+as_no_label_list <- function(x) {
+ lapply(x, \(x) {
+ attr(x, "label") <- NULL
+ x
+ })
 }
 
 expect_equal_layers <- function(x, y) {

tests/testthat/test-calculate-group.R

@@ -11,6 +11,9 @@ test_that("calculate_group_info() works", {
  )
 
  d_expect <- setNames(d[1:3], c("x", "y", "colour"))
+ attr(d_expect[[1L]], "label") <- "x"
+ attr(d_expect[[2L]], "label") <- "y"
+ attr(d_expect[[3L]], "label") <- "type"
  ids <- c(1, 1, 1, 2, 2, 3, 3)
 
  expect_equal(calculate_group_info(d, aes(x, y, colour = type)),
@@ -21,6 +24,7 @@ test_that("calculate_group_info() works", {
  # if some aes is the call, caluculated result is used. But it's not used for group keys.
  d_expect_factor <- d_expect
  d_expect_factor$colour <- factor(d_expect_factor$colour)
+ attr(d_expect_factor$colour, "label") <- "factor(type)"
  expect_equal(calculate_group_info(d, aes(x, y, colour = factor(type))),
  list(data = d_expect_factor, id = ids, key = aes()))
 
@@ -32,6 +36,7 @@ test_that("calculate_group_info() works", {
  # if there is group mapping, use it
  d_expect_group <- d_expect
  d_expect_group$group <- d$type == "a"
+ attr(d_expect_group$group, "label") <- '(type == "a")'
  res <- calculate_group_info(d, aes(x, y, group = (type == "a"), colour = type))
  expect_equal(res$data, d_expect_group[, colnames(res$data)])
  expect_equal(res$id, c(2, 2, 2, 1, 1, 1, 1))
@@ -53,6 +58,9 @@ test_that("calculate_group_info() works with facets", {
  )
 
  d_expect <- setNames(d[1:3], c("x", "y", "colour"))
+ attr(d_expect[[1L]], "label") <- "idx"
+ attr(d_expect[[2L]], "label") <- "value"
+ attr(d_expect[[3L]], "label") <- "cat1"
  ids <- c(1, 1, 2, 2, 3, 3, 4, 4)
 
  expect_equal(calculate_group_info(d, aes(idx, value, colour = cat1), extra_vars = quos(cat2 = cat2)),