From 855c65c616aa6061de074ae95b26328fa5c84ff6 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Mon, 25 Nov 2024 11:30:41 +0100
Subject: [PATCH 1/6] `Scale$make_title()` can uses functions

---
 R/axis-secondary.R   |  4 ++--
 R/scale-.R           | 21 ++++++++++++++++++---
 R/scale-continuous.R |  6 +++---
 R/scale-date.R       | 12 ++++++------
 R/scale-view.R       |  6 +++---
 5 files changed, 32 insertions(+), 17 deletions(-)

diff --git a/R/axis-secondary.R b/R/axis-secondary.R
index 23d36092b6..c1d024e288 100644
--- a/R/axis-secondary.R
+++ b/R/axis-secondary.R
@@ -329,7 +329,7 @@ AxisSecondary <- ggproto("AxisSecondary", NULL,
     scale$train(range)
     scale
   },
-  make_title = function(title) {
-    title
+  make_title = function(...) {
+    ScaleContinuous$make_title(...)
   }
 )
diff --git a/R/scale-.R b/R/scale-.R
index b8c03571bd..1966eed6dc 100644
--- a/R/scale-.R
+++ b/R/scale-.R
@@ -604,12 +604,27 @@ Scale <- ggproto("Scale", NULL,
     ord
   },
 
-  make_title = function(title) {
+  make_title = function(self, guide_title = waiver(), scale_title = waiver(), label_title = waiver()) {
+    title <- allow_lambda(label_title)
+    title <- if (is.function(title)) title() else title
+
+    scale_title <- allow_lambda(scale_title)
+    if (is.function(scale_title)) {
+      title <- scale_title(title)
+    } else {
+      title <- scale_title %|W|% title
+    }
+    guide_title <- allow_lambda(guide_title)
+    if (is.function(guide_title)) {
+      title <- guide_title(title)
+    } else {
+      title <- guide_title %|W|% title
+    }
     title
   },
 
-  make_sec_title = function(title) {
-    title
+  make_sec_title = function(self, ...) {
+    self$make_title(...)
   }
 )
 
diff --git a/R/scale-continuous.R b/R/scale-continuous.R
index 39b5203565..8a681c2f20 100644
--- a/R/scale-continuous.R
+++ b/R/scale-continuous.R
@@ -159,11 +159,11 @@ ScaleContinuousPosition <- ggproto("ScaleContinuousPosition", ScaleContinuous,
       self$secondary.axis$name
     }
   },
-  make_sec_title = function(self, title) {
+  make_sec_title = function(self, ...) {
     if (!is.waiver(self$secondary.axis)) {
-      self$secondary.axis$make_title(title)
+      self$secondary.axis$make_title(...)
     } else {
-      ggproto_parent(ScaleContinuous, self)$make_sec_title(title)
+      ggproto_parent(ScaleContinuous, self)$make_sec_title(...)
     }
   }
 )
diff --git a/R/scale-date.R b/R/scale-date.R
index 436b9b129d..dff564e71e 100644
--- a/R/scale-date.R
+++ b/R/scale-date.R
@@ -392,11 +392,11 @@ ScaleContinuousDatetime <- ggproto("ScaleContinuousDatetime", ScaleContinuous,
       self$secondary.axis$name
     }
   },
-  make_sec_title = function(self, title) {
+  make_sec_title = function(self, ...) {
     if (!is.waiver(self$secondary.axis)) {
-      self$secondary.axis$make_title(title)
+      self$secondary.axis$make_title(...)
     } else {
-      ggproto_parent(ScaleContinuous, self)$make_sec_title(title)
+      ggproto_parent(ScaleContinuous, self)$make_sec_title(...)
     }
   }
 
@@ -443,11 +443,11 @@ ScaleContinuousDate <- ggproto("ScaleContinuousDate", ScaleContinuous,
       self$secondary.axis$name
     }
   },
-  make_sec_title = function(self, title) {
+  make_sec_title = function(self, ...) {
     if (!is.waiver(self$secondary.axis)) {
-      self$secondary.axis$make_title(title)
+      self$secondary.axis$make_title(...)
     } else {
-      ggproto_parent(ScaleContinuous, self)$make_sec_title(title)
+      ggproto_parent(ScaleContinuous, self)$make_sec_title(...)
     }
   }
 )
diff --git a/R/scale-view.R b/R/scale-view.R
index 510f99f837..87afadb52f 100644
--- a/R/scale-view.R
+++ b/R/scale-view.R
@@ -76,7 +76,7 @@ view_scale_secondary <- function(scale, limits = scale$get_limits(),
       # different breaks and labels in a different data space
       aesthetics = scale$aesthetics,
       name = scale$sec_name(),
-      make_title = function(self, title) self$scale$make_sec_title(title),
+      make_title = function(self, ...) self$scale$make_sec_title(...),
       continuous_range = sort(continuous_range),
       dimension = function(self) self$break_info$range,
       get_limits = function(self) self$break_info$range,
@@ -124,8 +124,8 @@ ViewScale <- ggproto("ViewScale", NULL,
       x
     }
   },
-  make_title = function(self, title) {
-    self$scale$make_title(title)
+  make_title = function(self, ...) {
+    self$scale$make_title(...)
   },
   break_positions = function(self) {
     self$rescale(self$get_breaks())

From dc6c5cb502cfeaf92c508b921772d956ee4292ff Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Mon, 25 Nov 2024 13:58:20 +0100
Subject: [PATCH 2/6] Disentangle `Layout$resolve_label()`

---
 R/layout.R | 48 ++++++++++++++++++++++++++----------------------
 1 file changed, 26 insertions(+), 22 deletions(-)

diff --git a/R/layout.R b/R/layout.R
index 25088798b1..0a1821a1cb 100644
--- a/R/layout.R
+++ b/R/layout.R
@@ -243,35 +243,39 @@ Layout <- ggproto("Layout", NULL,
   },
 
   resolve_label = function(self, scale, labels) {
-    # General order is: guide title > scale name > labels
-    aes       <- scale$aesthetics[[1]]
-    primary   <- scale$name %|W|% labels[[aes]]
-    secondary <- if (is.null(scale$secondary.axis)) {
-      waiver()
-    } else {
-      scale$sec_name()
-    } %|W|% labels[[paste0("sec.", aes)]]
-    if (is.derived(secondary)) secondary <- primary
+    aes <- scale$aesthetics[[1]]
+
+    prim_scale <- scale$name
+    seco_scale <- (scale$sec_name %||% waiver)()
+
+    prim_label <- labels[[aes]]
+    seco_label <- labels[[paste0("sec. aes")]]
+
+    prim_guide <- seco_guide <- waiver()
+
     order <- scale$axis_order()
 
-    if (!is.null(self$panel_params[[1]]$guides)) {
-      if ((scale$position) %in% c("left", "right")) {
-        guides <- c("y", "y.sec")
-      } else {
-        guides <- c("x", "x.sec")
-      }
-      params    <- self$panel_params[[1]]$guides$get_params(guides)
+    panel <- self$panel_params[[1]]$guides
+    if (!is.null(panel)) {
+      position <- scale$position
+      aes <- switch(position, left = , right = "y", "x")
+      params <- panel$get_params(paste0(aes, c("", ".sec")))
       if (!is.null(params)) {
-        primary   <- params[[1]]$title %|W|% primary
-        secondary <- params[[2]]$title %|W|% secondary
-        position  <- params[[1]]$position %||% scale$position
-        if (position != scale$position) {
+        prim_guide <- params[[1]]$title
+        seco_guide <- params[[2]]$title
+        position   <- scale$position
+        if ((params[[1]]$position %||% position) != position) {
           order <- rev(order)
         }
       }
     }
-    primary   <- scale$make_title(primary)
-    secondary <- scale$make_sec_title(secondary)
+
+    primary   <- scale$make_title(prim_guide, prim_scale, prim_label)
+    secondary <- scale$make_sec_title(seco_guide, seco_scale, seco_label)
+    if (is.derived(secondary)) {
+      secondary <- primary
+    }
+
     list(primary = primary, secondary = secondary)[order]
   },
 

From c15fe4c38b1dec64709d1cfeca8236ba27ddfde4 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Mon, 25 Nov 2024 14:08:47 +0100
Subject: [PATCH 3/6] pre-resolve functions in `labs()`

---
 R/labels.R | 9 +++++++++
 R/scale-.R | 4 +---
 2 files changed, 10 insertions(+), 3 deletions(-)

diff --git a/R/labels.R b/R/labels.R
index 050d42829e..37761bfa41 100644
--- a/R/labels.R
+++ b/R/labels.R
@@ -84,6 +84,15 @@ setup_plot_labels <- function(plot, layers, data) {
     ))
   }
 
+  # User labels can be functions, so apply these to the default labels
+  plot_labels <- lapply(setNames(nm = names(plot_labels)), function(nm) {
+    label <- plot_labels[[nm]]
+    if (!is.function(label)) {
+      return(label)
+    }
+    label(labels[[nm]] %||% "")
+  })
+
   defaults(plot_labels, labels)
 }
 
diff --git a/R/scale-.R b/R/scale-.R
index 1966eed6dc..6a4e2e849f 100644
--- a/R/scale-.R
+++ b/R/scale-.R
@@ -605,9 +605,7 @@ Scale <- ggproto("Scale", NULL,
   },
 
   make_title = function(self, guide_title = waiver(), scale_title = waiver(), label_title = waiver()) {
-    title <- allow_lambda(label_title)
-    title <- if (is.function(title)) title() else title
-
+    title <- label_title
     scale_title <- allow_lambda(scale_title)
     if (is.function(scale_title)) {
       title <- scale_title(title)

From cd30442c53f7a071700bf4c543a9fd24f006d343 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Mon, 25 Nov 2024 14:31:48 +0100
Subject: [PATCH 4/6] rework how guides make titles

---
 R/guide-bins.R       | 2 +-
 R/guide-colorbar.R   | 2 +-
 R/guide-colorsteps.R | 4 +---
 R/guide-legend.R     | 2 +-
 R/guide-old.R        | 2 +-
 5 files changed, 5 insertions(+), 7 deletions(-)

diff --git a/R/guide-bins.R b/R/guide-bins.R
index 0124ea6052..29ff1d4565 100644
--- a/R/guide-bins.R
+++ b/R/guide-bins.R
@@ -212,7 +212,7 @@ GuideBins <- ggproto(
       key$.value <- 1 - key$.value
     }
 
-    params$title <- scale$make_title(params$title %|W|% scale$name %|W|% title)
+    params$title <- scale$make_title(params$title, scale$name, title)
     params$key <- key
     params
   },
diff --git a/R/guide-colorbar.R b/R/guide-colorbar.R
index c7c424c2ac..287b0087b8 100644
--- a/R/guide-colorbar.R
+++ b/R/guide-colorbar.R
@@ -259,7 +259,7 @@ GuideColourbar <- ggproto(
 
   extract_params = function(scale, params,
                             title  = waiver(), ...) {
-    params$title <- scale$make_title(params$title %|W|% scale$name %|W|% title)
+    params$title <- scale$make_title(params$title, scale$name, title)
     limits <- params$decor$value[c(1L, nrow(params$decor))]
     to <- switch(
       params$display,
diff --git a/R/guide-colorsteps.R b/R/guide-colorsteps.R
index 54cd89a948..0fb5f8864a 100644
--- a/R/guide-colorsteps.R
+++ b/R/guide-colorsteps.R
@@ -189,9 +189,7 @@ GuideColoursteps <- ggproto(
       params$key <- key
     }
 
-    params$title <- scale$make_title(
-      params$title %|W|% scale$name %|W|% title
-    )
+    params$title <- scale$make_title(params$title, scale$name, title)
 
     limits <- c(params$decor$min[1], params$decor$max[nrow(params$decor)])
     if (params$reverse) {
diff --git a/R/guide-legend.R b/R/guide-legend.R
index 37aad2e3f0..9355ae5a70 100644
--- a/R/guide-legend.R
+++ b/R/guide-legend.R
@@ -185,7 +185,7 @@ GuideLegend <- ggproto(
 
   extract_params = function(scale, params,
                             title = waiver(), ...) {
-    params$title <- scale$make_title(params$title %|W|% scale$name %|W|% title)
+    params$title <- scale$make_title(params$title, scale$name, title)
     if (isTRUE(params$reverse %||% FALSE)) {
       params$key <- params$key[nrow(params$key):1, , drop = FALSE]
     }
diff --git a/R/guide-old.R b/R/guide-old.R
index de870965fd..d20fec0e3e 100644
--- a/R/guide-old.R
+++ b/R/guide-old.R
@@ -89,7 +89,7 @@ GuideOld <- ggproto(
 
   train = function(self, params, scale, aesthetic = NULL,
                    title = waiver(), direction = NULL) {
-    params$title <- scale$make_title(params$title %|W|% scale$name %|W|% title)
+    params$title <- scale$make_title(params$title, scale$name, title)
     params$direction <- params$direction %||% direction %||% "vertical"
     params <- guide_train(params, scale, aesthetic)
     params

From f3a4f5b83b54cd8f420676b8940c74bc8d606c85 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Mon, 25 Nov 2024 14:35:30 +0100
Subject: [PATCH 5/6] add test

---
 tests/testthat/test-labels.R | 23 +++++++++++++++++++++++
 1 file changed, 23 insertions(+)

diff --git a/tests/testthat/test-labels.R b/tests/testthat/test-labels.R
index b8b002a3db..98b39bca18 100644
--- a/tests/testthat/test-labels.R
+++ b/tests/testthat/test-labels.R
@@ -199,6 +199,29 @@ test_that("position axis label hierarchy works as intended", {
   )
 })
 
+test_that("labels can be derived using functions", {
+
+  p <- ggplot(mtcars, aes(disp, mpg, colour = drat, shape = factor(cyl))) +
+    geom_point() +
+    labs(
+      y = to_upper_ascii,
+      shape = function(x) gsub("factor", "foo", x)
+    ) +
+    scale_shape_discrete(
+      name = to_upper_ascii,
+      guide = guide_legend(title = function(x) paste0(x, "!!!"))
+    ) +
+    scale_x_continuous(name = to_upper_ascii) +
+    guides(colour = guide_colourbar(title = to_upper_ascii))
+
+  labs <- get_labs(p)
+  expect_equal(labs$shape,  "FOO(CYL)!!!")
+  expect_equal(labs$colour, "DRAT")
+  expect_equal(labs$x,      "DISP")
+  expect_equal(labs$y,      "MPG")
+
+})
+
 test_that("moving guide positions lets titles follow", {
   df <- data_frame(foo = c(1e1, 1e5), bar = c(0, 100))
 

From 627e25a33d9552abdfa6ea6f6dd02af949b16f68 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Mon, 25 Nov 2024 14:38:24 +0100
Subject: [PATCH 6/6] add news bullet

---
 NEWS.md | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/NEWS.md b/NEWS.md
index 0c493a8f58..5e36fb6f05 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,7 @@
 # ggplot2 (development version)
 
+* Scale names, guide titles and aesthetic labels can now accept functions 
+  (@teunbrand, #4313)
 * Custom and raster annotation now respond to scale transformations, and can
   use AsIs variables for relative placement (@teunbrand based on 
   @yutannihilation's prior work, #3120)