allow better stat defaults updating with examples, add tests

Author: dkahle

R/geom-defaults.r

@@ -7,16 +7,42 @@
 #' @keywords internal
 #' @export
 #' @examples
+#'
+#' # updating a geom's default aesthetic settings
+#' # example: change geom_point()'s default color
 #' GeomPoint$default_aes
 #' update_geom_defaults("point", list(color = "red"))
 #' GeomPoint$default_aes
 #' ggplot(mtcars, aes(mpg, wt)) + geom_point()
+#'
+#' # reset default
 #' update_geom_defaults("point", list(colour = "black"))
+#'
+#' # note: adding default aesthetics is possible
+#' # update_geom_defaults("point", list(foo = "bar"))
+#' # GeomPoint$default_aes
+#'
+#'
+#' # updating a stat's default aesthetic settings
+#' # example: change stat_bin()'s default y-axis to the density scale
+#' StatBin$default_aes
+#' update_stat_defaults("bin", list(y = expr(after_stat(density))))
+#' StatBin$default_aes
+#' ggplot(data.frame(x = rnorm(1e3)), aes(x)) +
+#'   geom_histogram() +
+#'   geom_function(fun = dnorm, color = "red")
+#'
+#' # reset default
+#' update_stat_defaults("bin", list(y = expr(after_stat(density))))
+#'
 #' @rdname update_defaults
 update_geom_defaults <- function(geom, new) {
   g <- check_subclass(geom, "Geom", env = parent.frame())
   old <- g$default_aes
-  g$default_aes[] <- defaults(rename_aes(new), old)[names(old)]
+  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()
 }
 
@@ -25,6 +51,9 @@ update_geom_defaults <- function(geom, new) {
 update_stat_defaults <- function(stat, new) {
   g <- check_subclass(stat, "Stat", env = parent.frame())
   old <- g$default_aes
-  g$default_aes[] <- defaults(rename_aes(new), old)[names(old)]
+  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()
 }

man/update_defaults.Rd

@@ -5,3 +5,46 @@ test_that("aesthetic checking in geom throws correct errors", {
   aes <- list(a = 1:4, b = letters[1:4], c = TRUE, d = 1:2, e = 1:5)
   expect_snapshot_error(check_aesthetics(aes, 4))
 })
+
+
+
+test_that("updating geom aesthetic defaults preserves class and order", {
+
+  original_defaults <- GeomPoint$default_aes
+
+  update_geom_defaults("point", list(color = "red"))
+
+  updated_defaults <- GeomPoint$default_aes
+
+  expect_s3_class(updated_defaults, "uneval")
+
+  intended_defaults <- original_defaults
+  intended_defaults[["colour"]] <- "red"
+
+  expect_equal(updated_defaults, intended_defaults)
+
+  update_geom_defaults("point", original_defaults)
+
+})
+
+
+
+
+test_that("updating stat aesthetic defaults preserves class and order", {
+
+  original_defaults <- StatBin$default_aes
+
+  update_stat_defaults("bin", list(y = expr(after_stat(density))))
+
+  updated_defaults <- StatBin$default_aes
+
+  expect_s3_class(updated_defaults, "uneval")
+
+  intended_defaults <- original_defaults
+  intended_defaults[["y"]] <- expr(after_stat(density))
+
+  expect_equal(updated_defaults, intended_defaults)
+
+  update_stat_defaults("bin", original_defaults)
+
+})