Default labels from attributes (option 1)

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

R/aes-evaluation.R

@@ -321,7 +321,10 @@ strip_stage <- function(expr) {
 }
 
 # Convert aesthetic mapping into text labels
-make_labels <- function(mapping) {
+make_labels <- function(mapping, data = 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)) {
@@ -331,6 +334,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)

R/labels.R

@@ -16,6 +16,25 @@ update_labels <- function(p, labels) {
   p
 }
 
+label_from_layer <- function(layer, plot) {
+  data <- (layer$data %|W|% NULL) %||% plot$data
+  mapping <- make_labels(layer$mapping, data)
+  default <- lapply(
+    make_labels(layer$stat$default_aes, data),
+    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

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)
 }
@@ -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
 }

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

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