Allow default geom aesthetics to be set from theme

NAMESPACE

@@ -278,6 +278,7 @@ export(draw_key_vline)
 export(draw_key_vpath)
 export(dup_axis)
 export(element_blank)
+export(element_geom)
 export(element_grob)
 export(element_line)
 export(element_rect)

R/annotation-logticks.r

@@ -200,7 +200,10 @@ GeomLogticks <- ggproto("GeomLogticks", Geom,
     gTree(children = do.call("gList", ticks))
   },
 
-  default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = 1)
+  default_aes = expr(aes(
+    colour = theme$geom$colour, size = 0.5, linetype = 1,
+    alpha = theme$geom$alpha
+  ))
 )
 
 

R/geom-.r

@@ -107,11 +107,18 @@ 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()) {
+  use_defaults = function(self, data, params = list(), theme) {
+
+    # evaluates defaults given plot theme
+    if (length(theme) == 0) theme <- theme_grey()
+    env <- new.env()
+    env$theme <- theme
+    defaults <- rlang::eval_tidy(self$default_aes, env)
+
     # 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(self$default_aes[missing_aes], rlang::eval_tidy)
+    missing_eval <- lapply(defaults[missing_aes], rlang::eval_tidy)
     # Needed for geoms with defaults set to NULL (e.g. GeomSf)
     missing_eval <- compact(missing_eval)
 

R/geom-abline.r

@@ -121,7 +121,12 @@ 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 = expr(aes(
+    colour = theme$geom$colour,
+    size = 0.5, linetype = 1,
+    alpha = theme$geom$alpha
+  )),
+
   required_aes = c("slope", "intercept"),
 
   draw_key = draw_key_abline

R/geom-boxplot.r

@@ -253,8 +253,11 @@ 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 = expr(aes(
+    weight = 1, colour = theme$geom$colour.accent1 ,
+    fill = theme$geom$fill.accent, size = 0.5,
+    alpha = theme$geom$alpha, shape = 19, linetype = "solid"
+  )),
 
   required_aes = c("x", "lower", "upper", "middle", "ymin", "ymax")
 )

R/geom-contour.r

@@ -73,6 +73,8 @@ geom_contour <- function(mapping = NULL, data = NULL,
 #' @export
 #' @include geom-path.r
 GeomContour <- ggproto("GeomContour", GeomPath,
-  default_aes = aes(weight = 1, colour = "#3366FF", size = 0.5, linetype = 1,
-    alpha = NA)
+  default_aes = expr(aes(
+    weight = 1, colour = theme$geom$colour.accent2,
+    size = 0.5, linetype = 1, alpha = theme$geom$alpha
+  ))
 )

R/geom-crossbar.r

@@ -32,8 +32,10 @@ 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 = expr(aes(
+    colour = theme$geom$colour, fill = NA, size = 0.5,
+    linetype = 1, alpha = theme$geom$alpha
+  )),
 
   required_aes = c("x", "y", "ymin", "ymax"),
 

R/geom-curve.r

@@ -40,7 +40,10 @@ 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 = expr(aes(
+    colour = theme$geom$colour, size = 0.5, linetype = 1,
+    alpha = theme$geom$alpha
+  )),
   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.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

@@ -73,8 +73,8 @@ 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 = expr(aes(
+    fill = NA, weight = 1, colour = theme$geom$colour,
+    alpha = theme$geom$alpha, size = 0.5, linetype = 1
+  ))
 )

R/geom-density2d.r

@@ -73,5 +73,8 @@ 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 = expr(aes(
+    colour = theme$geom$colour.accent2,
+    size = 0.5, linetype = 1, alpha = theme$geom$alpha
+  ))
 )

R/geom-dotplot.r

@@ -175,7 +175,11 @@ 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 = expr(aes(
+    colour = theme$geom$colour,
+    fill = theme$geom$colour,
+    alpha = theme$geom$alpha
+  )),
 
   setup_data = function(data, params) {
     data$width <- data$width %||%

R/geom-errorbar.r

@@ -26,8 +26,11 @@ 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 = expr(aes(
+    colour = theme$geom$colour,
+    size = 0.5, linetype = 1, width = 0.5,
+    alpha = theme$geom$alpha
+  )),
 
   draw_key = draw_key_path,
 

R/geom-errorbarh.r

@@ -48,8 +48,11 @@ 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 = expr(aes(
+    colour = theme$geom$colour,
+    size = 0.5, linetype = 1, height = 0.5,
+    alpha = theme$geom$alpha
+  )),
 
   draw_key = draw_key_path,
 
@@ -67,7 +70,7 @@ GeomErrorbarh <- ggproto("GeomErrorbarh", Geom,
   draw_panel = function(data, panel_params, coord, height = NULL) {
     GeomPath$draw_panel(data.frame(
       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

@@ -73,13 +73,13 @@ GeomHex <- ggproto("GeomHex", Geom,
 
   required_aes = c("x", "y"),
 
-  default_aes = aes(
+  default_aes = expr(aes(
     colour = NA,
-    fill = "grey50",
+    fill = theme$geom$fill,
     size = 0.5,
     linetype = 1,
-    alpha = NA
-  ),
+    alpha = theme$geom$alpha
+  )),
 
   draw_key = draw_key_polygon
 )

R/geom-hline.r

@@ -47,7 +47,11 @@ 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 = expr(aes(
+    colour = theme$geom$colour,
+    size = 0.5, linetype = 1,
+    alpha = theme$geom$alpha
+  )),
   required_aes = "yintercept",
 
   draw_key = draw_key_path

R/geom-label.R

@@ -50,11 +50,12 @@ geom_label <- function(mapping = NULL, data = NULL,
 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
-  ),
+  default_aes = expr(aes(
+    colour = theme$text$colour, fill = theme$geom$fill.accent,
+    size =  3.88, angle = 0, hjust = 0.5, vjust = 0.5,
+    alpha = theme$geom$alpha, family = theme$text$family,
+    fontface = theme$text$face, lineheight = theme$text$lineheight
+  )),
 
   draw_panel = function(self, data, panel_params, coord, parse = FALSE,
                         na.rm = FALSE,

R/geom-linerange.r

@@ -83,7 +83,11 @@ 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 = expr(aes(
+    colour = theme$geom$colour,
+    size = 0.5, linetype = 1,
+    alpha = theme$geom$alpha
+  )),
 
   draw_key = draw_key_vpath,
 

R/geom-path.r

@@ -123,7 +123,10 @@ 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 = expr(aes(
+    colour = theme$geom$colour, size = 0.5, linetype = 1,
+    alpha = theme$geom$alpha
+  )),
 
   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

@@ -110,10 +110,10 @@ geom_point <- function(mapping = NULL, data = NULL,
 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
-  ),
+  default_aes = expr(aes(
+    shape = 19, colour = theme$geom$colour, size = 1.5,
+    fill = NA, alpha = theme$geom$alpha, stroke = 0.5
+  )),
 
   draw_panel = function(data, panel_params, coord, na.rm = FALSE) {
     if (is.character(data$shape)) {

R/geom-pointrange.r

@@ -28,8 +28,13 @@ 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 = expr(aes(
+    colour = theme$geom$colour,
+    size = 0.5, linetype = 1,
+    shape = 19, fill = NA,
+    alpha = theme$geom$alpha,
+    stroke = 1
+  )),
 
   draw_key = draw_key_pointrange,
 

R/geom-polygon.r

@@ -105,8 +105,12 @@ GeomPolygon <- ggproto("GeomPolygon", Geom,
     )
   },
 
-  default_aes = aes(colour = "NA", fill = "grey20", size = 0.5, linetype = 1,
-    alpha = NA),
+  default_aes = expr(aes(
+    colour = NA,
+    fill = theme$geom$fill,
+    size = 0.5, linetype = 1,
+    alpha = theme$geom$alpha
+  )),
 
   handle_na = function(data, params) {
     data

R/geom-quantile.r

@@ -61,8 +61,8 @@ 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 = expr(aes(
+    weight = 1, colour = theme$geom$colour.accent2, size = 0.5, linetype = 1,
+    alpha = theme$geom$alpha
+  ))
 )

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 = expr(aes(fill = theme$geom$fill, alpha = theme$geom$alpha)),
   non_missing_aes = "fill",
   required_aes = c("x", "y"),
 

R/geom-rect.r

@@ -26,8 +26,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 = expr(aes(
+    colour = NA,
+    fill = theme$geom$fill,
+    size = 0.5,
+    linetype = 1,
+    alpha = theme$geom$alpha
+  )),
 
   required_aes = c("xmin", "xmax", "ymin", "ymax"),
 

R/geom-ribbon.r

@@ -57,8 +57,10 @@ geom_ribbon <- function(mapping = NULL, data = NULL,
 #' @usage NULL
 #' @export
 GeomRibbon <- ggproto("GeomRibbon", Geom,
-  default_aes = aes(colour = NA, fill = "grey20", size = 0.5, linetype = 1,
-    alpha = NA),
+  default_aes = expr(aes(
+    colour = NA, fill = theme$geom$fill,
+    size = 0.5, linetype = 1, alpha = theme$geom$alpha
+  )),
 
   required_aes = c("x", "ymin", "ymax"),
 
@@ -131,8 +133,10 @@ geom_area <- function(mapping = NULL, data = NULL, stat = "identity",
 #' @usage NULL
 #' @export
 GeomArea <- ggproto("GeomArea", GeomRibbon,
-  default_aes = aes(colour = NA, fill = "grey20", size = 0.5, linetype = 1,
-    alpha = NA),
+  default_aes = expr(aes(
+    colour = NA, fill = theme$geom$fill,
+    size = 0.5, linetype = 1, alpha = theme$geom$alpha
+  )),
 
   required_aes = c("x", "y"),
 

R/geom-rug.r

@@ -106,7 +106,11 @@ GeomRug <- ggproto("GeomRug", Geom,
     gTree(children = do.call("gList", rugs))
   },
 
-  default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA),
+  default_aes = expr(aes(
+    colour = theme$geom$colour,
+    size = 0.5, linetype = 1,
+    alpha = theme$geom$alpha
+  )),
 
   draw_key = draw_key_path
 )