Skip to content

Commit 212224d

Browse files
teunbrandteunbrand
authored
Scale name function (#6200)
* `Scale$make_title()` can uses functions * Disentangle `Layout$resolve_label()` * pre-resolve functions in `labs()` * rework how guides make titles * add test * add news bullet
1 parent 4b887b7 commit 212224d

14 files changed

+95
-46
lines changed

‎NEWS.md

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,7 @@
11
# ggplot2 (development version)
22

3+
* Scale names, guide titles and aesthetic labels can now accept functions
4+
(@teunbrand, #4313)
35
* Binned scales with zero-width data expand the default limits by 0.1
46
(@teunbrand, #5066)
57
* New default `geom_qq_line(geom = "abline")` for better clipping in the

‎R/axis-secondary.R

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -329,7 +329,7 @@ AxisSecondary <- ggproto("AxisSecondary", NULL,
329329
scale$train(range)
330330
scale
331331
},
332-
make_title = function(title) {
333-
title
332+
make_title = function(...) {
333+
ScaleContinuous$make_title(...)
334334
}
335335
)

‎R/guide-bins.R

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -218,7 +218,7 @@ GuideBins <- ggproto(
218218
key$.value <- 1 - key$.value
219219
}
220220

221-
params$title <- scale$make_title(params$title %|W|% scale$name %|W|% title)
221+
params$title <- scale$make_title(params$title, scale$name, title)
222222
params$key <- key
223223
params
224224
},

‎R/guide-colorbar.R

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -259,7 +259,7 @@ GuideColourbar <- ggproto(
259259

260260
extract_params = function(scale, params,
261261
title = waiver(), ...) {
262-
params$title <- scale$make_title(params$title %|W|% scale$name %|W|% title)
262+
params$title <- scale$make_title(params$title, scale$name, title)
263263
limits <- params$decor$value[c(1L, nrow(params$decor))]
264264
to <- switch(
265265
params$display,

‎R/guide-colorsteps.R

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -191,9 +191,7 @@ GuideColoursteps <- ggproto(
191191
params$key <- key
192192
}
193193

194-
params$title <- scale$make_title(
195-
params$title %|W|% scale$name %|W|% title
196-
)
194+
params$title <- scale$make_title(params$title, scale$name, title)
197195

198196
limits <- c(params$decor$min[1], params$decor$max[nrow(params$decor)])
199197
if (params$reverse) {

‎R/guide-legend.R

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -185,7 +185,7 @@ GuideLegend <- ggproto(
185185

186186
extract_params = function(scale, params,
187187
title = waiver(), ...) {
188-
params$title <- scale$make_title(params$title %|W|% scale$name %|W|% title)
188+
params$title <- scale$make_title(params$title, scale$name, title)
189189
if (isTRUE(params$reverse %||% FALSE)) {
190190
params$key <- params$key[nrow(params$key):1, , drop = FALSE]
191191
}

‎R/guide-old.R

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -89,7 +89,7 @@ GuideOld <- ggproto(
8989

9090
train = function(self, params, scale, aesthetic = NULL,
9191
title = waiver(), direction = NULL) {
92-
params$title <- scale$make_title(params$title %|W|% scale$name %|W|% title)
92+
params$title <- scale$make_title(params$title, scale$name, title)
9393
params$direction <- params$direction %||% direction %||% "vertical"
9494
params <- guide_train(params, scale, aesthetic)
9595
params

‎R/labels.R

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -84,6 +84,15 @@ setup_plot_labels <- function(plot, layers, data) {
8484
))
8585
}
8686

87+
# User labels can be functions, so apply these to the default labels
88+
plot_labels <- lapply(setNames(nm = names(plot_labels)), function(nm) {
89+
label <- plot_labels[[nm]]
90+
if (!is.function(label)) {
91+
return(label)
92+
}
93+
label(labels[[nm]] %||% "")
94+
})
95+
8796
dict <- plot_labels$dictionary
8897
if (length(dict) > 0) {
8998
labels <- lapply(labels, function(x) {

‎R/layout.R

Lines changed: 26 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -244,35 +244,39 @@ Layout <- ggproto("Layout", NULL,
244244
},
245245

246246
resolve_label = function(self, scale, labels) {
247-
# General order is: guide title > scale name > labels
248-
aes <- scale$aesthetics[[1]]
249-
primary <- scale$name %|W|% labels[[aes]]
250-
secondary <- if (is.null(scale$secondary.axis)) {
251-
waiver()
252-
} else {
253-
scale$sec_name()
254-
} %|W|% labels[[paste0("sec.", aes)]]
255-
if (is.derived(secondary)) secondary <- primary
247+
aes <- scale$aesthetics[[1]]
248+
249+
prim_scale <- scale$name
250+
seco_scale <- (scale$sec_name %||% waiver)()
251+
252+
prim_label <- labels[[aes]]
253+
seco_label <- labels[[paste0("sec. aes")]]
254+
255+
prim_guide <- seco_guide <- waiver()
256+
256257
order <- scale$axis_order()
257258

258-
if (!is.null(self$panel_params[[1]]$guides)) {
259-
if ((scale$position) %in% c("left", "right")) {
260-
guides <- c("y", "y.sec")
261-
} else {
262-
guides <- c("x", "x.sec")
263-
}
264-
params <- self$panel_params[[1]]$guides$get_params(guides)
259+
panel <- self$panel_params[[1]]$guides
260+
if (!is.null(panel)) {
261+
position <- scale$position
262+
aes <- switch(position, left = , right = "y", "x")
263+
params <- panel$get_params(paste0(aes, c("", ".sec")))
265264
if (!is.null(params)) {
266-
primary <- params[[1]]$title %|W|% primary
267-
secondary <- params[[2]]$title %|W|% secondary
268-
position <- params[[1]]$position %||% scale$position
269-
if (position != scale$position) {
265+
prim_guide <- params[[1]]$title
266+
seco_guide <- params[[2]]$title
267+
position <- scale$position
268+
if ((params[[1]]$position %||% position) != position) {
270269
order <- rev(order)
271270
}
272271
}
273272
}
274-
primary <- scale$make_title(primary)
275-
secondary <- scale$make_sec_title(secondary)
273+
274+
primary <- scale$make_title(prim_guide, prim_scale, prim_label)
275+
secondary <- scale$make_sec_title(seco_guide, seco_scale, seco_label)
276+
if (is.derived(secondary)) {
277+
secondary <- primary
278+
}
279+
276280
list(primary = primary, secondary = secondary)[order]
277281
},
278282

‎R/scale-.R

Lines changed: 16 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -612,12 +612,25 @@ Scale <- ggproto("Scale", NULL,
612612
ord
613613
},
614614

615-
make_title = function(title) {
615+
make_title = function(self, guide_title = waiver(), scale_title = waiver(), label_title = waiver()) {
616+
title <- label_title
617+
scale_title <- allow_lambda(scale_title)
618+
if (is.function(scale_title)) {
619+
title <- scale_title(title)
620+
} else {
621+
title <- scale_title %|W|% title
622+
}
623+
guide_title <- allow_lambda(guide_title)
624+
if (is.function(guide_title)) {
625+
title <- guide_title(title)
626+
} else {
627+
title <- guide_title %|W|% title
628+
}
616629
title
617630
},
618631

619-
make_sec_title = function(title) {
620-
title
632+
make_sec_title = function(self, ...) {
633+
self$make_title(...)
621634
}
622635
)
623636

0 commit comments

Comments
 (0)