Allow default geom aesthetics to be set from theme

NAMESPACE

@@ -303,6 +303,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)

R/annotation-logticks.r

@@ -200,7 +200,12 @@ GeomLogticks <- ggproto("GeomLogticks", Geom,
     gTree(children = do.call("gList", ticks))
   },
 
-  default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = 1)
+  default_aes = aes(
+    colour = from_theme("colour"),
+    size = 0.5,
+    linetype = 1,
+    alpha = NA
+  )
 )
 
 

R/geom-.r

@@ -108,12 +108,24 @@ Geom <- ggproto("Geom",
 
   setup_data = function(data, params) data,
 
+  # evaluate defaults according to theme
+  eval_defaults = function(self, theme) {
+
+    if (length(theme) == 0) theme <- theme_get()
+
+    from_theme <- function(aes, element = "geom") {
+      theme[[element]][[aes]]
+    }
+
+    lapply(self$default_aes, rlang::eval_tidy, data = list(from_theme = from_theme))
+  },
+
   # Combine data with defaults and set aesthetics from parameters
-  use_defaults = function(self, data, params = list(), modifiers = aes()) {
+  use_defaults = function(self, data, defaults, params = list(), modifiers = aes()) {
     # Fill in missing aesthetics with their defaults
-    missing_aes <- setdiff(names(self$default_aes), names(data))
+    missing_aes <- setdiff(names(defaults), names(data))
+    missing_eval <- lapply(defaults[missing_aes], eval_tidy)
 
-    missing_eval <- lapply(self$default_aes[missing_aes], eval_tidy)
     # Needed for geoms with defaults set to NULL (e.g. GeomSf)
     missing_eval <- compact(missing_eval)
 

R/geom-abline.r

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

R/geom-boxplot.r

@@ -281,8 +281,15 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
 
   draw_key = draw_key_boxplot,
 
-  default_aes = aes(weight = 1, colour = "grey20", fill = "white", size = 0.5,
-    alpha = NA, shape = 19, linetype = "solid"),
+  default_aes = aes(
+    weight = 1,
+    colour = from_theme("colour_1") ,
+    fill = from_theme("fill_1"),
+    size = 0.5,
+    alpha = NA,
+    shape = 19,
+    linetype = "solid"
+   ),
 
   required_aes = c("x|y", "lower|xlower", "upper|xupper", "middle|xmiddle", "ymin|xmin", "ymax|xmax")
 )

R/geom-contour.r

@@ -117,7 +117,7 @@ geom_contour_filled <- function(mapping = NULL, data = NULL,
 GeomContour <- ggproto("GeomContour", GeomPath,
   default_aes = aes(
     weight = 1,
-    colour = "#3366FF",
+    colour = from_theme("colour_2"),
     size = 0.5,
     linetype = 1,
     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, size = 0.5, linetype = 1,
-    alpha = NA),
+  default_aes = aes(
+    colour = from_theme("colour"),
+    fill = NA,
+    size = 0.5,
+    linetype = 1,
+    alpha = NA
+  ),
 
   required_aes = c("x", "y", "ymin|xmin", "ymax|xmax"),
 

R/geom-curve.r

@@ -40,7 +40,13 @@ geom_curve <- function(mapping = NULL, data = NULL,
 #' @usage NULL
 #' @export
 GeomCurve <- ggproto("GeomCurve", GeomSegment,
-  default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA),
+  default_aes = aes(
+    colour = from_theme("colour"),
+    size = 0.5,
+    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

@@ -13,7 +13,11 @@
 #' @rdname update_defaults
 update_geom_defaults <- function(geom, new) {
   g <- check_subclass(geom, "Geom", env = parent.frame())
-  old <- g$default_aes
+
+  env <-  new_data_mask(new.env())
+  env$theme <- theme_get()
+  old <- rlang::eval_tidy(g$default_aes, env)
+
   g$default_aes <- defaults(rename_aes(new), old)
   invisible()
 }

R/geom-density.r

@@ -80,8 +80,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 = "black", alpha = NA),
-    GeomArea$default_aes
+  default_aes = aes(
+    fill = NA,
+    weight = 1,
+    colour = from_theme("colour"),
+    alpha = NA,
+    size = 0.5,
+    linetype = 1
   )
 )

R/geom-density2d.r

@@ -82,5 +82,10 @@ geom_density2d <- geom_density_2d
 #' @usage NULL
 #' @export
 GeomDensity2d <- ggproto("GeomDensity2d", GeomPath,
-  default_aes = aes(colour = "#3366FF", size = 0.5, linetype = 1, alpha = NA)
+  default_aes = aes(
+    colour = from_theme("colour_2"),
+    size = 0.5,
+    linetype = 1,
+    alpha = NA
+  )
 )

R/geom-dotplot.r

@@ -178,7 +178,13 @@ 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"),
+  default_aes = aes(
+    colour = from_theme("colour"),
+    fill = from_theme("colour"),
+    alpha = NA,
+    stroke = 1,
+    linetype = "solid"
+  ),
 
   setup_data = function(data, params) {
     data$width <- data$width %||%

R/geom-errorbar.r

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

R/geom-errorbarh.r

@@ -48,8 +48,13 @@ geom_errorbarh <- function(mapping = NULL, data = NULL,
 #' @usage NULL
 #' @export
 GeomErrorbarh <- ggproto("GeomErrorbarh", Geom,
-  default_aes = aes(colour = "black", size = 0.5, linetype = 1, height = 0.5,
-    alpha = NA),
+  default_aes = aes(
+    colour = from_theme("colour"),
+    size = 0.5,
+    linetype = 1,
+    height = 0.5,
+    alpha = NA
+  ),
 
   draw_key = draw_key_path,
 
@@ -67,7 +72,7 @@ GeomErrorbarh <- ggproto("GeomErrorbarh", Geom,
   draw_panel = function(data, panel_params, coord, height = NULL) {
     GeomPath$draw_panel(new_data_frame(list(
       x = as.vector(rbind(data$xmax, data$xmax, NA, data$xmax, data$xmin, NA, data$xmin, data$xmin)),
-      y = as.vector(rbind(data$ymin, data$ymax, NA, data$y,    data$y,    NA, data$ymin, data$ymax)),
+      y = as.vector(rbind(data$ymin, data$ymax, NA, data$y, data$y, NA, data$ymin, data$ymax)),
       colour = rep(data$colour, each = 8),
       alpha = rep(data$alpha, each = 8),
       size = rep(data$size, each = 8),

R/geom-hex.r

@@ -75,7 +75,7 @@ GeomHex <- ggproto("GeomHex", Geom,
 
   default_aes = aes(
     colour = NA,
-    fill = "grey50",
+    fill = from_theme("fill"),
     size = 0.5,
     linetype = 1,
     alpha = NA

R/geom-hline.r

@@ -55,7 +55,13 @@ GeomHline <- ggproto("GeomHline", Geom,
     GeomSegment$draw_panel(unique(data), panel_params, coord)
   },
 
-  default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA),
+  default_aes = aes(
+    colour = from_theme("colour"),
+    size = 0.5,
+    linetype = 1,
+    alpha = NA
+  ),
+
   required_aes = "yintercept",
 
   draw_key = draw_key_path

R/geom-label.R

@@ -51,10 +51,17 @@ 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,
-    lineheight = 1.2
-  ),
+    colour = from_theme("colour", element = "text"),
+    fill = from_theme("fill_1"),
+    size =  3.88,
+    angle = 0,
+    hjust = 0.5,
+    vjust = 0.5,
+    alpha = NA,
+    family = from_theme("family", element = "text"),
+    fontface = from_theme("face", element = "text"),
+    lineheight = from_theme("lineheight", element = "text")
+   ),
 
   draw_panel = function(self, data, panel_params, coord, parse = FALSE,
                         na.rm = FALSE,

R/geom-linerange.r

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

R/geom-path.r

@@ -130,7 +130,12 @@ geom_path <- function(mapping = NULL, data = NULL,
 GeomPath <- ggproto("GeomPath", Geom,
   required_aes = c("x", "y"),
 
-  default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA),
+  default_aes = aes(
+    colour = from_theme("colour"),
+    size = 0.5,
+    linetype = 1,
+    alpha = NA
+  ),
 
   handle_na = function(data, params) {
     # Drop missing values at the start or end of a line - can't drop in the

R/geom-point.r

@@ -108,8 +108,12 @@ 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,
-    alpha = NA, stroke = 0.5
+    shape = 19,
+    colour = from_theme("colour"),
+    size = 1.5,
+    fill = NA,
+    alpha = NA,
+    stroke = 0.5
   ),
 
   draw_panel = function(data, panel_params, coord, na.rm = FALSE) {

R/geom-pointrange.r

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

R/geom-polygon.r

@@ -167,8 +167,14 @@ GeomPolygon <- ggproto("GeomPolygon", Geom,
 
   },
 
-  default_aes = aes(colour = "NA", fill = "grey20", size = 0.5, linetype = 1,
-    alpha = NA, subgroup = NULL),
+  default_aes = aes(
+    colour = NA,
+    fill = from_theme("fill"),
+    size = 0.5,
+    linetype = 1,
+    alpha = NA,
+    subgroup = NULL
+  ),
 
   handle_na = function(data, params) {
     data

R/geom-quantile.r

@@ -61,8 +61,11 @@ geom_quantile <- function(mapping = NULL, data = NULL,
 #' @export
 #' @include geom-path.r
 GeomQuantile <- ggproto("GeomQuantile", GeomPath,
-  default_aes = defaults(
-    aes(weight = 1, colour = "#3366FF", size = 0.5),
-    GeomPath$default_aes
+  default_aes = aes(
+    weight = 1,
+    colour = from_theme("colour_2"),
+    size = 0.5,
+    linetype = 1,
+    alpha = NA
   )
 )

R/geom-raster.r

@@ -44,7 +44,10 @@ 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("fill"),
+    alpha = NA
+  ),
   non_missing_aes = c("fill", "xmin", "xmax", "ymin", "ymax"),
   required_aes = c("x", "y"),
 
@@ -80,7 +83,7 @@ GeomRaster <- ggproto("GeomRaster", Geom,
   },
 
   draw_panel = function(data, panel_params, coord, interpolate = FALSE,
-                        hjust = 0.5, vjust = 0.5) {
+                          hjust = 0.5, vjust = 0.5) {
     if (!inherits(coord, "CoordCartesian")) {
       abort("geom_raster only works with Cartesian coordinates")
     }

R/geom-rect.r

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