Label dictionary (#6077)

* first implementation of `labs(dict)`

* add test

* add news bullet

* rename dict --> dictionary

* `revalue` was removed

Author: teunbrand

NEWS.md

@@ -1,5 +1,7 @@
 # ggplot2 (development version)
 
+* New argument `labs(dictionary)` to label based on variable name rather than 
+  based on aesthetic (@teunbrand, #5178)
 * Fixed bug in out-of-bounds binned breaks (@teunbrand, #6054)
 * Binned guides now accept expressions as labels (@teunbrand, #6005)
 * (internal) `Scale$get_labels()` format expressions as lists.

R/labels.R

@@ -84,6 +84,15 @@ setup_plot_labels <- function(plot, layers, data) {
     ))
   }
 
+  dict <- plot_labels$dictionary
+  if (length(dict) > 0) {
+    labels <- lapply(labels, function(x) {
+      dict <- dict[names(dict) %in% x]
+      x[match(names(dict), x)] <- dict
+      x
+    })
+  }
+
   defaults(plot_labels, labels)
 }
 
@@ -114,6 +123,10 @@ setup_plot_labels <- function(plot, layers, data) {
 #'        bottom-right of the plot by default.
 #' @param tag The text for the tag label which will be displayed at the
 #'        top-left of the plot by default.
+#' @param dictionary A named character vector to serve as dictionary.
+#'        Automatically derived labels, such as those based on variables will
+#'        be matched with `names(dictionary)` and replaced by the matching
+#'        entry in `dictionary`.
 #' @param alt,alt_insight Text used for the generation of alt-text for the plot.
 #'        See [get_alt_text] for examples. `alt` can also be a function that
 #'        takes the plot as input and returns text as output. `alt` also accepts
@@ -128,6 +141,14 @@ setup_plot_labels <- function(plot, layers, data) {
 #' p + labs(colour = "Cylinders")
 #' p + labs(x = "New x label")
 #'
+#' # Set labels by variable name instead of aesthetic
+#' p + labs(dict = c(
+#'   disp = "Displacment", # Not in use
+#'   cyl  = "Number of cylinders",
+#'   mpg  = "Miles per gallon",
+#'   wt   = "Weight (1000 lbs)"
+#' ))
+#'
 #' # The plot title appears at the top-left, with the subtitle
 #' # display in smaller text underneath it
 #' p + labs(title = "New plot title")
@@ -146,11 +167,12 @@ setup_plot_labels <- function(plot, layers, data) {
 #'  labs(title = "title") +
 #'  labs(title = NULL)
 labs <- function(..., title = waiver(), subtitle = waiver(), caption = waiver(),
-                 tag = waiver(), alt = waiver(), alt_insight = waiver()) {
+                 tag = waiver(), dictionary = waiver(), alt = waiver(),
+                 alt_insight = waiver()) {
   # .ignore_empty = "all" is needed to allow trailing commas, which is NOT a trailing comma for dots_list() as it's in ...
   args <- dots_list(..., title = title, subtitle = subtitle, caption = caption,
     tag = tag, alt = allow_lambda(alt), alt_insight = alt_insight,
-    .ignore_empty = "all")
+    dictionary = dictionary, .ignore_empty = "all")
 
   is_waive <- vapply(args, is.waiver, logical(1))
   args <- args[!is_waive]

man/labs.Rd

@@ -246,6 +246,31 @@ test_that("moving guide positions lets titles follow", {
   expect_identical(labs[names(expect)], expect)
 })
 
+test_that("label dictionaries work", {
+
+  p <- ggplot(mtcars, aes(disp, mpg, shape = factor(cyl), size = drat)) +
+    geom_point() +
+    labs(dictionary = c(
+      disp = "Displacement",
+      mpg  = "Miles per gallon",
+      `factor(cyl)` = "Number of cylinders",
+      drat = "Rear axle ratio"
+    ))
+  p <- ggplot_build(p)
+
+  x <- p$layout$resolve_label(p$layout$panel_scales_x[[1]], p$plot$labels)
+  expect_equal(x$primary, "Displacement")
+
+  y <- p$layout$resolve_label(p$layout$panel_scales_y[[1]], p$plot$labels)
+  expect_equal(y$primary, "Miles per gallon")
+
+  shape <- p$plot$guides$get_params("shape")$title
+  expect_equal(shape, "Number of cylinders")
+
+  size <- p$plot$guides$get_params("size")$title
+  expect_equal(size, "Rear axle ratio")
+})
+
 # Visual tests ------------------------------------------------------------
 
 test_that("tags are drawn correctly", {