From 1a08f8dfd9e4424fd5f4bff16b987549467b55e9 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 17 Feb 2025 10:22:10 +0100 Subject: [PATCH 1/3] isolate deprecated theme elements in function --- R/theme.R | 37 +++++++++++++++++++++---------------- 1 file changed, 21 insertions(+), 16 deletions(-) diff --git a/R/theme.R b/R/theme.R index dfe986fc62..402d47f437 100644 --- a/R/theme.R +++ b/R/theme.R @@ -469,6 +469,26 @@ theme <- function(..., validate = TRUE) { elements <- find_args(..., complete = NULL, validate = NULL) + elements <- fix_theme_deprecations(elements) + + # If complete theme set all non-blank elements to inherit from blanks + if (complete) { + elements <- lapply(elements, function(el) { + if (is.theme_element(el) && !inherits(el, "element_blank")) { + el$inherit.blank <- TRUE + } + el + }) + } + structure( + elements, + class = c("theme", "gg"), + complete = complete, + validate = validate + ) +} + +fix_theme_deprecations <- function(elements) { if (!is.null(elements$axis.ticks.margin)) { deprecate_warn0( "2.0.0", "theme(axis.ticks.margin)", @@ -539,22 +559,7 @@ theme <- function(..., elements$legend.position.inside <- elements$legend.position elements$legend.position <- "inside" } - - # If complete theme set all non-blank elements to inherit from blanks - if (complete) { - elements <- lapply(elements, function(el) { - if (is.theme_element(el) && !inherits(el, "element_blank")) { - el$inherit.blank <- TRUE - } - el - }) - } - structure( - elements, - class = c("theme", "gg"), - complete = complete, - validate = validate - ) + elements } #' @export From 51818fe72cdacc5e001024cc2783cb1f24fc1ec7 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 17 Feb 2025 11:13:53 +0100 Subject: [PATCH 2/3] look for conflicting options --- R/theme.R | 40 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) diff --git a/R/theme.R b/R/theme.R index 402d47f437..1b5084ae6a 100644 --- a/R/theme.R +++ b/R/theme.R @@ -470,6 +470,7 @@ theme <- function(..., elements <- find_args(..., complete = NULL, validate = NULL) elements <- fix_theme_deprecations(elements) + elements <- validate_theme_palettes(elements) # If complete theme set all non-blank elements to inherit from blanks if (complete) { @@ -562,6 +563,45 @@ fix_theme_deprecations <- function(elements) { elements } +validate_theme_palettes <- function(elements) { + + pals <- c("palette.colour.discrete", "palette.colour.continuous", + "palette.fill.discrete", "palette.fill.continuous", + "palette.color.discrete", "palette.color.continuous") + if (!any(pals %in% names(elements))) { + return(elements) + } + + # Standardise spelling + elements <- replace_null( + elements, + palette.colour.discrete = elements$palette.color.discrete, + palette.colour.continuous = elements$palette.color.continuous + ) + elements$palette.color.discrete <- NULL + elements$palette.color.continuous <- NULL + + # Check for incompatible options + pals <- c("palette.colour.discrete", "palette.colour.continuous", + "palette.fill.discrete", "palette.fill.continuous") + opts <- c("ggplot2.discrete.colour", "ggplot2.continuous.colour", + "ggplot2.discrete.fill", "ggplot2.continuous.fill") + index <- which(pals %in% names(elements)) + + for (i in index) { + if (is.null(getOption(opts[i]))) { + next + } + cli::cli_warn(c( + "The {.code options('{opts[i]}')} setting is incompatible with the \\ + {.arg {pals[i]}} theme setting.", + i = "You can set {.code options({opts[i]} = NULL)}." + )) + } + + elements +} + #' @export #' @rdname is_tests is.theme <- function(x) inherits(x, "theme") From c95553efdee67b03aef43dd50f4019bbdfd314fb Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 17 Feb 2025 11:16:14 +0100 Subject: [PATCH 3/3] add test --- tests/testthat/_snaps/theme.md | 5 +++++ tests/testthat/test-theme.R | 10 ++++++++++ 2 files changed, 15 insertions(+) diff --git a/tests/testthat/_snaps/theme.md b/tests/testthat/_snaps/theme.md index 005e1b2abd..0218bbef51 100644 --- a/tests/testthat/_snaps/theme.md +++ b/tests/testthat/_snaps/theme.md @@ -98,3 +98,8 @@ The `aspect.ratio` theme element must be a object. +# theme() warns about conflicting palette options + + The `options('ggplot2.discrete.colour')` setting is incompatible with the `palette.colour.discrete` theme setting. + i You can set `options(ggplot2.discrete.colour = NULL)`. + diff --git a/tests/testthat/test-theme.R b/tests/testthat/test-theme.R index 8d74b4038f..ce16671af4 100644 --- a/tests/testthat/test-theme.R +++ b/tests/testthat/test-theme.R @@ -710,6 +710,16 @@ test_that("margin_part() mechanics work as expected", { expect_equal(as.numeric(test), c(5.5, 5.5, 11, 5.5)) }) +test_that("theme() warns about conflicting palette options", { + expect_silent( + theme(palette.colour.discrete = c("dodgerblue", "orange")) + ) + local_options(ggplot2.discrete.colour = c("red", "purple")) + expect_snapshot_warning( + theme(palette.colour.discrete = c("dodgerblue", "orange")) + ) +}) + # Visual tests ------------------------------------------------------------ test_that("element_polygon() can render a grob", {