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 <thomasp85@gmail.com>

* 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 <thomasp85@gmail.com>

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,