From ff6e6d9a995aa317565b361596100ff04f1d2d0c Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Thu, 2 May 2024 12:02:28 +0200 Subject: [PATCH 1/6] isolate layer mechanism for labels --- R/labels.R | 18 ++++++++++++++++++ R/plot-construction.R | 15 +-------------- 2 files changed, 19 insertions(+), 14 deletions(-) diff --git a/R/labels.R b/R/labels.R index a70d6d535c..dd866387dd 100644 --- a/R/labels.R +++ b/R/labels.R @@ -16,6 +16,24 @@ update_labels <- function(p, labels) { p } +label_from_layer <- function(layer, plot) { + mapping <- make_labels(layer$mapping) + default <- lapply( + make_labels(layer$stat$default_aes), + function(l) { + attr(l, "fallback") <- TRUE + l + }) + new_labels <- defaults(mapping, default) + current_labels <- plot$labels + current_fallbacks <- vapply(current_labels, function(l) isTRUE(attr(l, "fallback")), logical(1)) + labels <- defaults(current_labels[!current_fallbacks], new_labels) + if (any(current_fallbacks)) { + labels <- defaults(labels, current_labels) + } + labels +} + #' Modify axis, legend, and plot labels #' #' Good labels are critical for making your plots accessible to a wider diff --git a/R/plot-construction.R b/R/plot-construction.R index b6d83fe1f0..c5676e79b6 100644 --- a/R/plot-construction.R +++ b/R/plot-construction.R @@ -167,19 +167,6 @@ ggplot_add.by <- function(object, plot, object_name) { #' @export ggplot_add.Layer <- function(object, plot, object_name) { plot$layers <- append(plot$layers, object) - - # Add any new labels - mapping <- make_labels(object$mapping) - default <- lapply(make_labels(object$stat$default_aes), function(l) { - attr(l, "fallback") <- TRUE - l - }) - new_labels <- defaults(mapping, default) - current_labels <- plot$labels - current_fallbacks <- vapply(current_labels, function(l) isTRUE(attr(l, "fallback")), logical(1)) - plot$labels <- defaults(current_labels[!current_fallbacks], new_labels) - if (any(current_fallbacks)) { - plot$labels <- defaults(plot$labels, current_labels) - } + plot$labels <- label_from_layer(object, plot) plot } From 50fd6468e5e1e787c935d1a51aa8dba8f344fc55 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Thu, 2 May 2024 12:03:50 +0200 Subject: [PATCH 2/6] allow label lookup from data --- R/aes-evaluation.R | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/R/aes-evaluation.R b/R/aes-evaluation.R index e128fd2c15..dfddcf0d0b 100644 --- a/R/aes-evaluation.R +++ b/R/aes-evaluation.R @@ -321,7 +321,8 @@ strip_stage <- function(expr) { } # Convert aesthetic mapping into text labels -make_labels <- function(mapping) { +make_labels <- function(mapping, data = NULL) { + data <- data %|W|% NULL default_label <- function(aesthetic, mapping) { # e.g., geom_smooth(aes(colour = "loess")) or aes(y = NULL) if (is.null(mapping) || is.atomic(mapping)) { @@ -331,6 +332,10 @@ make_labels <- function(mapping) { mapping <- strip_dots(mapping, strip_pronoun = TRUE) if (is_quosure(mapping) && quo_is_symbol(mapping)) { name <- as_string(quo_get_expr(mapping)) + if (!is.null(data) && name %in% names(data)) { + value <- eval_tidy(mapping, data = data) + name <- attr(value, "label", exact = TRUE) %||% name + } } else { name <- quo_text(mapping) name <- gsub("\n.*$", "...", name) From 001dc33b0fb3670ab813bee6b7f3d31880c5f8bb Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Thu, 2 May 2024 12:04:07 +0200 Subject: [PATCH 3/6] propagate data for labels --- R/labels.R | 5 +++-- R/plot-construction.R | 2 +- R/plot.R | 2 +- 3 files changed, 5 insertions(+), 4 deletions(-) diff --git a/R/labels.R b/R/labels.R index dd866387dd..72b3e0eee3 100644 --- a/R/labels.R +++ b/R/labels.R @@ -17,9 +17,10 @@ update_labels <- function(p, labels) { } label_from_layer <- function(layer, plot) { - mapping <- make_labels(layer$mapping) + data <- (layer$data %|W|% NULL) %||% plot$data + mapping <- make_labels(layer$mapping, data) default <- lapply( - make_labels(layer$stat$default_aes), + make_labels(layer$stat$default_aes, data), function(l) { attr(l, "fallback") <- TRUE l diff --git a/R/plot-construction.R b/R/plot-construction.R index c5676e79b6..70d62b3be6 100644 --- a/R/plot-construction.R +++ b/R/plot-construction.R @@ -134,7 +134,7 @@ ggplot_add.uneval <- function(object, plot, object_name) { # defaults() doesn't copy class, so copy it. class(plot$mapping) <- class(object) - labels <- make_labels(object) + labels <- make_labels(object, plot$data) names(labels) <- names(object) update_labels(plot, labels) } diff --git a/R/plot.R b/R/plot.R index 0d1df80f98..f0cea24f55 100644 --- a/R/plot.R +++ b/R/plot.R @@ -133,7 +133,7 @@ ggplot.default <- function(data = NULL, mapping = aes(), ..., layout = ggproto(NULL, Layout) ), class = c("gg", "ggplot")) - p$labels <- make_labels(mapping) + p$labels <- make_labels(mapping, data) set_last_plot(p) p From 74047a91402fcb57a24cd19130cffedd49889a31 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Thu, 2 May 2024 12:17:18 +0200 Subject: [PATCH 4/6] add test --- tests/testthat/test-labels.R | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/tests/testthat/test-labels.R b/tests/testthat/test-labels.R index 78a77db663..21d5a0b3da 100644 --- a/tests/testthat/test-labels.R +++ b/tests/testthat/test-labels.R @@ -90,6 +90,33 @@ test_that("plot.tag.position rejects invalid input", { }) +test_that("label attributes are being used", { + + label <- "Miles per gallon" + df <- mtcars + attr(df$mpg, "label") <- label + + # Test constructor + p <- ggplot(df, aes(mpg)) + expect_equal(p$labels, list(x = label)) + + # Test when adding mapping separately + p <- ggplot(df) + aes(mpg) + expect_equal(p$labels, list(x = label)) + + # Test it can be derived from self-contained layer + p <- ggplot() + geom_point(aes(mpg), data = df) + expect_equal(p$labels, list(x = label)) + + # Test it can be derived from main data + p <- ggplot(df) + geom_point(aes(mpg)) + expect_equal(p$labels, list(x = label)) + + # Limitation: cannot eval global mapping in layer data + # p <- ggplot(mapping = aes(mpg)) + geom_point(data = df) + # expect_equal(p$labels, list(x = label)) +}) + test_that("position axis label hierarchy works as intended", { df <- data_frame(foo = c(1e1, 1e5), bar = c(0, 100)) From a1cc86d30e4fecccf96a8efcac6defd4a609af8c Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Thu, 2 May 2024 12:22:25 +0200 Subject: [PATCH 5/6] add news bullet --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index 070c74dd40..efe0725b72 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # ggplot2 (development version) +* Default labels are now derived from a label attribute when available + (@teunbrand, #4631). * (Internal) Applying defaults in `geom_sf()` has moved from the internal `sf_grob()` to `GeomSf$use_defaults()` (@teunbrand). * `facet_wrap()` has new options for the `dir` argument to more precisely From 530e9545121bf59f1b9f324b6bfb06e8627ca0ab Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Thu, 2 May 2024 12:30:14 +0200 Subject: [PATCH 6/6] deal with function `data` more explicitly --- R/aes-evaluation.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/aes-evaluation.R b/R/aes-evaluation.R index dfddcf0d0b..b52ba63308 100644 --- a/R/aes-evaluation.R +++ b/R/aes-evaluation.R @@ -322,7 +322,9 @@ strip_stage <- function(expr) { # Convert aesthetic mapping into text labels make_labels <- function(mapping, data = NULL) { - data <- data %|W|% NULL + if (is.waive(data) || is.function(data)) { + data <- NULL + } default_label <- function(aesthetic, mapping) { # e.g., geom_smooth(aes(colour = "loess")) or aes(y = NULL) if (is.null(mapping) || is.atomic(mapping)) {