diff --git a/NEWS.md b/NEWS.md index 3e92547b2a..8459f00a0f 100644 --- a/NEWS.md +++ b/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 diff --git a/R/geom-label.R b/R/geom-label.R index f250089435..dfa4dae5e1 100644 --- a/R/geom-label.R +++ b/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) diff --git a/R/geom-text.R b/R/geom-text.R index a680b01ab2..406067856e 100644 --- a/R/geom-text.R +++ b/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) diff --git a/R/layer.R b/R/layer.R index d241f69af5..2632f4cde8 100644 --- a/R/layer.R +++ b/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, `[`, i) + } + 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 +} diff --git a/R/scale-.R b/R/scale-.R index df2046c25e..896d916628 100644 --- a/R/scale-.R +++ b/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) { diff --git a/tests/testthat/_snaps/geom-text/geom-text-with-expressions.svg b/tests/testthat/_snaps/geom-text/geom-text-with-expressions.svg new file mode 100644 index 0000000000..4b8b21277f --- /dev/null +++ b/tests/testthat/_snaps/geom-text/geom-text-with-expressions.svg @@ -0,0 +1,64 @@ + + + + + + + + + + + + + + + + + + + + + +α ++ +β +2 +γ + +δ + + + +1.00 +1.25 +1.50 +1.75 +2.00 + + + + + + + + + + +1.00 +1.25 +1.50 +1.75 +2.00 +x +y +geom_text with expressions + + diff --git a/tests/testthat/test-geom-text.R b/tests/testthat/test-geom-text.R index 8fe509e724..da49293c51 100644 --- a/tests/testthat/test-geom-text.R +++ b/tests/testthat/test-geom-text.R @@ -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", {