From fc015fc4b76f9c77219a0834c9342ea3553e0f12 Mon Sep 17 00:00:00 2001
From: Hiroaki Yutani <yutani.ini@gmail.com>
Date: Thu, 18 Jul 2024 01:15:55 +0900
Subject: [PATCH] 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                               |  2 ++
 R/gghighlight.R                       |  6 ++++++
 R/util.R                              | 15 +++++++++++++++
 tests/testthat/helpers.R              |  9 ++++++++-
 tests/testthat/test-calculate-group.R |  8 ++++++++
 5 files changed, 39 insertions(+), 1 deletion(-)

diff --git a/NEWS.md b/NEWS.md
index e6169ee..1253557 100644
--- a/NEWS.md
+++ b/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.
diff --git a/R/gghighlight.R b/R/gghighlight.R
index ae6f409..5ec94ed 100644
--- a/R/gghighlight.R
+++ b/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)) {
diff --git a/R/util.R b/R/util.R
index 4a2c0c3..2bc9c9e 100644
--- a/R/util.R
+++ b/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
+}
\ No newline at end of file
diff --git a/tests/testthat/helpers.R b/tests/testthat/helpers.R
index c657556..61db43c 100644
--- a/tests/testthat/helpers.R
+++ b/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) {
diff --git a/tests/testthat/test-calculate-group.R b/tests/testthat/test-calculate-group.R
index 387c5cd..4797c8a 100644
--- a/tests/testthat/test-calculate-group.R
+++ b/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)),