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

‎R/scale-continuous.R

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -159,11 +159,11 @@ ScaleContinuousPosition <- ggproto("ScaleContinuousPosition", ScaleContinuous,
159159
self$secondary.axis$name
160160
}
161161
},
162-
make_sec_title = function(self, title) {
162+
make_sec_title = function(self, ...) {
163163
if (!is.waiver(self$secondary.axis)) {
164-
self$secondary.axis$make_title(title)
164+
self$secondary.axis$make_title(...)
165165
} else {
166-
ggproto_parent(ScaleContinuous, self)$make_sec_title(title)
166+
ggproto_parent(ScaleContinuous, self)$make_sec_title(...)
167167
}
168168
}
169169
)

‎R/scale-date.R

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -392,11 +392,11 @@ ScaleContinuousDatetime <- ggproto("ScaleContinuousDatetime", ScaleContinuous,
392392
self$secondary.axis$name
393393
}
394394
},
395-
make_sec_title = function(self, title) {
395+
make_sec_title = function(self, ...) {
396396
if (!is.waiver(self$secondary.axis)) {
397-
self$secondary.axis$make_title(title)
397+
self$secondary.axis$make_title(...)
398398
} else {
399-
ggproto_parent(ScaleContinuous, self)$make_sec_title(title)
399+
ggproto_parent(ScaleContinuous, self)$make_sec_title(...)
400400
}
401401
}
402402

@@ -443,11 +443,11 @@ ScaleContinuousDate <- ggproto("ScaleContinuousDate", ScaleContinuous,
443443
self$secondary.axis$name
444444
}
445445
},
446-
make_sec_title = function(self, title) {
446+
make_sec_title = function(self, ...) {
447447
if (!is.waiver(self$secondary.axis)) {
448-
self$secondary.axis$make_title(title)
448+
self$secondary.axis$make_title(...)
449449
} else {
450-
ggproto_parent(ScaleContinuous, self)$make_sec_title(title)
450+
ggproto_parent(ScaleContinuous, self)$make_sec_title(...)
451451
}
452452
}
453453
)

‎R/scale-view.R

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -76,7 +76,7 @@ view_scale_secondary <- function(scale, limits = scale$get_limits(),
7676
# different breaks and labels in a different data space
7777
aesthetics = scale$aesthetics,
7878
name = scale$sec_name(),
79-
make_title = function(self, title) self$scale$make_sec_title(title),
79+
make_title = function(self, ...) self$scale$make_sec_title(...),
8080
continuous_range = sort(continuous_range),
8181
dimension = function(self) self$break_info$range,
8282
get_limits = function(self) self$break_info$range,
@@ -127,8 +127,8 @@ ViewScale <- ggproto("ViewScale", NULL,
127127
x
128128
}
129129
},
130-
make_title = function(self, title) {
131-
self$scale$make_title(title)
130+
make_title = function(self, ...) {
131+
self$scale$make_title(...)
132132
},
133133
mapped_breaks = function(self) {
134134
self$map(self$get_breaks())

‎tests/testthat/test-labels.R

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -199,6 +199,29 @@ test_that("position axis label hierarchy works as intended", {
199199
)
200200
})
201201

202+
test_that("labels can be derived using functions", {
203+
204+
p <- ggplot(mtcars, aes(disp, mpg, colour = drat, shape = factor(cyl))) +
205+
geom_point() +
206+
labs(
207+
y = to_upper_ascii,
208+
shape = function(x) gsub("factor", "foo", x)
209+
) +
210+
scale_shape_discrete(
211+
name = to_upper_ascii,
212+
guide = guide_legend(title = function(x) paste0(x, "!!!"))
213+
) +
214+
scale_x_continuous(name = to_upper_ascii) +
215+
guides(colour = guide_colourbar(title = to_upper_ascii))
216+
217+
labs <- get_labs(p)
218+
expect_equal(labs$shape, "FOO(CYL)!!!")
219+
expect_equal(labs$colour, "DRAT")
220+
expect_equal(labs$x, "DISP")
221+
expect_equal(labs$y, "MPG")
222+
223+
})
224+
202225
test_that("moving guide positions lets titles follow", {
203226
df <- data_frame(foo = c(1e1, 1e5), bar = c(0, 100))
204227

0 commit comments

Comments
 (0)