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)),