Skip to content

Commit 1bb9230

Browse files
teunbrandteunbrand
authored
Scale palettes from theme (#5946)
* add palette theme elements * set palettes * expand options for numeric palettes * backward compatibility for `options()` default scales * use explicit scales in tests * standard colour scales have `palette = NULL` * document * properly document this time * misc fixes * more palettes in theme * use binned versions of discrete palettes for continuous linetype/shape * Set default palettes to `NULL` * tweak test to populate palettes * try registered theme palettes * document * remove redundant call to `plot_theme()` * simplify `fallback_palette()` args * Put in shims for scales/#427 * Streamline `ScalesList$set_palettes()` method * try to match first non-null aesthetic * add news bullet
1 parent f13d9ab commit 1bb9230

26 files changed

+427
-217
lines changed

‎NEWS.md

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -215,6 +215,9 @@
215215
* Added `keep.zeroes` argument to `stat_bin()` (@teunbrand, #3449)
216216
* `coord_sf()` no longer errors when dealing with empty graticules (@teunbrand, #6052)
217217
* Added `theme_transparent()` with transparent backgrounds (@topepo).
218+
* New theme elements `palette.{aes}.discrete` and `palette.{aes}.continuous`.
219+
Theme palettes replace palettes in scales where `palette = NULL`, which is
220+
the new default in many scales (@teunbrand, #4696).
218221

219222
# ggplot2 3.5.1
220223

‎R/geom-text.R

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -95,7 +95,7 @@
9595
#' # Add aesthetic mappings
9696
#' p + geom_text(aes(colour = factor(cyl)))
9797
#' p + geom_text(aes(colour = factor(cyl))) +
98-
#' scale_colour_discrete(l = 40)
98+
#' scale_colour_hue(l = 40)
9999
#' p + geom_label(aes(fill = factor(cyl)), colour = "white", fontface = "bold")
100100
#'
101101
#' # Scale size of text, and change legend key glyph from a to point

‎R/plot-build.R

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -106,6 +106,7 @@ ggplot_build.ggplot <- function(plot) {
106106
# Train and map non-position scales and guides
107107
npscales <- scales$non_position_scales()
108108
if (npscales$n() > 0) {
109+
npscales$set_palettes(plot$theme)
109110
lapply(data, npscales$train_df)
110111
plot$guides <- plot$guides$build(npscales, plot$layers, plot$labels, data, plot$theme)
111112
data <- lapply(data, npscales$map_df)

‎R/scale-.R

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -528,6 +528,7 @@ Scale <- ggproto("Scale", NULL,
528528
if (empty(df)) {
529529
return()
530530
}
531+
self$palette <- self$palette %||% fallback_palette(self)
531532

532533
aesthetics <- intersect(self$aesthetics, names(df))
533534
names(aesthetics) <- aesthetics

‎R/scale-alpha.R

Lines changed: 19 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -31,8 +31,9 @@
3131
#'
3232
#' # Changing the title
3333
#' p + scale_alpha("cylinders")
34-
scale_alpha <- function(name = waiver(), ..., range = c(0.1, 1)) {
35-
continuous_scale("alpha", name = name, palette = pal_rescale(range), ...)
34+
scale_alpha <- function(name = waiver(), ..., range = NULL) {
35+
palette <- if (!is.null(range)) pal_rescale(range) else NULL
36+
continuous_scale("alpha", name = name, palette = palette, ...)
3637
}
3738

3839
#' @rdname scale_alpha
@@ -41,8 +42,9 @@ scale_alpha_continuous <- scale_alpha
4142

4243
#' @rdname scale_alpha
4344
#' @export
44-
scale_alpha_binned <- function(name = waiver(), ..., range = c(0.1, 1)) {
45-
binned_scale("alpha", name = name, palette = pal_rescale(range), ...)
45+
scale_alpha_binned <- function(name = waiver(), ..., range = NULL) {
46+
palette <- if (!is.null(range)) pal_rescale(range) else NULL
47+
binned_scale("alpha", name = name, palette = palette, ...)
4648
}
4749

4850
#' @rdname scale_alpha
@@ -56,32 +58,33 @@ scale_alpha_discrete <- function(...) {
5658

5759
#' @rdname scale_alpha
5860
#' @export
59-
scale_alpha_ordinal <- function(name = waiver(), ..., range = c(0.1, 1)) {
60-
discrete_scale(
61-
"alpha", name = name,
62-
palette = function(n) seq(range[1], range[2], length.out = n),
63-
...
64-
)
61+
scale_alpha_ordinal <- function(name = waiver(), ..., range = NULL) {
62+
palette <- if (!is.null(range)) {
63+
function(n) seq(range[1], range[2], length.out = n)
64+
} else {
65+
NULL
66+
}
67+
discrete_scale("alpha", name = name, palette = palette, ...)
6568
}
6669

6770
#' @rdname scale_alpha
6871
#' @export
6972
#' @usage NULL
70-
scale_alpha_datetime <- function(name = waiver(), ..., range = c(0.1, 1)) {
73+
scale_alpha_datetime <- function(name = waiver(), ..., range = NULL) {
74+
palette <- if (!is.null(range)) pal_rescale(range) else NULL
7175
datetime_scale(
7276
aesthetics = "alpha", transform = "time", name = name,
73-
palette = pal_rescale(range),
74-
...
77+
palette = palette, ...
7578
)
7679
}
7780

7881
#' @rdname scale_alpha
7982
#' @export
8083
#' @usage NULL
81-
scale_alpha_date <- function(name = waiver(), ..., range = c(0.1, 1)){
84+
scale_alpha_date <- function(name = waiver(), ..., range = NULL){
85+
palette <- if (!is.null(range)) pal_rescale(range) else NULL
8286
datetime_scale(
8387
aesthetics = "alpha", transform = "date", name = name,
84-
palette = pal_rescale(range),
85-
...
88+
palette = palette, ...
8689
)
8790
}

‎R/scale-colour.R

Lines changed: 123 additions & 93 deletions
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,7 @@
2727
#' you want to manually set the colors of a scale, consider using
2828
#' [scale_colour_gradient()] or [scale_colour_steps()].
2929
#'
30+
#' @inheritParams continuous_scale
3031
#' @param ... Additional parameters passed on to the scale type
3132
#' @param type One of the following:
3233
#' * "gradient" (the default)
@@ -77,122 +78,81 @@
7778
#' v
7879
#' options(ggplot2.continuous.fill = tmp) # restore previous setting
7980
#' @export
80-
scale_colour_continuous <- function(...,
81+
scale_colour_continuous <- function(..., aesthetics = "colour",
82+
guide = "colourbar", na.value = "grey50",
8183
type = getOption("ggplot2.continuous.colour")) {
82-
type <- type %||% "gradient"
83-
args <- list2(...)
84-
args$call <- args$call %||% current_call()
8584

86-
if (is.function(type)) {
87-
if (!any(c("...", "call") %in% fn_fmls_names(type))) {
88-
args$call <- NULL
89-
}
90-
check_scale_type(exec(type, !!!args), "scale_colour_continuous", "colour")
91-
} else if (identical(type, "gradient")) {
92-
exec(scale_colour_gradient, !!!args)
93-
} else if (identical(type, "viridis")) {
94-
exec(scale_colour_viridis_c, !!!args)
95-
} else {
96-
cli::cli_abort(c(
97-
"Unknown scale type: {.val {type}}",
98-
"i" = "Use either {.val gradient} or {.val viridis}."
99-
))
85+
if (!is.null(type)) {
86+
scale <- scale_backward_compatibility(
87+
..., guide = guide, na.value = na.value, scale = type,
88+
aesthetic = "colour", type = "continuous"
89+
)
90+
return(scale)
10091
}
92+
93+
continuous_scale(
94+
aesthetics, palette = NULL, guide = guide, na.value = na.value,
95+
...
96+
)
10197
}
10298

10399
#' @rdname scale_colour_continuous
104100
#' @export
105-
scale_fill_continuous <- function(...,
101+
scale_fill_continuous <- function(..., aesthetics = "fill", guide = "colourbar",
102+
na.value = "grey50",
106103
type = getOption("ggplot2.continuous.fill")) {
107-
type <- type %||% "gradient"
108-
args <- list2(...)
109-
args$call <- args$call %||% current_call()
110104

111-
if (is.function(type)) {
112-
if (!any(c("...", "call") %in% fn_fmls_names(type))) {
113-
args$call <- NULL
114-
}
115-
check_scale_type(exec(type, !!!args), "scale_fill_continuous", "fill")
116-
} else if (identical(type, "gradient")) {
117-
exec(scale_fill_gradient, !!!args)
118-
} else if (identical(type, "viridis")) {
119-
exec(scale_fill_viridis_c, !!!args)
120-
} else {
121-
cli::cli_abort(c(
122-
"Unknown scale type: {.val {type}}",
123-
"i" = "Use either {.val gradient} or {.val viridis}."
124-
))
105+
if (!is.null(type)) {
106+
scale <- scale_backward_compatibility(
107+
..., guide = guide, na.value = na.value, scale = type,
108+
aesthetic = "fill", type = "continuous"
109+
)
110+
return(scale)
125111
}
112+
113+
continuous_scale(
114+
aesthetics, palette = NULL, guide = guide, na.value = na.value,
115+
...
116+
)
126117
}
127118

128119
#' @export
129120
#' @rdname scale_colour_continuous
130-
scale_colour_binned <- function(...,
121+
scale_colour_binned <- function(..., aesthetics = "colour", guide = "coloursteps",
122+
na.value = "grey50",
131123
type = getOption("ggplot2.binned.colour")) {
132-
args <- list2(...)
133-
args$call <- args$call %||% current_call()
134-
if (is.function(type)) {
135-
if (!any(c("...", "call") %in% fn_fmls_names(type))) {
136-
args$call <- NULL
137-
}
138-
check_scale_type(exec(type, !!!args), "scale_colour_binned", "colour")
139-
} else {
140-
type_fallback <- getOption("ggplot2.continuous.colour", default = "gradient")
141-
# don't use fallback from scale_colour_continuous() if it is
142-
# a function, since that would change the type of the color
143-
# scale from binned to continuous
144-
if (is.function(type_fallback)) {
145-
type_fallback <- "gradient"
146-
}
147-
type <- type %||% type_fallback
148-
149-
if (identical(type, "gradient")) {
150-
exec(scale_colour_steps, !!!args)
151-
} else if (identical(type, "viridis")) {
152-
exec(scale_colour_viridis_b, !!!args)
153-
} else {
154-
cli::cli_abort(c(
155-
"Unknown scale type: {.val {type}}",
156-
"i" = "Use either {.val gradient} or {.val viridis}."
157-
))
158-
}
124+
if (!is.null(type)) {
125+
scale <- scale_backward_compatibility(
126+
..., guide = guide, na.value = na.value, scale = type,
127+
aesthetic = "colour", type = "binned"
128+
)
129+
return(scale)
159130
}
131+
132+
binned_scale(
133+
aesthetics, palette = NULL, guide = guide, na.value = na.value,
134+
...
135+
)
160136
}
161137

162138
#' @export
163139
#' @rdname scale_colour_continuous
164-
scale_fill_binned <- function(...,
140+
scale_fill_binned <- function(..., aesthetics = "fill", guide = "coloursteps",
141+
na.value = "grey50",
165142
type = getOption("ggplot2.binned.fill")) {
166-
args <- list2(...)
167-
args$call <- args$call %||% current_call()
168-
if (is.function(type)) {
169-
if (!any(c("...", "call") %in% fn_fmls_names(type))) {
170-
args$call <- NULL
171-
}
172-
check_scale_type(exec(type, !!!args), "scale_fill_binned", "fill")
173-
} else {
174-
type_fallback <- getOption("ggplot2.continuous.fill", default = "gradient")
175-
# don't use fallback from scale_colour_continuous() if it is
176-
# a function, since that would change the type of the color
177-
# scale from binned to continuous
178-
if (is.function(type_fallback)) {
179-
type_fallback <- "gradient"
180-
}
181-
type <- type %||% type_fallback
182-
183-
if (identical(type, "gradient")) {
184-
exec(scale_fill_steps, !!!args)
185-
} else if (identical(type, "viridis")) {
186-
exec(scale_fill_viridis_b, !!!args)
187-
} else {
188-
cli::cli_abort(c(
189-
"Unknown scale type: {.val {type}}",
190-
"i" = "Use either {.val gradient} or {.val viridis}."
191-
))
192-
}
143+
if (!is.null(type)) {
144+
scale <- scale_backward_compatibility(
145+
..., guide = guide, na.value = na.value, scale = type,
146+
aesthetic = "fill", type = "binned"
147+
)
148+
return(scale)
193149
}
194-
}
195150

151+
binned_scale(
152+
aesthetics, palette = NULL, guide = guide, na.value = na.value,
153+
...
154+
)
155+
}
196156

197157
# helper function to make sure that the provided scale is of the correct
198158
# type (i.e., is continuous and works with the provided aesthetic)
@@ -222,3 +182,73 @@ check_scale_type <- function(scale, name, aesthetic, scale_is_discrete = FALSE,
222182

223183
scale
224184
}
185+
186+
# helper function for backwards compatibility through setting defaults
187+
# scales through `options()` instead of `theme()`.
188+
scale_backward_compatibility <- function(..., scale, aesthetic, type) {
189+
aesthetic <- standardise_aes_names(aesthetic[1])
190+
191+
args <- list2(...)
192+
args$call <- args$call %||% caller_call() %||% current_call()
193+
194+
if (type == "binned") {
195+
fallback <- getOption(
196+
paste("ggplot2", type, aesthetic, sep = "."),
197+
default = "gradient"
198+
)
199+
if (is.function(fallback)) {
200+
fallback <- "gradient"
201+
}
202+
scale <- scale %||% fallback
203+
}
204+
205+
if (is_bare_string(scale)) {
206+
if (scale == "continuous") {
207+
scale <- "gradient"
208+
}
209+
if (scale == "discrete") {
210+
scale <- "hue"
211+
}
212+
if (scale == "viridis") {
213+
scale <- switch(
214+
type, discrete = "viridis_d", binned = "viridis_b", "viridis_c"
215+
)
216+
}
217+
218+
candidates <- paste("scale", aesthetic, scale, sep = "_")
219+
for (candi in candidates) {
220+
f <- find_global(candi, env = caller_env(), mode = "function")
221+
if (!is.null(f)) {
222+
scale <- f
223+
break
224+
}
225+
}
226+
}
227+
228+
if (!is.function(scale) && type == "discrete") {
229+
args$type <- scale
230+
scale <- switch(
231+
aesthetic,
232+
colour = scale_colour_qualitative,
233+
fill = scale_fill_qualitative
234+
)
235+
}
236+
237+
if (is.function(scale)) {
238+
if (!any(c("...", "call") %in% fn_fmls_names(scale))) {
239+
args$call <- NULL
240+
}
241+
if (!"..." %in% fn_fmls_names(scale)) {
242+
args <- args[intersect(names(args), fn_fmls_names(scale))]
243+
}
244+
scale <- check_scale_type(
245+
exec(scale, !!!args),
246+
paste("scale", aesthetic, type, sep = "_"),
247+
aesthetic,
248+
scale_is_discrete = type == "discrete"
249+
)
250+
return(scale)
251+
}
252+
253+
cli::cli_abort("Unknown scale type: {.val {scale}}")
254+
}

0 commit comments

Comments
 (0)