From a76d1ab81f75ead2828ccbae3ba703e156bb2a19 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 21 Jan 2025 10:25:17 +0100 Subject: [PATCH 1/3] allow unregistered `geom.*` elements in theme --- R/theme.R | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/R/theme.R b/R/theme.R index 2ebd892f62..9e5eb278d0 100644 --- a/R/theme.R +++ b/R/theme.R @@ -565,8 +565,11 @@ validate_theme <- function(theme, tree = get_element_tree(), call = caller_env() if (!is_theme_validate(theme)) { return() } + elnames <- names(theme) + elnames[startsWith(elnames, "geom.")] <- "geom" + mapply( - validate_element, theme, names(theme), + validate_element, theme, elnames, MoreArgs = list(element_tree = tree, call = call) ) } @@ -630,7 +633,10 @@ plot_theme <- function(x, default = get_theme()) { validate_theme(theme) # Remove elements that are not registered - theme[setdiff(names(theme), names(get_element_tree()))] <- NULL + # We accept unregistered `geom.*` elements + remove <- setdiff(names(theme), names(get_element_tree())) + remove <- remove[!startsWith(remove, "geom.")] + theme[remove] <- NULL theme } From 912c29e7b64ee5a4363220cfa62a8161f9acfd0f Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 21 Jan 2025 10:34:44 +0100 Subject: [PATCH 2/3] allow inheritance of geom elements --- R/geom-.R | 28 ++++++++++++++++++++++++---- 1 file changed, 24 insertions(+), 4 deletions(-) diff --git a/R/geom-.R b/R/geom-.R index 50bdeb66a6..74efe6cec6 100644 --- a/R/geom-.R +++ b/R/geom-.R @@ -133,7 +133,7 @@ Geom <- ggproto("Geom", # Fill in missing aesthetics with their defaults missing_aes <- setdiff(names(default_aes), names(data)) default_aes <- default_aes[missing_aes] - themed_defaults <- eval_from_theme(default_aes, theme) + themed_defaults <- eval_from_theme(default_aes, theme, class(self)) default_aes[names(themed_defaults)] <- themed_defaults # Mark staged/scaled defaults as modifier (#6135) @@ -243,13 +243,33 @@ Geom <- ggproto("Geom", #' @rdname is_tests is.geom <- function(x) inherits(x, "Geom") -eval_from_theme <- function(aesthetics, theme) { +eval_from_theme <- function(aesthetics, theme, class = NULL) { themed <- is_themed_aes(aesthetics) if (!any(themed)) { return(aesthetics) } - settings <- calc_element("geom", theme) %||% .default_geom_element - lapply(aesthetics[themed], eval_tidy, data = settings) + + element <- calc_element("geom", theme) %||% .default_geom_element + class <- setdiff(class, c("Geom", "ggproto", "gg")) + + if (length(class) > 0) { + + # CamelCase to dot.case + class <- gsub("([A-Za-z])([A-Z])([a-z])", "\\1.\\2\\3", class) + class <- gsub("([a-z])([A-Z])", "\\1.\\2", class) + class <- to_lower_ascii(class) + + class <- class[class %in% names(theme)] + + # Inherit up to parent geom class + if (length(class) > 0) { + for (cls in rev(class)) { + element <- combine_elements(theme[[cls]], element) + } + } + } + + lapply(aesthetics[themed], eval_tidy, data = element) } #' Graphical units From 4fd2ce3f5f2f0e0a756dc2c58444f1f1f8d01370 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 21 Jan 2025 10:45:51 +0100 Subject: [PATCH 3/3] add test --- tests/testthat/test-theme.R | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/tests/testthat/test-theme.R b/tests/testthat/test-theme.R index ef358b10b6..f4804d727e 100644 --- a/tests/testthat/test-theme.R +++ b/tests/testthat/test-theme.R @@ -673,6 +673,26 @@ test_that("margin_part() mechanics work as expected", { expect_equal(as.numeric(test), c(5.5, 5.5, 11, 5.5)) }) +test_that("geom elements are inherited correctly", { + + GeomFoo <- ggproto("GeomFoo", GeomPoint) + GeomBar <- ggproto("GeomBar", GeomFoo) + + p <- ggplot(data.frame(x = 1), aes(x, x)) + + stat_identity(geom = GeomBar) + + theme( + geom = element_geom(pointshape = 15), + geom.point = element_geom(borderwidth = 2, ink = "blue"), + geom.foo = element_geom(pointsize = 2), + geom.bar = element_geom(ink = "red") + ) + p <- layer_data(p) + expect_equal(p$shape, 15) + expect_equal(p$stroke, 2) + expect_equal(p$size, 2) + expect_equal(p$colour, "red") +}) + # Visual tests ------------------------------------------------------------ test_that("aspect ratio is honored", {