From 1a38c7f9d42b1ee3c0f1912a47b866b6199fab6d Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 18 Mar 2024 14:43:33 +0100 Subject: [PATCH 1/5] unify updating mechanism --- R/geom-defaults.R | 46 ++++++++++++++++++++++++++++++++-------------- 1 file changed, 32 insertions(+), 14 deletions(-) diff --git a/R/geom-defaults.R b/R/geom-defaults.R index afd2e598d4..d60108afea 100644 --- a/R/geom-defaults.R +++ b/R/geom-defaults.R @@ -33,23 +33,41 @@ #' #' @rdname update_defaults update_geom_defaults <- function(geom, new) { - g <- check_subclass(geom, "Geom", env = parent.frame()) - old <- g$default_aes - new <- rename_aes(new) - new_names_order <- unique(c(names(old), names(new))) - new <- defaults(new, old)[new_names_order] - g$default_aes[names(new)] <- new - invisible() + update_defaults(geom, "Geom", new, env = parent.frame()) } #' @rdname update_defaults #' @export update_stat_defaults <- function(stat, new) { - g <- check_subclass(stat, "Stat", env = parent.frame()) - old <- g$default_aes - new <- rename_aes(new) - new_names_order <- unique(c(names(old), names(new))) - new <- defaults(new, old)[new_names_order] - g$default_aes[names(new)] <- new - invisible() + update_defaults(stat, "Stat", new, env = parent.frame()) +} + +cache_defaults <- new_environment() + +update_defaults <- function(name, subclass, new, env = parent.frame()) { + obj <- check_subclass(name, subclass, env = env) + index <- snake_class(obj) + + if (is.null(new)) { # Reset from cache + + old <- cache_defaults[[index]] + if (!is.null(old)) { + new <- update_defaults(name, subclass, new = old, env = env) + } + invisible(new) + + } else { # Update default aesthetics + + old <- obj$default_aes + # Only update cache the first time defaults are changed + if (!index %in% ls(cache_defaults)) { + cache_defaults[[index]] <- old + } + new <- rename_aes(new) + name_order <- unique(c(names(old), names(new))) + new <- defaults(new, old)[name_order] + obj$default_aes[names(new)] <- new + invisible(old) + + } } From e8e90ef9dc0ae77824f6bf048b737ce10dd1ae25 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 18 Mar 2024 14:44:19 +0100 Subject: [PATCH 2/5] add tests --- tests/testthat/test-geom-.R | 20 +++++++++++++++++--- 1 file changed, 17 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-geom-.R b/tests/testthat/test-geom-.R index 409aa19b8f..61063d5d95 100644 --- a/tests/testthat/test-geom-.R +++ b/tests/testthat/test-geom-.R @@ -6,7 +6,21 @@ test_that("aesthetic checking in geom throws correct errors", { expect_snapshot_error(check_aesthetics(aes, 4)) }) - +test_that("geom defaults can be set and reset", { + l <- geom_point() + test <- l$geom$use_defaults(data_frame0()) + expect_equal(test$colour, "black") + + inv <- update_geom_defaults("point", list(colour = "red")) + test <- l$geom$use_defaults(data_frame0()) + expect_equal(test$colour, "red") + expect_equal(inv$colour, "black") + + inv <- update_geom_defaults("point", NULL) + test <- l$geom$use_defaults(data_frame0()) + expect_equal(test$colour, "black") + expect_equal(inv$colour, "red") +}) test_that("updating geom aesthetic defaults preserves class and order", { @@ -23,7 +37,7 @@ test_that("updating geom aesthetic defaults preserves class and order", { expect_equal(updated_defaults, intended_defaults) - update_geom_defaults("point", original_defaults) + update_geom_defaults("point", NULL) }) @@ -46,6 +60,6 @@ test_that("updating stat aesthetic defaults preserves class and order", { expect_equal(updated_defaults, intended_defaults) - update_stat_defaults("bin", original_defaults) + update_stat_defaults("bin", NULL) }) From f6ecb5e1e648db188c2cbc5df2dc75c610ad70e9 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 18 Mar 2024 14:44:30 +0100 Subject: [PATCH 3/5] redocument --- R/geom-defaults.R | 8 +++++--- man/update_defaults.Rd | 10 +++++++--- 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/R/geom-defaults.R b/R/geom-defaults.R index d60108afea..fdd9cbd735 100644 --- a/R/geom-defaults.R +++ b/R/geom-defaults.R @@ -3,7 +3,9 @@ #' @param stat,geom Name of geom/stat to modify (like `"point"` or #' `"bin"`), or a Geom/Stat object (like `GeomPoint` or #' `StatBin`). -#' @param new Named list of aesthetics. +#' @param new One of the following: +#' * A named list of aesthetics to serve as new defaults. +#' * `NULL` to reset the defaults. #' @keywords internal #' @export #' @examples @@ -16,7 +18,7 @@ #' ggplot(mtcars, aes(mpg, wt)) + geom_point() #' #' # reset default -#' update_geom_defaults("point", aes(color = "black")) +#' update_geom_defaults("point", NULL) #' #' #' # updating a stat's default aesthetic settings @@ -29,7 +31,7 @@ #' geom_function(fun = dnorm, color = "red") #' #' # reset default -#' update_stat_defaults("bin", aes(y = after_stat(count))) +#' update_stat_defaults("bin", NULL) #' #' @rdname update_defaults update_geom_defaults <- function(geom, new) { diff --git a/man/update_defaults.Rd b/man/update_defaults.Rd index e009b99d32..8006bf8246 100644 --- a/man/update_defaults.Rd +++ b/man/update_defaults.Rd @@ -10,7 +10,11 @@ update_geom_defaults(geom, new) update_stat_defaults(stat, new) } \arguments{ -\item{new}{Named list of aesthetics.} +\item{new}{One of the following: +\itemize{ +\item A named list of aesthetics to serve as new defaults. +\item \code{NULL} to reset the defaults. +}} \item{stat, geom}{Name of geom/stat to modify (like \code{"point"} or \code{"bin"}), or a Geom/Stat object (like \code{GeomPoint} or @@ -29,7 +33,7 @@ GeomPoint$default_aes ggplot(mtcars, aes(mpg, wt)) + geom_point() # reset default -update_geom_defaults("point", aes(color = "black")) +update_geom_defaults("point", NULL) # updating a stat's default aesthetic settings @@ -42,7 +46,7 @@ ggplot(data.frame(x = rnorm(1e3)), aes(x)) + geom_function(fun = dnorm, color = "red") # reset default -update_stat_defaults("bin", aes(y = after_stat(count))) +update_stat_defaults("bin", NULL) } \keyword{internal} From b0cc8cf5de4a70f11af3cd6b4c332a518bce215d Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 18 Mar 2024 14:46:49 +0100 Subject: [PATCH 4/5] add news bullet --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index a96a2e4b02..011b3c6be1 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,8 @@ # ggplot2 (development version) +* `update_geom_defaults()` and `update_stat_defaults()` have a reset mechanism + when using `new = NULL` and invisible return the previous defaults (#4993). * `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 a893a1e69436c8daca40e895ddd490498c5a1278 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 2 Apr 2024 09:21:18 +0200 Subject: [PATCH 5/5] add review suggestion --- R/geom-defaults.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/geom-defaults.R b/R/geom-defaults.R index fdd9cbd735..8b81eeef94 100644 --- a/R/geom-defaults.R +++ b/R/geom-defaults.R @@ -62,7 +62,7 @@ update_defaults <- function(name, subclass, new, env = parent.frame()) { old <- obj$default_aes # Only update cache the first time defaults are changed - if (!index %in% ls(cache_defaults)) { + if (!exists(index, envir = cache_defaults)) { cache_defaults[[index]] <- old } new <- rename_aes(new)