Inheritance of theme-based aesthetics (#6285)

* allow unregistered `geom.*` elements in theme

* allow inheritance of geom elements

* add test

* add colour/fill to element_geom

* use ink/paper bypass in defaults

* include default values in 'Aesthetics' section

* document

Author: teunbrand

R/annotation-logticks.R

@@ -229,7 +229,7 @@ GeomLogticks <- ggproto("GeomLogticks", Geom,
   },
 
   default_aes = aes(
-    colour = from_theme(ink),
+    colour = from_theme(colour %||% ink),
     linewidth = from_theme(linewidth),
     linetype = from_theme(linetype),
     alpha = 1

R/geom-.R

@@ -133,7 +133,7 @@ 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)
+    themed_defaults <- eval_from_theme(default_aes, theme, class(self))
     default_aes[names(themed_defaults)] <- themed_defaults
 
     # Mark staged/scaled defaults as modifier (#6135)
@@ -239,13 +239,33 @@ Geom <- ggproto("Geom",
 #' @rdname is_tests
 is.geom <- function(x) inherits(x, "Geom")
 
-eval_from_theme <- function(aesthetics, theme) {
+eval_from_theme <- function(aesthetics, theme, class = NULL) {
   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)
+
+  element <- calc_element("geom", theme) %||% .default_geom_element
+  class <- setdiff(class, c("Geom", "ggproto", "gg"))
+
+  if (length(class) > 0) {
+
+    # CamelCase to dot.case
+    class <- gsub("([A-Za-z])([A-Z])([a-z])", "\\1.\\2\\3", class)
+    class <- gsub("([a-z])([A-Z])", "\\1.\\2", class)
+    class <- to_lower_ascii(class)
+
+    class <- class[class %in% names(theme)]
+
+    # Inherit up to parent geom class
+    if (length(class) > 0) {
+      for (cls in rev(class)) {
+        element <- combine_elements(theme[[cls]], element)
+      }
+    }
+  }
+
+  lapply(aesthetics[themed], eval_tidy, data = element)
 }
 
 #' Graphical units

R/geom-abline.R

@@ -147,7 +147,7 @@ GeomAbline <- ggproto("GeomAbline", Geom,
   },
 
   default_aes = aes(
-    colour = from_theme(ink),
+    colour = from_theme(colour %||% ink),
     linewidth = from_theme(linewidth),
     linetype = from_theme(linetype),
     alpha = NA

R/geom-boxplot.R

@@ -395,8 +395,8 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
   draw_key = draw_key_boxplot,
 
   default_aes = aes(
-    weight = 1, colour = from_theme(col_mix(ink, paper, 0.2)),
-    fill = from_theme(paper), size = from_theme(pointsize),
+    weight = 1, colour = from_theme(colour %||% col_mix(ink, paper, 0.2)),
+    fill = from_theme(fill %||% paper), size = from_theme(pointsize),
     alpha = NA, shape = from_theme(pointshape), linetype = from_theme(bordertype),
     linewidth = from_theme(borderwidth),
     width = 0.9

R/geom-contour.R

@@ -124,13 +124,7 @@ geom_contour_filled <- function(mapping = NULL, data = NULL,
 #' @export
 #' @include geom-path.R
 GeomContour <- ggproto("GeomContour", GeomPath,
-  default_aes = aes(
-    weight = 1,
-    colour = from_theme(accent),
-    linewidth = from_theme(linewidth),
-    linetype = from_theme(linetype),
-    alpha = NA
-  )
+  default_aes = aes(weight = 1, !!!GeomPath$default_aes)
 )
 
 #' @rdname ggplot2-ggproto

R/geom-crossbar.R

@@ -79,8 +79,8 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom,
   },
 
   default_aes = aes(
-    colour = from_theme(ink),
-    fill = NA,
+    colour = from_theme(colour %||% ink),
+    fill = from_theme(fill %||% NA),
     linewidth = from_theme(borderwidth),
     linetype = from_theme(bordertype),
     alpha = NA

R/geom-curve.R

@@ -41,13 +41,6 @@ geom_curve <- function(mapping = NULL, data = NULL,
 #' @export
 GeomCurve <- ggproto("GeomCurve", GeomSegment,
 
-  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-density.R

@@ -92,8 +92,12 @@ geom_density <- function(mapping = NULL, data = NULL,
 #' @export
 #' @include geom-ribbon.R
 GeomDensity <- ggproto("GeomDensity", GeomArea,
-  default_aes = defaults(
-    aes(fill = NA, weight = 1, colour = from_theme(ink), alpha = NA),
-    GeomArea$default_aes
+  default_aes = aes(
+    colour = from_theme(colour %||% ink),
+    fill   = from_theme(fill %||% NA),
+    weight = 1,
+    alpha  = NA,
+    linewidth = from_theme(borderwidth),
+    linetype  = from_theme(bordertype)
   )
 )

R/geom-density2d.R

@@ -107,7 +107,7 @@ geom_density2d <- geom_density_2d
 #' @export
 GeomDensity2d <- ggproto("GeomDensity2d", GeomPath,
   default_aes = aes(
-    colour = from_theme(accent),
+    colour = from_theme(colour %||% accent),
     linewidth = from_theme(linewidth),
     linetype = from_theme(linetype),
     alpha = NA

R/geom-dotplot.R

@@ -189,8 +189,8 @@ GeomDotplot <- ggproto("GeomDotplot", Geom,
   non_missing_aes = c("size", "shape"),
 
   default_aes = aes(
-    colour = from_theme(ink),
-    fill = from_theme(ink),
+    colour = from_theme(colour %||% ink),
+    fill = from_theme(fill %||% ink),
     alpha = NA,
     stroke = from_theme(borderwidth * 2),
     linetype = from_theme(linetype),