Expression aesthetics (#6685)

* add normalisation step for label ingestion

* reuse normalisation in scale labels

* add validation step in GeomText and GeomLabel

* add snapshot test

* add news bullet

* add comments

* typos

* fix bug

Author: teunbrand

NEWS.md

@@ -2,6 +2,8 @@
 
 ### Bug fixes
 
+* `geom_text()` and `geom_label()` accept expressions as the `label` aesthetic 
+  (@teunbrand, #6638)
 * Fixed regression where `draw_key_rect()` stopped using `fill` colours 
   (@mitchelloharawild, #6609).
 * Fixed regression where `scale_{x,y}_*()` threw an error when an expression

R/geom-label.R

@@ -83,6 +83,7 @@ GeomLabel <- ggproto("GeomLabel", Geom,
     if (parse) {
       lab <- parse_safe(as.character(lab))
     }
+    lab <- validate_labels(lab)
 
     data <- coord$transform(data, panel_params)
     data$vjust <- compute_just(data$vjust, data$y, data$x, data$angle)

R/geom-text.R

@@ -23,6 +23,7 @@ GeomText <- ggproto(
     if (parse) {
       lab <- parse_safe(as.character(lab))
     }
+    lab <- validate_labels(lab)
 
     data <- coord$transform(data, panel_params)
 

R/layer.R

@@ -176,6 +176,7 @@ layer <- function(geom = NULL, stat = NULL,
   if (check.aes && length(extra_aes) > 0) {
     cli::cli_warn("Ignoring unknown aesthetics: {.field {extra_aes}}", call = call_env)
   }
+  aes_params$label <- normalise_label(aes_params$label)
 
   # adjust the legend draw key if requested
   geom <- set_draw_key(geom, key_glyph %||% params$key_glyph)
@@ -552,6 +553,7 @@ Layer <- ggproto("Layer", NULL,
 
     # Evaluate aesthetics
     evaled <- eval_aesthetics(aesthetics, data)
+    evaled$label <- normalise_label(evaled$label)
     plot@scales$add_defaults(evaled, plot@plot_env)
 
     # Check for discouraged usage in mapping
@@ -963,3 +965,20 @@ cleanup_mismatched_data <- function(data, n, fun) {
   data[failed] <- NULL
   data
 }
+
+normalise_label <- function(label) {
+  if (is.null(label)) {
+    return(NULL)
+  }
+  if (obj_is_list(label)) {
+    # Ensure that each element in the list has length 1
+    label[lengths(label) == 0] <- ""
+    labels <- lapply(labels, `[`, 1)
+  }
+  if (is.expression(label)) {
+    # Classed expressions, when converted to lists, retain their class.
+    # The unclass is needed to properly treat it as a vctrs-compatible list.
+    label <- unclass(as.list(label))
+  }
+  label
+}

R/scale-.R

@@ -1182,18 +1182,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale,
         call = self$call
       )
     }
-
-    if (obj_is_list(labels)) {
-      # Guard against list with empty elements
-      labels[lengths(labels) == 0] <- ""
-      # Make sure each element is scalar
-      labels <- lapply(labels, `[`, 1)
-    }
-    if (is.expression(labels)) {
-      labels <- as.list(labels)
-    }
-
-    labels
+    normalise_label(labels)
   },
 
   clone = function(self) {
@@ -1436,11 +1425,7 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale,
       # Need to ensure that if breaks were dropped, corresponding labels are too
       labels <- labels[attr(breaks, "pos")]
     }
-
-    if (is.expression(labels)) {
-      labels <- as.list(labels)
-    }
-    labels
+    normalise_label(labels)
   },
 
   clone = function(self) {
@@ -1688,10 +1673,7 @@ ScaleBinned <- ggproto("ScaleBinned", Scale,
         call = self$call
       )
     }
-    if (is.expression(labels)) {
-      labels <- as.list(labels)
-    }
-    labels
+    normalise_label(labels)
   },
 
   clone = function(self) {

tests/testthat/_snaps/geom-text/geom-text-with-expressions.svg

@@ -33,6 +33,18 @@ test_that("geom_text() rejects exotic units", {
   )
 })
 
+test_that("geom_text() can display expressions", {
+
+  df <- data_frame0(x = 1:2, y = 1:2)
+  df$exp <- expression(alpha + beta^2, gamma * sqrt(delta))
+
+  expect_doppelganger(
+    "geom_text with expressions",
+    ggplot(df, aes(x, y, label = exp)) +
+      geom_text()
+  )
+})
+
 # compute_just ------------------------------------------------------------
 
 test_that("vertical and horizontal positions are equivalent", {