diff --git a/NEWS.md b/NEWS.md index b40ea07f25..36ab09933e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # ggplot2 (development version) +* Binned guides now accept expressions as labels (@teunbrand, #6005) +* (internal) `Scale$get_labels()` format expressions as lists. * In non-orthogonal coordinate systems (`coord_sf()`, `coord_polar()` and `coord_radial()`), using 'AsIs' variables escape transformation when both `x` and `y` is an 'AsIs' variable (@teunbrand, #6205). diff --git a/R/guide-.R b/R/guide-.R index fc002c33d2..aa2aa7b37d 100644 --- a/R/guide-.R +++ b/R/guide-.R @@ -225,13 +225,8 @@ Guide <- ggproto( mapped <- scale$map(breaks) labels <- scale$get_labels(breaks) - # {vctrs} doesn't play nice with expressions, convert to list. - # see also https://github.com/r-lib/vctrs/issues/559 - if (is.expression(labels)) { - labels <- as.list(labels) - } - key <- data_frame(mapped, .name_repair = ~ aesthetic) + key <- data_frame(!!aesthetic := mapped) key$.value <- breaks key$.label <- labels diff --git a/R/guide-axis-theta.R b/R/guide-axis-theta.R index 7c7b62a9d0..dc4e1b405d 100644 --- a/R/guide-axis-theta.R +++ b/R/guide-axis-theta.R @@ -110,7 +110,7 @@ GuideAxisTheta <- ggproto( # labels of these positions ends_apart <- (key$theta[n] - key$theta[1]) %% (2 * pi) if (n > 0 && ends_apart < 0.05 && !is.null(key$.label)) { - if (is.expression(key$.label)) { + if (is.expression(key$.label[[1]])) { combined <- substitute( paste(a, "/", b), list(a = key$.label[[1]], b = key$.label[[n]]) diff --git a/R/guide-bins.R b/R/guide-bins.R index 0124ea6052..5bc695b010 100644 --- a/R/guide-bins.R +++ b/R/guide-bins.R @@ -161,7 +161,7 @@ GuideBins <- ggproto( key$.show <- NA labels <- scale$get_labels(breaks) - if (is.character(scale$labels) || is.numeric(scale$labels)) { + if (is.character(scale$labels) || is.numeric(scale$labels) || is.expression(scale$labels)) { limit_lab <- c(NA, NA) } else { limit_lab <- scale$get_labels(limits) @@ -265,7 +265,7 @@ GuideBins <- ggproto( list(labels = flip_element_grob( elements$text, - label = key$.label, + label = validate_labels(key$.label), x = unit(key$.value, "npc"), margin_x = FALSE, margin_y = TRUE, diff --git a/R/scale-.R b/R/scale-.R index b8c03571bd..33752f9ec2 100644 --- a/R/scale-.R +++ b/R/scale-.R @@ -861,12 +861,9 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, labels[lengths(labels) == 0] <- "" # Make sure each element is scalar labels <- lapply(labels, `[`, 1) - - if (any(vapply(labels, is.language, logical(1)))) { - labels <- inject(expression(!!!labels)) - } else { - labels <- unlist(labels) - } + } + if (is.expression(labels)) { + labels <- as.list(labels) } labels @@ -1074,48 +1071,42 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale, return(NULL) } - if (is.null(self$labels)) { + labels <- self$labels + if (is.null(labels)) { return(NULL) } - if (identical(self$labels, NA)) { + if (identical(labels, NA)) { cli::cli_abort( "Invalid {.arg labels} specification. Use {.code NULL}, not {.code NA}.", call = self$call ) } - if (is.waiver(self$labels)) { + if (is.waiver(labels)) { if (!is.null(names(breaks))) { - return(names(breaks)) - } - if (is.numeric(breaks)) { + labels <- names(breaks) + } else if (is.numeric(breaks)) { # Only format numbers, because on Windows, format messes up encoding - format(breaks, justify = "none") + labels <- format(breaks, justify = "none") } else { - as.character(breaks) + labels <- as.character(breaks) } - } else if (is.function(self$labels)) { - self$labels(breaks) - } else { - if (!is.null(names(self$labels))) { - # If labels have names, use them to match with breaks - labels <- breaks - - map <- match(names(self$labels), labels, nomatch = 0) - labels[map] <- self$labels[map != 0] - labels - } else { - labels <- self$labels + } else if (is.function(labels)) { + labels <- labels(breaks) + } else if (!is.null(names(labels))) { + # If labels have names, use them to match with breaks + map <- match(names(self$labels), breaks, nomatch = 0) + labels <- replace(breaks, map, labels[map != 0]) + } else if (!is.null(attr(breaks, "pos"))) { + # Need to ensure that if breaks were dropped, corresponding labels are too + labels <- labels[attr(breaks, "pos")] + } - # Need to ensure that if breaks were dropped, corresponding labels are too - pos <- attr(breaks, "pos") - if (!is.null(pos)) { - labels <- labels[pos] - } - labels - } + if (is.expression(labels)) { + labels <- as.list(labels) } + labels }, clone = function(self) { @@ -1351,6 +1342,9 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, call = self$call ) } + if (is.expression(labels)) { + labels <- as.list(labels) + } labels },