Geom aesthetics based on theme (#5833)

* draft new `geom` element in themes

* plumbing for providing theme to Geom$use_defaults()

* make `from_theme()` as eval helper

* Evaluate default aesthetics from theme

* allow user-specified `from_theme()`

* plumbing for guides to observe theme

* Add text settings

* accept minor fontsize difference (11.04pt -> 11.00pt)

* temporarily disable `sf_grob()` default lookups

* temporary shim for colour mixing

* Get all `colour`/`fill`/`linewidth` from theme

* test theme has `geom` element

* adapt tests

* `geom_sf()` has themed defaults

* we don't expect complete themes anymore

* shim auto-replaces itself when exported from scales

* theme defaults for point size/shape

* boxplot point shape/size default from `GeomBoxplot$default_aes`

* accept larger points in large theme snapshots

* Point to theme setting in `update_geom_defaults()`

* document `from_theme()`

* add news bullet

* Update R/geom-pointrange.R

Co-authored-by: Thomas Lin Pedersen <[email protected]>

* Run revdepcheck

* implement @yutannihilation's suggestion

* run revdepcheck

* revdepcheck once again

* protect against missing `theme`

* skip empty sf layers

* getter for geom defaults

* add `linetype` to `element_geom()`

* `geom_path()` treats integer `1L` as solid (in addition to numeric `1`)

* get linetype from theme

* swap thin/thick for linewidth/borderwidth and distinguish linetype and bordertype

* point stroke counts as border

* deduplicate argument documentation

---------

Co-authored-by: Thomas Lin Pedersen <[email protected]>

Author: teunbrand

NAMESPACE

@@ -344,6 +344,7 @@ export(draw_key_vpath)
 export(dup_axis)
 export(el_def)
 export(element_blank)
+export(element_geom)
 export(element_grob)
 export(element_line)
 export(element_rect)
@@ -367,6 +368,7 @@ export(find_panel)
 export(flip_data)
 export(flipped_names)
 export(fortify)
+export(from_theme)
 export(geom_abline)
 export(geom_area)
 export(geom_bar)
@@ -422,6 +424,7 @@ export(geom_violin)
 export(geom_vline)
 export(get_alt_text)
 export(get_element_tree)
+export(get_geom_defaults)
 export(get_guide_data)
 export(get_last_plot)
 export(get_layer_data)

NEWS.md

@@ -1,5 +1,11 @@
 # ggplot2 (development version)
 
+* (Breaking) The defaults for all geoms can be set at one in the theme. 
+  (@teunbrand based on pioneering work by @dpseidel, #2239)
+    * A new `theme(geom)` argument is used to track these defaults.
+    * The `element_geom()` function can be used to populate that argument.
+    * The `from_theme()` function allows access to the theme default fields from
+      inside the `aes()` function.
 * Passing empty unmapped aesthetics to layers raises a warning instead of
   throwing an error (@teunbrand, #6009).
 * Moved {mgcv} from Imports to Suggests (@teunbrand, #5986)

R/aes-evaluation.R

@@ -109,6 +109,13 @@
 #'     fun.data = ~ round(data.frame(mean = mean(.x), sd = sd(.x)), 2)
 #'   )
 #' ```
+#'
+#' ## Theme access
+#' The `from_theme()` function can be used to acces the [`element_geom()`]
+#' fields of the `theme(geom)` argument. Using `aes(colour = from_theme(ink))`
+#' and `aes(colour = from_theme(accent))` allows swapping between foreground and
+#' accent colours.
+#'
 #' @rdname aes_eval
 #' @name aes_eval
 #'
@@ -192,6 +199,13 @@ stat <- function(x) {
 after_scale <- function(x) {
   x
 }
+
+#' @rdname aes_eval
+#' @export
+from_theme <- function(x) {
+  x
+}
+
 #' @rdname aes_eval
 #' @export
 stage <- function(start = NULL, after_stat = NULL, after_scale = NULL) {
@@ -221,6 +235,9 @@ is_scaled_aes <- function(aesthetics) {
 is_staged_aes <- function(aesthetics) {
   vapply(aesthetics, is_staged, logical(1), USE.NAMES = FALSE)
 }
+is_themed_aes <- function(aesthetics) {
+  vapply(aesthetics, is_themed, logical(1), USE.NAMES = FALSE)
+}
 is_calculated <- function(x, warn = FALSE) {
   if (is_call(get_expr(x), "after_stat")) {
     return(TRUE)
@@ -263,6 +280,9 @@ is_scaled <- function(x) {
 is_staged <- function(x) {
   is_call(get_expr(x), "stage")
 }
+is_themed <- function(x) {
+  is_call(get_expr(x), "from_theme")
+}
 
 # Strip dots from expressions
 strip_dots <- function(expr, env, strip_pronoun = FALSE) {

R/annotation-logticks.R

@@ -228,7 +228,12 @@ GeomLogticks <- ggproto("GeomLogticks", Geom,
     gTree(children = inject(gList(!!!ticks)))
   },
 
-  default_aes = aes(colour = "black", linewidth = 0.5, linetype = 1, alpha = 1)
+  default_aes = aes(
+    colour = from_theme(ink),
+    linewidth = from_theme(linewidth),
+    linetype = from_theme(linetype),
+    alpha = 1
+  )
 )
 
 

R/geom-.R

@@ -114,7 +114,8 @@ Geom <- ggproto("Geom",
   setup_data = function(data, params) data,
 
   # Combine data with defaults and set aesthetics from parameters
-  use_defaults = function(self, data, params = list(), modifiers = aes(), default_aes = NULL, ...) {
+  use_defaults = function(self, data, params = list(), modifiers = aes(),
+                          default_aes = NULL, theme = NULL, ...) {
     default_aes <- default_aes %||% self$default_aes
 
     # Inherit size as linewidth if no linewidth aesthetic and param exist
@@ -131,8 +132,11 @@ 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)
+    default_aes[names(themed_defaults)] <- themed_defaults
 
-    missing_eval <- lapply(default_aes[missing_aes], eval_tidy)
+    missing_eval <- lapply(default_aes, eval_tidy)
     # Needed for geoms with defaults set to NULL (e.g. GeomSf)
     missing_eval <- compact(missing_eval)
 
@@ -142,6 +146,13 @@ Geom <- ggproto("Geom",
       data[names(missing_eval)] <- missing_eval
     }
 
+    themed <- is_themed_aes(modifiers)
+    if (any(themed)) {
+      themed <- eval_from_theme(modifiers[themed], theme)
+      modifiers <- modifiers[setdiff(names(modifiers), names(themed))]
+      data[names(themed)] <- themed
+    }
+
     # If any after_scale mappings are detected they will be resolved here
     # This order means that they will have access to all default aesthetics
     if (length(modifiers) != 0) {
@@ -226,6 +237,15 @@ Geom <- ggproto("Geom",
 )
 
 
+eval_from_theme <- function(aesthetics, theme) {
+  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)
+}
+
 #' Graphical units
 #'
 #' Multiply size in mm by these constants in order to convert to the units

R/geom-abline.R

@@ -142,7 +142,13 @@ GeomAbline <- ggproto("GeomAbline", Geom,
     GeomSegment$draw_panel(unique0(data), panel_params, coord, lineend = lineend)
   },
 
-  default_aes = aes(colour = "black", linewidth = 0.5, linetype = 1, alpha = NA),
+  default_aes = aes(
+    colour = from_theme(ink),
+    linewidth = from_theme(linewidth),
+    linetype = from_theme(linetype),
+    alpha = NA
+  ),
+
   required_aes = c("slope", "intercept"),
 
   draw_key = draw_key_abline,

R/geom-boxplot.R

@@ -117,8 +117,8 @@ geom_boxplot <- function(mapping = NULL, data = NULL,
                          outlier.colour = NULL,
                          outlier.color = NULL,
                          outlier.fill = NULL,
-                         outlier.shape = 19,
-                         outlier.size = 1.5,
+                         outlier.shape = NULL,
+                         outlier.size = NULL,
                          outlier.stroke = 0.5,
                          outlier.alpha = NULL,
                          notch = FALSE,
@@ -223,8 +223,8 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
 
   draw_group = function(self, data, panel_params, coord, lineend = "butt",
                         linejoin = "mitre", fatten = 2, outlier.colour = NULL,
-                        outlier.fill = NULL, outlier.shape = 19,
-                        outlier.size = 1.5, outlier.stroke = 0.5,
+                        outlier.fill = NULL, outlier.shape = NULL,
+                        outlier.size = NULL, outlier.stroke = 0.5,
                         outlier.alpha = NULL, notch = FALSE, notchwidth = 0.5,
                         staplewidth = 0, varwidth = FALSE, flipped_aes = FALSE) {
     data <- check_linewidth(data, snake_class(self))
@@ -327,8 +327,12 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
 
   draw_key = draw_key_boxplot,
 
-  default_aes = aes(weight = 1, colour = "grey20", fill = "white", size = NULL,
-    alpha = NA, shape = 19, linetype = "solid", linewidth = 0.5),
+  default_aes = aes(
+    weight = 1, colour = from_theme(col_mix(ink, paper, 0.2)),
+    fill = from_theme(paper), size = from_theme(pointsize),
+    alpha = NA, shape = from_theme(pointshape), linetype = from_theme(bordertype),
+    linewidth = from_theme(borderwidth)
+  ),
 
   required_aes = c("x|y", "lower|xlower", "upper|xupper", "middle|xmiddle", "ymin|xmin", "ymax|xmax"),
 

R/geom-contour.R

@@ -126,9 +126,9 @@ geom_contour_filled <- function(mapping = NULL, data = NULL,
 GeomContour <- ggproto("GeomContour", GeomPath,
   default_aes = aes(
     weight = 1,
-    colour = "#3366FF",
-    linewidth = 0.5,
-    linetype = 1,
+    colour = from_theme(accent),
+    linewidth = from_theme(linewidth),
+    linetype = from_theme(linetype),
     alpha = NA
   )
 )

R/geom-crossbar.R

@@ -40,8 +40,13 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom,
     GeomErrorbar$setup_data(data, params)
   },
 
-  default_aes = aes(colour = "black", fill = NA, linewidth = 0.5, linetype = 1,
-    alpha = NA),
+  default_aes = aes(
+    colour = from_theme(ink),
+    fill = NA,
+    linewidth = from_theme(borderwidth),
+    linetype = from_theme(bordertype),
+    alpha = NA
+  ),
 
   required_aes = c("x", "y", "ymin|xmin", "ymax|xmax"),
 

R/geom-curve.R

@@ -40,7 +40,14 @@ geom_curve <- function(mapping = NULL, data = NULL,
 #' @usage NULL
 #' @export
 GeomCurve <- ggproto("GeomCurve", GeomSegment,
-  default_aes = aes(colour = "black", linewidth = 0.5, linetype = 1, alpha = NA),
+
+  default_aes = aes(
+    colour = from_theme(ink),
+    linewidth = from_theme(linewidth),
+    linetype = from_theme(linetype),
+    alpha = NA
+  ),
+
   draw_panel = function(data, panel_params, coord, curvature = 0.5, angle = 90,
                         ncp = 5, arrow = NULL, arrow.fill = NULL, lineend = "butt", na.rm = FALSE) {
 

R/geom-defaults.R

@@ -9,6 +9,9 @@
 #'  * A named list of aesthetics to serve as new defaults.
 #'  * `NULL` to reset the defaults.
 #' @keywords internal
+#' @note
+#' Please note that geom defaults can be set *en masse* via the `theme(geom)`
+#' argument.
 #' @export
 #' @examples
 #'
@@ -51,6 +54,57 @@ update_stat_defaults <- function(stat, new) {
   update_defaults(stat, "Stat", new, env = parent.frame())
 }
 
+#' Resolve and get geom defaults
+#'
+#' @param geom Some definition of a geom:
+#' * A `function` that creates a layer, e.g. `geom_path()`.
+#' * A layer created by such function
+#' * A string naming a geom class in snake case without the `geom_`-prefix,
+#'   e.g. `"contour_filled"`.
+#' * A geom class object.
+#' @param theme A [`theme`] object. Defaults to the current global theme.
+#'
+#' @return A list of aesthetics
+#' @export
+#' @keywords internal
+#'
+#' @examples
+#' # Using a function
+#' get_geom_defaults(geom_raster)
+#'
+#' # Using a layer includes static aesthetics as default
+#' get_geom_defaults(geom_tile(fill = "white"))
+#'
+#' # Using a class name
+#' get_geom_defaults("density_2d")
+#'
+#' # Using a class
+#' get_geom_defaults(GeomPoint)
+#'
+#' # Changed theme
+#' get_geom_defaults("point", theme(geom = element_geom(ink = "purple")))
+get_geom_defaults <- function(geom, theme = theme_get()) {
+  theme <- theme %||% list(geom = .default_geom_element)
+
+  if (is.function(geom)) {
+    geom <- geom()
+  }
+  if (is.layer(geom)) {
+    data <- data_frame0(.id = 1L)
+    data <- geom$compute_geom_2(data = data, theme = theme)
+    data$.id <- NULL
+    return(data)
+  }
+  if (is.character(geom)) {
+    geom <- check_subclass(geom, "Geom")
+  }
+  if (inherits(geom, "Geom")) {
+    out <- geom$use_defaults(data = NULL, theme = theme)
+    return(out)
+  }
+  stop_input_type(geom, as_cli("a layer function, string or {.cls Geom} object"))
+}
+
 #' @rdname update_defaults
 #' @export
 reset_geom_defaults <- function() reset_defaults("geom")

R/geom-density.R

@@ -93,7 +93,7 @@ geom_density <- function(mapping = NULL, data = NULL,
 #' @include geom-ribbon.R
 GeomDensity <- ggproto("GeomDensity", GeomArea,
   default_aes = defaults(
-    aes(fill = NA, weight = 1, colour = "black", alpha = NA),
+    aes(fill = NA, weight = 1, colour = from_theme(ink), alpha = NA),
     GeomArea$default_aes
   )
 )

R/geom-density2d.R

@@ -106,7 +106,12 @@ geom_density2d <- geom_density_2d
 #' @usage NULL
 #' @export
 GeomDensity2d <- ggproto("GeomDensity2d", GeomPath,
-  default_aes = aes(colour = "#3366FF", linewidth = 0.5, linetype = 1, alpha = NA)
+  default_aes = aes(
+    colour = from_theme(accent),
+    linewidth = from_theme(linewidth),
+    linetype = from_theme(linetype),
+    alpha = NA
+  )
 )
 
 #' @export

R/geom-dotplot.R

@@ -188,8 +188,14 @@ GeomDotplot <- ggproto("GeomDotplot", Geom,
   required_aes = c("x", "y"),
   non_missing_aes = c("size", "shape"),
 
-  default_aes = aes(colour = "black", fill = "black", alpha = NA,
-                    stroke = 1, linetype = "solid", weight = 1),
+  default_aes = aes(
+    colour = from_theme(ink),
+    fill = from_theme(ink),
+    alpha = NA,
+    stroke = from_theme(borderwidth * 2),
+    linetype = from_theme(linetype),
+    weight = 1
+  ),
 
   setup_data = function(data, params) {
     data$width <- data$width %||%

R/geom-errorbar.R

@@ -28,8 +28,14 @@ geom_errorbar <- function(mapping = NULL, data = NULL,
 #' @usage NULL
 #' @export
 GeomErrorbar <- ggproto("GeomErrorbar", Geom,
-  default_aes = aes(colour = "black", linewidth = 0.5, linetype = 1, width = 0.5,
-    alpha = NA),
+
+  default_aes = aes(
+    colour = from_theme(ink),
+    linewidth = from_theme(linewidth),
+    linetype = from_theme(linetype),
+    width = 0.5,
+    alpha = NA
+  ),
 
   draw_key = draw_key_path,
 

R/geom-errorbarh.R

@@ -51,8 +51,14 @@ geom_errorbarh <- function(mapping = NULL, data = NULL,
 #' @usage NULL
 #' @export
 GeomErrorbarh <- ggproto("GeomErrorbarh", Geom,
-  default_aes = aes(colour = "black", linewidth = 0.5, linetype = 1, height = 0.5,
-    alpha = NA),
+
+  default_aes = aes(
+    colour = from_theme(ink),
+    linewidth = from_theme(linewidth),
+    linetype = from_theme(linetype),
+    height = 0.5,
+    alpha = NA
+  ),
 
   draw_key = draw_key_path,