Skip to content

Commit f34ad83

Browse files
authored
Theme palettes warn about options (#6334)
* isolate deprecated theme elements in function * look for conflicting options * add test
1 parent ffdfc23 commit f34ad83

File tree

3 files changed

+72
-12
lines changed

3 files changed

+72
-12
lines changed

R/theme.R

+57-12
Original file line numberDiff line numberDiff line change
@@ -467,8 +467,29 @@ theme <- function(...,
467467
strip.switch.pad.wrap,
468468
complete = FALSE,
469469
validate = TRUE) {
470+
470471
elements <- find_args(..., complete = NULL, validate = NULL)
472+
elements <- fix_theme_deprecations(elements)
473+
elements <- validate_theme_palettes(elements)
471474

475+
# If complete theme set all non-blank elements to inherit from blanks
476+
if (complete) {
477+
elements <- lapply(elements, function(el) {
478+
if (is.theme_element(el) && !inherits(el, "element_blank")) {
479+
el$inherit.blank <- TRUE
480+
}
481+
el
482+
})
483+
}
484+
structure(
485+
elements,
486+
class = c("theme", "gg"),
487+
complete = complete,
488+
validate = validate
489+
)
490+
}
491+
492+
fix_theme_deprecations <- function(elements) {
472493
if (is.unit(elements$legend.margin) && !is.margin(elements$legend.margin)) {
473494
cli::cli_warn(c(
474495
"{.var legend.margin} must be specified using {.fn margin}",
@@ -511,22 +532,46 @@ theme <- function(...,
511532
elements$legend.position.inside <- elements$legend.position
512533
elements$legend.position <- "inside"
513534
}
535+
elements
536+
}
514537

515-
# If complete theme set all non-blank elements to inherit from blanks
516-
if (complete) {
517-
elements <- lapply(elements, function(el) {
518-
if (is.theme_element(el) && !inherits(el, "element_blank")) {
519-
el$inherit.blank <- TRUE
520-
}
521-
el
522-
})
538+
validate_theme_palettes <- function(elements) {
539+
540+
pals <- c("palette.colour.discrete", "palette.colour.continuous",
541+
"palette.fill.discrete", "palette.fill.continuous",
542+
"palette.color.discrete", "palette.color.continuous")
543+
if (!any(pals %in% names(elements))) {
544+
return(elements)
523545
}
524-
structure(
546+
547+
# Standardise spelling
548+
elements <- replace_null(
525549
elements,
526-
class = c("theme", "gg"),
527-
complete = complete,
528-
validate = validate
550+
palette.colour.discrete = elements$palette.color.discrete,
551+
palette.colour.continuous = elements$palette.color.continuous
529552
)
553+
elements$palette.color.discrete <- NULL
554+
elements$palette.color.continuous <- NULL
555+
556+
# Check for incompatible options
557+
pals <- c("palette.colour.discrete", "palette.colour.continuous",
558+
"palette.fill.discrete", "palette.fill.continuous")
559+
opts <- c("ggplot2.discrete.colour", "ggplot2.continuous.colour",
560+
"ggplot2.discrete.fill", "ggplot2.continuous.fill")
561+
index <- which(pals %in% names(elements))
562+
563+
for (i in index) {
564+
if (is.null(getOption(opts[i]))) {
565+
next
566+
}
567+
cli::cli_warn(c(
568+
"The {.code options('{opts[i]}')} setting is incompatible with the \\
569+
{.arg {pals[i]}} theme setting.",
570+
i = "You can set {.code options({opts[i]} = NULL)}."
571+
))
572+
}
573+
574+
elements
530575
}
531576

532577
#' @export

tests/testthat/_snaps/theme.md

+5
Original file line numberDiff line numberDiff line change
@@ -98,3 +98,8 @@
9898

9999
The `aspect.ratio` theme element must be a <numeric/integer> object.
100100

101+
# theme() warns about conflicting palette options
102+
103+
The `options('ggplot2.discrete.colour')` setting is incompatible with the `palette.colour.discrete` theme setting.
104+
i You can set `options(ggplot2.discrete.colour = NULL)`.
105+

tests/testthat/test-theme.R

+10
Original file line numberDiff line numberDiff line change
@@ -706,6 +706,16 @@ test_that("margin_part() mechanics work as expected", {
706706
expect_equal(as.numeric(test), c(5.5, 5.5, 11, 5.5))
707707
})
708708

709+
test_that("theme() warns about conflicting palette options", {
710+
expect_silent(
711+
theme(palette.colour.discrete = c("dodgerblue", "orange"))
712+
)
713+
local_options(ggplot2.discrete.colour = c("red", "purple"))
714+
expect_snapshot_warning(
715+
theme(palette.colour.discrete = c("dodgerblue", "orange"))
716+
)
717+
})
718+
709719
test_that("geom elements are inherited correctly", {
710720

711721
GeomFoo <- ggproto("GeomFoo", GeomPoint)

0 commit comments

Comments
 (0)