Geom aesthetics based on theme

NAMESPACE

@@ -342,6 +342,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)
@@ -365,6 +366,7 @@ export(find_panel)
 export(flip_data)
 export(flipped_names)
 export(fortify)
+export(from_theme)
 export(geom_abline)
 export(geom_area)
 export(geom_bar)

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.
 * (Internal) Applying defaults in `geom_sf()` has moved from the internal 
   `sf_grob()` to `GeomSf$use_defaults()` (@teunbrand).
 * `facet_wrap()` has new options for the `dir` argument to more precisely

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,7 @@ 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(thin), linetype = 1, 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) {
@@ -223,6 +234,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,7 @@ 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(thin), linetype = 1, 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 = "solid",
+    linewidth = from_theme(thin)
+  ),
 
   required_aes = c("x|y", "lower|xlower", "upper|xupper", "middle|xmiddle", "ymin|xmin", "ymax|xmax"),
 

R/geom-contour.R

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

R/geom-crossbar.R

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

R/geom-curve.R

@@ -40,7 +40,7 @@ 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(thin), linetype = 1, 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

@@ -7,6 +7,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
 #'

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,7 @@ 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(thin), linetype = 1, alpha = NA)
 )
 
 #' @export

R/geom-dotplot.R

@@ -188,7 +188,7 @@ GeomDotplot <- ggproto("GeomDotplot", Geom,
   required_aes = c("x", "y"),
   non_missing_aes = c("size", "shape"),
 
-  default_aes = aes(colour = "black", fill = "black", alpha = NA,
+  default_aes = aes(colour = from_theme(ink), fill = from_theme(ink), alpha = NA,
                     stroke = 1, linetype = "solid", weight = 1),
 
   setup_data = function(data, params) {

R/geom-errorbar.R

@@ -28,7 +28,7 @@ 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,
+  default_aes = aes(colour = from_theme(ink), linewidth = from_theme(thin), linetype = 1, width = 0.5,
     alpha = NA),
 
   draw_key = draw_key_path,

R/geom-errorbarh.R

@@ -51,7 +51,7 @@ 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,
+  default_aes = aes(colour = from_theme(ink), linewidth = from_theme(thin), linetype = 1, height = 0.5,
     alpha = NA),
 
   draw_key = draw_key_path,

R/geom-hex.R

@@ -107,8 +107,8 @@ GeomHex <- ggproto("GeomHex", Geom,
 
   default_aes = aes(
     colour = NA,
-    fill = "grey50",
-    linewidth = 0.5,
+    fill = from_theme(col_mix(ink, paper)),
+    linewidth = from_theme(thin),
     linetype = 1,
     alpha = NA
   ),

R/geom-hline.R

@@ -55,7 +55,7 @@ GeomHline <- ggproto("GeomHline", 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(thin), linetype = 1, alpha = NA),
   required_aes = "yintercept",
 
   draw_key = draw_key_path,

R/geom-label.R

@@ -56,8 +56,11 @@ GeomLabel <- ggproto("GeomLabel", Geom,
   required_aes = c("x", "y", "label"),
 
   default_aes = aes(
-    colour = "black", fill = "white", size = 3.88, angle = 0,
-    hjust = 0.5, vjust = 0.5, alpha = NA, family = "", fontface = 1,
+    colour = from_theme(ink), fill = from_theme(paper),
+    family = from_theme(family),
+    size = from_theme(fontsize),
+    angle = 0,
+    hjust = 0.5, vjust = 0.5, alpha = NA, fontface = 1,
     lineheight = 1.2
   ),
 

R/geom-linerange.R

@@ -91,7 +91,7 @@ geom_linerange <- function(mapping = NULL, data = NULL,
 #' @usage NULL
 #' @export
 GeomLinerange <- ggproto("GeomLinerange", Geom,
-  default_aes = aes(colour = "black", linewidth = 0.5, linetype = 1, alpha = NA),
+  default_aes = aes(colour = from_theme(ink), linewidth = from_theme(thin), linetype = 1, alpha = NA),
 
   draw_key = draw_key_linerange,
 

R/geom-path.R

@@ -130,7 +130,7 @@ geom_path <- function(mapping = NULL, data = NULL,
 GeomPath <- ggproto("GeomPath", Geom,
   required_aes = c("x", "y"),
 
-  default_aes = aes(colour = "black", linewidth = 0.5, linetype = 1, alpha = NA),
+  default_aes = aes(colour = from_theme(ink), linewidth = from_theme(thin), linetype = 1, alpha = NA),
 
   non_missing_aes = c("linewidth", "colour", "linetype"),
 

R/geom-point.R

@@ -135,7 +135,8 @@ GeomPoint <- ggproto("GeomPoint", Geom,
   required_aes = c("x", "y"),
   non_missing_aes = c("size", "shape", "colour"),
   default_aes = aes(
-    shape = 19, colour = "black", size = 1.5, fill = NA,
+    shape = from_theme(pointshape),
+    colour = from_theme(ink), size = from_theme(pointsize), fill = NA,
     alpha = NA, stroke = 0.5
   ),
 

R/geom-pointrange.R

@@ -30,8 +30,11 @@ geom_pointrange <- function(mapping = NULL, data = NULL,
 #' @usage NULL
 #' @export
 GeomPointrange <- ggproto("GeomPointrange", Geom,
-  default_aes = aes(colour = "black", size = 0.5, linewidth = 0.5, linetype = 1,
-                    shape = 19, fill = NA, alpha = NA, stroke = 1),
+  default_aes = aes(
+    colour = from_theme(ink), size = from_theme(pointsize / 3),
+    linewidth = from_theme(thin), linetype = 1,
+    shape = 19, fill = NA, alpha = NA, stroke = 1
+  ),
 
   draw_key = draw_key_pointrange,
 

R/geom-polygon.R

@@ -175,8 +175,12 @@ GeomPolygon <- ggproto("GeomPolygon", Geom,
     }
   },
 
-  default_aes = aes(colour = NA, fill = "grey20", linewidth = 0.5, linetype = 1,
-    alpha = NA, subgroup = NULL),
+  default_aes = aes(
+    colour = NA,
+    fill = from_theme(col_mix(ink, paper, 0.2)),
+    linewidth = from_theme(thin), linetype = 1,
+    alpha = NA, subgroup = NULL
+  ),
 
   handle_na = function(data, params) {
     data

R/geom-quantile.R

@@ -66,7 +66,7 @@ geom_quantile <- function(mapping = NULL, data = NULL,
 #' @include geom-path.R
 GeomQuantile <- ggproto("GeomQuantile", GeomPath,
   default_aes = defaults(
-    aes(weight = 1, colour = "#3366FF", linewidth = 0.5),
+    aes(weight = 1, colour = from_theme(accent), linewidth = from_theme(thin)),
     GeomPath$default_aes
   )
 )

R/geom-raster.R

@@ -44,7 +44,7 @@ geom_raster <- function(mapping = NULL, data = NULL,
 #' @usage NULL
 #' @export
 GeomRaster <- ggproto("GeomRaster", Geom,
-  default_aes = aes(fill = "grey20", alpha = NA),
+  default_aes = aes(fill = from_theme(col_mix(ink, paper, 0.2)), alpha = NA),
   non_missing_aes = c("fill", "xmin", "xmax", "ymin", "ymax"),
   required_aes = c("x", "y"),
 

R/geom-rect.R

@@ -28,8 +28,11 @@ geom_rect <- function(mapping = NULL, data = NULL,
 #' @usage NULL
 #' @export
 GeomRect <- ggproto("GeomRect", Geom,
-  default_aes = aes(colour = NA, fill = "grey35", linewidth = 0.5, linetype = 1,
-    alpha = NA),
+  default_aes = aes(
+    colour = NA, fill = from_theme(col_mix(ink, paper, 0.35)),
+    linewidth = from_theme(thin), linetype = 1,
+    alpha = NA
+  ),
 
   required_aes = c("xmin", "xmax", "ymin", "ymax"),