New label_glue() function (#459)

NAMESPACE

@@ -121,6 +121,7 @@ export(label_currency)
 export(label_date)
 export(label_date_short)
 export(label_dollar)
+export(label_glue)
 export(label_log)
 export(label_math)
 export(label_number)

NEWS.md

@@ -1,4 +1,5 @@
 # scales (development version)
+* New `label_glue()` labelling function for interpolated strings (#457).
 * `fullseq()` and by extension `breaks_width()` can now deal with unsorted 
   ranges (#435).
 * New `label_date_short(leading)` argument to replace leading zeroes (#442)

R/label-glue.R

@@ -0,0 +1,39 @@
+#' Interpolated labels
+#'
+#' Use `label_glue()` to perform string interpolation using the \pkg{glue}
+#' package. Enclosed expressions will be evaluated as R code.
+#'
+#' @param pattern A glue string used for formatting. The `x` variable holds the
+#'   breaks, so that `"{x}"` (default) returns the breaks as-is.
+#' @param ... Arguments passed on to [`glue::glue()`].
+#' @param parse Whether to return labels as expressions.
+#' @inheritParams glue::glue
+#'
+#' @return A labeller function that takes a vector of breaks and returns a
+#'   character vector of labels.
+#' @export
+#' @family labels for continuous scales
+#' @family labels for discrete scales
+#'
+#' @examples
+#' # Example variables
+#' animal  <- "penguin"
+#' species <- c("Adelie",  "Chinstrap", "Emperor", "Gentoo")
+#'
+#' # Typical use, note that {x} will become the breaks
+#' demo_discrete(species, labels = label_glue("The {x}\n{animal}"))
+#' # It adapts to the breaks that are present
+#' demo_discrete(species[-3], labels =  label_glue("The {x}\n{animal}"))
+#' # Contrary to directly glueing species + animal, which results in mislabelling!
+#' demo_discrete(species[-3], labels = glue::glue("The {species}\n{animal}"))
+label_glue <- function(pattern = "{x}", ..., parse = FALSE, .envir = caller_env()) {
+  args <- list2(...)
+  force_all(pattern, parse, .envir)
+  function(x) {
+    x <- inject(glue::glue_data(list(x = x), pattern, !!!args, .envir = .envir))
+    if (parse) {
+      x <- parse_safe(x)
+    }
+    x
+  }
+}

tests/testthat/test-label-glue.R

@@ -0,0 +1,10 @@
+test_that("label_glue environments work out as intended", {
+
+  x <- LETTERS[1:3]
+  y <- "foo"
+
+  # Note `{x}` should mask the `x <- LETTERS[1:3]` above
+  f <- label_glue("{x} and {y}")
+  expect_equal(f(letters[1:3]), c("a and foo", "b and foo", "c and foo"))
+
+})