From 8c6f5d2e638c33e49a8c675992cf075c38b861f6 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 25 Mar 2024 16:48:58 +0100 Subject: [PATCH 1/6] exported wrapper for `plot_theme()` --- R/theme.R | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/R/theme.R b/R/theme.R index 62ac55f3c6..75754275cb 100644 --- a/R/theme.R +++ b/R/theme.R @@ -553,6 +553,22 @@ validate_theme <- function(theme, tree = get_element_tree(), call = caller_env() ) } +complete_theme <- function(theme = NULL, default = theme_get()) { + check_object(theme, is.theme, "a {.cls theme} object", allow_null = TRUE) + check_object(default, is.theme, "a {.cls theme} object") + theme <- plot_theme(list(theme = theme), default = default) + + # Using `theme(!!!theme)` drops `NULL` entries, so strip most attributes and + # construct a new theme + attributes(theme) <- list(names = attr(theme, "names")) + structure( + theme, + class = c("theme", "gg"), + complete = TRUE, # This theme is complete and has no missing elements + validate = FALSE # Settings have already been validated + ) +} + # Combine plot defaults with current theme to get complete theme for a plot plot_theme <- function(x, default = theme_get()) { theme <- x$theme From 049ec77d9d50e1c8e68368c6266b563950cc18a0 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 25 Mar 2024 16:49:23 +0100 Subject: [PATCH 2/6] document --- NAMESPACE | 1 + R/theme.R | 18 ++++++++++++++++++ man/complete_theme.Rd | 28 ++++++++++++++++++++++++++++ 3 files changed, 47 insertions(+) create mode 100644 man/complete_theme.Rd diff --git a/NAMESPACE b/NAMESPACE index 67c7a4941a..30e0148e5b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -304,6 +304,7 @@ export(borders) export(calc_element) export(check_device) export(combine_vars) +export(complete_theme) export(continuous_scale) export(coord_cartesian) export(coord_equal) diff --git a/R/theme.R b/R/theme.R index 75754275cb..a3ded7b5c3 100644 --- a/R/theme.R +++ b/R/theme.R @@ -553,6 +553,24 @@ validate_theme <- function(theme, tree = get_element_tree(), call = caller_env() ) } +#' Complete a theme +#' +#' This function takes a theme and completes it so that it can be used +#' downstream to render theme elements. Missing elements are filled in and +#' every item is validated to the specifications of the element tree. +#' +#' @param theme An incomplete [theme][theme()] object to complete, or `NULL` +#' to complete the default theme. +#' @param default A complete [theme][theme()] to fill in missing pieces. +#' Defaults to the global theme settings. +#' +#' @keywords internal +#' @return A [theme][theme()] object. +#' @export +#' +#' @examples +#' my_theme <- theme(line = element_line(colour = "red")) +#' complete_theme(my_theme) complete_theme <- function(theme = NULL, default = theme_get()) { check_object(theme, is.theme, "a {.cls theme} object", allow_null = TRUE) check_object(default, is.theme, "a {.cls theme} object") diff --git a/man/complete_theme.Rd b/man/complete_theme.Rd new file mode 100644 index 0000000000..b90e6abc9b --- /dev/null +++ b/man/complete_theme.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/theme.R +\name{complete_theme} +\alias{complete_theme} +\title{Complete a theme} +\usage{ +complete_theme(theme = NULL, default = theme_get()) +} +\arguments{ +\item{theme}{An incomplete \link[=theme]{theme} object to complete, or \code{NULL} +to complete the default theme.} + +\item{default}{A complete \link[=theme]{theme} to fill in missing pieces. +Defaults to the global theme settings.} +} +\value{ +A \link[=theme]{theme} object. +} +\description{ +This function takes a theme and completes it so that it can be used +downstream to render theme elements. Missing elements are filled in and +every item is validated to the specifications of the element tree. +} +\examples{ +my_theme <- theme(line = element_line(colour = "red")) +complete_theme(my_theme) +} +\keyword{internal} From 7a35bcd1b1cf304918b294b273aa016dd97d8cf9 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 25 Mar 2024 16:49:31 +0100 Subject: [PATCH 3/6] add test --- tests/testthat/test-theme.R | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/tests/testthat/test-theme.R b/tests/testthat/test-theme.R index 895d4cf9fc..c5a883b19a 100644 --- a/tests/testthat/test-theme.R +++ b/tests/testthat/test-theme.R @@ -583,6 +583,30 @@ test_that("Minor tick length supports biparental inheritance", { ) }) +test_that("complete_theme completes a theme", { + # `NULL` should match default + gray <- theme_gray() + new <- complete_theme(NULL, default = gray) + expect_equal(new, gray) + + # Elements are propagated + new <- complete_theme(theme(axis.line = element_line("red")), gray) + expect_equal(new$axis.line$colour, "red") + + # Missing elements are filled in if default theme is incomplete + new <- complete_theme(default = theme()) + expect_s3_class(new$axis.line, "element_blank") + + # Registered elements are included + register_theme_elements( + test = element_text(), + element_tree = list(test = el_def("element_text", "text")) + ) + new <- complete_theme(default = gray) + expect_s3_class(new$test, "element_text") + reset_theme_settings() +}) + # Visual tests ------------------------------------------------------------ test_that("aspect ratio is honored", { From 6454182fc9e5fe43e56c6f68ec9e704a2fa5ac52 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 25 Mar 2024 16:51:09 +0100 Subject: [PATCH 4/6] add news bullet --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index a96a2e4b02..3146209ad1 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,8 @@ # ggplot2 (development version) +* New function `complete_theme()` to replicate how themes are handled during + plot building (#5801). * `coord_map()` and `coord_polar()` throw informative warnings when used with the guide system (#5707). * When passing a function to `stat_contour(breaks)`, that function is used to From 201f44a6dad30e023420e4055de38fb9150a45fb Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 25 Mar 2024 17:08:02 +0100 Subject: [PATCH 5/6] Allow for unclassed list themes --- R/theme.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/theme.R b/R/theme.R index a3ded7b5c3..3b76b05cad 100644 --- a/R/theme.R +++ b/R/theme.R @@ -572,7 +572,9 @@ validate_theme <- function(theme, tree = get_element_tree(), call = caller_env() #' my_theme <- theme(line = element_line(colour = "red")) #' complete_theme(my_theme) complete_theme <- function(theme = NULL, default = theme_get()) { - check_object(theme, is.theme, "a {.cls theme} object", allow_null = TRUE) + if (!is_bare_list(theme)) { + check_object(theme, is.theme, "a {.cls theme} object", allow_null = TRUE) + } check_object(default, is.theme, "a {.cls theme} object") theme <- plot_theme(list(theme = theme), default = default) From 75fa551983eb70808ce9b691c2a9da0e525bb410 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 26 Mar 2024 11:26:31 +0100 Subject: [PATCH 6/6] fix failing test --- tests/testthat/test-theme.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-theme.R b/tests/testthat/test-theme.R index c5a883b19a..e2cdf20ade 100644 --- a/tests/testthat/test-theme.R +++ b/tests/testthat/test-theme.R @@ -587,7 +587,7 @@ test_that("complete_theme completes a theme", { # `NULL` should match default gray <- theme_gray() new <- complete_theme(NULL, default = gray) - expect_equal(new, gray) + expect_equal(new, gray, ignore_attr = "validate") # Elements are propagated new <- complete_theme(theme(axis.line = element_line("red")), gray)