diff --git a/NAMESPACE b/NAMESPACE index f5f7149913..00aef75d1d 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/annotation-logticks.r b/R/annotation-logticks.r index 909c01684c..162cf79e08 100644 --- a/R/annotation-logticks.r +++ b/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 + ) ) diff --git a/R/geom-.r b/R/geom-.r index 5a84dcc4dc..830dcaee9a 100644 --- a/R/geom-.r +++ b/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) diff --git a/R/geom-abline.r b/R/geom-abline.r index 60161c1fc1..438630a9c2 100644 --- a/R/geom-abline.r +++ b/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 diff --git a/R/geom-boxplot.r b/R/geom-boxplot.r index bd3d5ed9a5..b586566122 100644 --- a/R/geom-boxplot.r +++ b/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") ) diff --git a/R/geom-contour.r b/R/geom-contour.r index 2dc81cba4a..ff50c45c57 100644 --- a/R/geom-contour.r +++ b/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 diff --git a/R/geom-crossbar.r b/R/geom-crossbar.r index 05fa058460..44ce8634ed 100644 --- a/R/geom-crossbar.r +++ b/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"), diff --git a/R/geom-curve.r b/R/geom-curve.r index 9a44a85be3..b0a46d358e 100644 --- a/R/geom-curve.r +++ b/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) { diff --git a/R/geom-defaults.r b/R/geom-defaults.r index 1fefa8c66e..4b82b2245a 100644 --- a/R/geom-defaults.r +++ b/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() } diff --git a/R/geom-density.r b/R/geom-density.r index ce7b8ce7b3..fc83b2806d 100644 --- a/R/geom-density.r +++ b/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 ) ) diff --git a/R/geom-density2d.r b/R/geom-density2d.r index 2fb8cb5967..a54548bd73 100644 --- a/R/geom-density2d.r +++ b/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 + ) ) diff --git a/R/geom-dotplot.r b/R/geom-dotplot.r index d227ef22a1..ea8f012b41 100644 --- a/R/geom-dotplot.r +++ b/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 %||% diff --git a/R/geom-errorbar.r b/R/geom-errorbar.r index 4840d75d10..9ba57d7a29 100644 --- a/R/geom-errorbar.r +++ b/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, diff --git a/R/geom-errorbarh.r b/R/geom-errorbarh.r index e23898d12e..26e21f8a23 100644 --- a/R/geom-errorbarh.r +++ b/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), diff --git a/R/geom-hex.r b/R/geom-hex.r index 683109eab2..07ac4a3f9b 100644 --- a/R/geom-hex.r +++ b/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 diff --git a/R/geom-hline.r b/R/geom-hline.r index d242f74b08..04298da89d 100644 --- a/R/geom-hline.r +++ b/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 diff --git a/R/geom-label.R b/R/geom-label.R index 826d16a72b..c480fe7874 100644 --- a/R/geom-label.R +++ b/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, diff --git a/R/geom-linerange.r b/R/geom-linerange.r index 005f93de3a..2b37b2f0f6 100644 --- a/R/geom-linerange.r +++ b/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, diff --git a/R/geom-path.r b/R/geom-path.r index b8539d9d3f..8a50085bc5 100644 --- a/R/geom-path.r +++ b/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 diff --git a/R/geom-point.r b/R/geom-point.r index 88e1e6655f..c7ef0aff8a 100644 --- a/R/geom-point.r +++ b/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) { diff --git a/R/geom-pointrange.r b/R/geom-pointrange.r index 5b018c1253..1410fb3637 100644 --- a/R/geom-pointrange.r +++ b/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, diff --git a/R/geom-polygon.r b/R/geom-polygon.r index 9b5f1bb291..5d70a7c03c 100644 --- a/R/geom-polygon.r +++ b/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 diff --git a/R/geom-quantile.r b/R/geom-quantile.r index 85729b42d0..e381f3674f 100644 --- a/R/geom-quantile.r +++ b/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 ) ) diff --git a/R/geom-raster.r b/R/geom-raster.r index a9f4b61a8d..32348e9434 100644 --- a/R/geom-raster.r +++ b/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") } diff --git a/R/geom-rect.r b/R/geom-rect.r index 95cf0383e6..7c3b899c2d 100644 --- a/R/geom-rect.r +++ b/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"), diff --git a/R/geom-ribbon.r b/R/geom-ribbon.r index f63199f6a4..56a271cdc5 100644 --- a/R/geom-ribbon.r +++ b/R/geom-ribbon.r @@ -73,8 +73,13 @@ 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 = aes( + colour = NA, + fill = from_theme("fill"), + size = 0.5, + linetype = 1, + alpha = NA + ), required_aes = c("x|y", "ymin|xmin", "ymax|xmax"), @@ -204,8 +209,13 @@ 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 = aes( + colour = NA, + fill = from_theme("fill"), + size = 0.5, + linetype = 1, + alpha = NA + ), required_aes = c("x", "y"), diff --git a/R/geom-rug.r b/R/geom-rug.r index b64b530bec..7dec26fe21 100644 --- a/R/geom-rug.r +++ b/R/geom-rug.r @@ -145,7 +145,12 @@ GeomRug <- ggproto("GeomRug", Geom, gTree(children = do.call("gList", rugs)) }, - 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_path ) diff --git a/R/geom-segment.r b/R/geom-segment.r index 2fd48da8a0..81d3c71a73 100644 --- a/R/geom-segment.r +++ b/R/geom-segment.r @@ -100,8 +100,15 @@ geom_segment <- function(mapping = NULL, data = NULL, #' @export GeomSegment <- ggproto("GeomSegment", Geom, required_aes = c("x", "y", "xend", "yend"), + non_missing_aes = c("linetype", "size", "shape"), - 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, arrow = NULL, arrow.fill = NULL, lineend = "butt", linejoin = "round", na.rm = FALSE) { diff --git a/R/geom-sf.R b/R/geom-sf.R index 56e156f1aa..8c8a2d4797 100644 --- a/R/geom-sf.R +++ b/R/geom-sf.R @@ -97,20 +97,40 @@ GeomSf <- ggproto("GeomSf", Geom, stroke = 0.5 ), - draw_panel = function(data, panel_params, coord, legend = NULL, + draw_layer = function(self, data, params, layout, coord, theme) { + if (empty(data)) { + n <- if (is.factor(data$PANEL)) nlevels(data$PANEL) else 1L + return(rep(list(zeroGrob()), n)) + } + + # Trim off extra parameters + params <- params[intersect(names(params), self$parameters())] + + args <- c(list(quote(data), quote(panel_params), quote(coord)), quote(theme), params) + lapply(split(data, data$PANEL), function(data) { + if (empty(data)) return(zeroGrob()) + + panel_params <- layout$panel_params[[data$PANEL[1]]] + do.call(self$draw_panel, args) + }) + }, + + draw_panel = function(data, panel_params, coord, theme, legend = NULL, lineend = "butt", linejoin = "round", linemitre = 10, na.rm = TRUE) { + if (!inherits(coord, "CoordSf")) { abort("geom_sf() must be used with coord_sf()") } # Need to refactor this to generate one grob per geometry type coord <- coord$transform(data, panel_params) - sf_grob(coord, lineend = lineend, linejoin = linejoin, linemitre = linemitre, na.rm = na.rm) + sf_grob(coord, theme, lineend = lineend, linejoin = linejoin, linemitre = linemitre, na.rm = na.rm) }, draw_key = function(data, params, size) { - data <- modify_list(default_aesthetics(params$legend), data) + ## TODO: refactor default_aesthetics & test + # data <- modify_list(default_aesthetics(params$legend), data) if (params$legend == "point") { draw_key_point(data, params, size) } else if (params$legend == "line") { @@ -121,17 +141,29 @@ GeomSf <- ggproto("GeomSf", Geom, } ) -default_aesthetics <- function(type) { - if (type == "point") { - GeomPoint$default_aes - } else if (type == "line") { - GeomLine$default_aes - } else { - modify_list(GeomPolygon$default_aes, list(fill = "grey90", colour = "grey35")) - } -} +## TODO: refactor & test +# default_aesthetics <- function(type) { +# +# from_theme <- function(aes, element = "geom") { +# theme[[element]][[aes]] +# } +# +# +# if (type == "point") { +# defaults <- GeomPoint$default_aes +# } else if (type == "line") { +# defaults <- GeomLine$default_aes +# } else { +# defaults <- modify_list(GeomPolygon$default_aes, +# list(fill = from_theme("fill"), +# colour = from_theme("colour"))) +# } +# +# lapply(defaults, rlang::eval_tidy, data = list(from_theme = from_theme)) +# +# } -sf_grob <- function(x, lineend = "butt", linejoin = "round", linemitre = 10, na.rm = TRUE) { +sf_grob <- function(x, theme, lineend = "butt", linejoin = "round", linemitre = 10, na.rm = TRUE) { type <- sf_types[sf::st_geometry_type(x$geometry)] is_point <- type == "point" is_line <- type == "line" @@ -152,10 +184,16 @@ sf_grob <- function(x, lineend = "butt", linejoin = "round", linemitre = 10, na. type_ind <- type_ind[!remove] is_collection <- is_collection[!remove] } + + from_theme <- function(aes, element = "geom") { + theme[[element]][[aes]] + } + defaults <- list( GeomPoint$default_aes, GeomLine$default_aes, - modify_list(GeomPolygon$default_aes, list(fill = "grey90", colour = "grey35")) + modify_list(GeomPolygon$default_aes, list(fill = from_theme("fill"), + colour = from_theme("colour"))) ) defaults[[4]] <- modify_list( defaults[[3]], @@ -165,6 +203,8 @@ sf_grob <- function(x, lineend = "butt", linejoin = "round", linemitre = 10, na. defaults <- lapply(setNames(default_names, default_names), function(n) { unlist(lapply(defaults, function(def) def[[n]] %||% NA)) }) + defaults <- lapply(defaults, function(x) sapply(x, rlang::eval_tidy, + data = list(from_theme = from_theme))) alpha <- x$alpha %||% defaults$alpha[type_ind] col <- x$colour %||% defaults$colour[type_ind] col[is_point | is_line] <- alpha(col[is_point | is_line], alpha[is_point | is_line]) diff --git a/R/geom-smooth.r b/R/geom-smooth.r index 05bd1a8f29..ddb7d1400a 100644 --- a/R/geom-smooth.r +++ b/R/geom-smooth.r @@ -92,7 +92,6 @@ geom_smooth <- function(mapping = NULL, data = NULL, orientation = NA, show.legend = NA, inherit.aes = TRUE) { - params <- list( na.rm = na.rm, orientation = orientation, @@ -158,6 +157,12 @@ GeomSmooth <- ggproto("GeomSmooth", Geom, required_aes = c("x", "y"), optional_aes = c("ymin", "ymax"), - default_aes = aes(colour = "#3366FF", fill = "grey60", size = 1, - linetype = 1, weight = 1, alpha = 0.4) + default_aes = aes( + colour = from_theme("colour_2"), + fill = from_theme("fill"), + size = 1, + linetype = 1, + weight = 1, + alpha = 0.4 + ) ) diff --git a/R/geom-text.r b/R/geom-text.r index b745b200c4..744eacbad4 100644 --- a/R/geom-text.r +++ b/R/geom-text.r @@ -145,8 +145,7 @@ geom_text <- function(mapping = NULL, data = NULL, check_overlap = FALSE, na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) -{ + inherit.aes = TRUE) { if (!missing(nudge_x) || !missing(nudge_y)) { if (!missing(position)) { abort("You must specify either `position` or `nudge_x`/`nudge_y`.") @@ -180,12 +179,19 @@ GeomText <- ggproto("GeomText", Geom, required_aes = c("x", "y", "label"), default_aes = aes( - colour = "black", 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"), + 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(data, panel_params, coord, parse = FALSE, - na.rm = FALSE, check_overlap = FALSE) { + na.rm = FALSE, check_overlap = FALSE) { lab <- data$label if (parse) { lab <- parse_safe(as.character(lab)) @@ -201,7 +207,8 @@ GeomText <- ggproto("GeomText", Geom, textGrob( lab, - data$x, data$y, default.units = "native", + data$x, data$y, + default.units = "native", hjust = data$hjust, vjust = data$vjust, rot = data$angle, gp = gpar( diff --git a/R/geom-tile.r b/R/geom-tile.r index fb5e74b084..345fac1e27 100644 --- a/R/geom-tile.r +++ b/R/geom-tile.r @@ -96,8 +96,15 @@ GeomTile <- ggproto("GeomTile", GeomRect, ) }, - default_aes = aes(fill = "grey20", colour = NA, size = 0.1, linetype = 1, - alpha = NA, width = NA, height = NA), + default_aes = aes( + fill = from_theme("fill"), + colour = NA, + size = 0.1, + linetype = 1, + alpha = NA, + width = NA, + height = NA + ), required_aes = c("x", "y"), diff --git a/R/geom-violin.r b/R/geom-violin.r index 9afc3d4d5e..76c95632db 100644 --- a/R/geom-violin.r +++ b/R/geom-violin.r @@ -172,8 +172,8 @@ GeomViolin <- ggproto("GeomViolin", Geom, ggname("geom_violin", grobTree( GeomPolygon$draw_panel(newdata, ...), - quantile_grob) - ) + quantile_grob + )) } else { ggname("geom_violin", GeomPolygon$draw_panel(newdata, ...)) } @@ -181,8 +181,14 @@ GeomViolin <- ggproto("GeomViolin", Geom, draw_key = draw_key_polygon, - default_aes = aes(weight = 1, colour = "grey20", fill = "white", size = 0.5, - alpha = NA, linetype = "solid"), + default_aes = aes( + weight = 1, + colour = from_theme("colour_1"), + fill = from_theme("fill_1"), + size = 0.5, + alpha = NA, + linetype = "solid" + ), required_aes = c("x", "y") ) @@ -204,4 +210,3 @@ create_quantile_segment_frame <- function(data, draw_quantiles) { group = rep(ys, each = 2) )) } - diff --git a/R/geom-vline.r b/R/geom-vline.r index 3c22e0b1c9..3c64b0c0a7 100644 --- a/R/geom-vline.r +++ b/R/geom-vline.r @@ -55,7 +55,13 @@ GeomVline <- ggproto("GeomVline", 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 = "xintercept", draw_key = draw_key_vline diff --git a/R/guide-bins.R b/R/guide-bins.R index 5f243bb216..ab9da10892 100644 --- a/R/guide-bins.R +++ b/R/guide-bins.R @@ -156,10 +156,11 @@ guide_merge.bins <- function(guide, new_guide) { } #' @export -guide_geom.bins <- function(guide, layers, default_mapping) { +guide_geom.bins <- function(guide, layers, default_mapping, theme) { # arrange common data for vertical and horizontal guide guide$geoms <- lapply(layers, function(layer) { matched <- matched_aes(layer, guide, default_mapping) + defaults <- layer$geom$eval_defaults(theme = theme) # check if this layer should be included include <- include_layer_in_guide(layer, matched) @@ -173,9 +174,9 @@ guide_geom.bins <- function(guide, layers, default_mapping) { n <- vapply(layer$aes_params, length, integer(1)) params <- layer$aes_params[n == 1] - data <- layer$geom$use_defaults(guide$key[matched], params) + data <- layer$geom$use_defaults(guide$key[matched], defaults = defaults, params) } else { - data <- layer$geom$use_defaults(NULL, layer$aes_params)[rep(1, nrow(guide$key)), ] + data <- layer$geom$use_defaults(NULL, defaults = defaults, layer$aes_params)[rep(1, nrow(guide$key)), ] } # override.aes in guide_legend manually changes the geom diff --git a/R/guide-colorbar.r b/R/guide-colorbar.r index 92412e12ae..561c6b8a0d 100644 --- a/R/guide-colorbar.r +++ b/R/guide-colorbar.r @@ -242,7 +242,7 @@ guide_merge.colorbar <- function(guide, new_guide) { # this guide is not geom-based. #' @export -guide_geom.colorbar <- function(guide, layers, default_mapping) { +guide_geom.colorbar <- function(guide, layers, default_mapping, theme) { # Layers that use this guide guide_layers <- lapply(layers, function(layer) { matched <- matched_aes(layer, guide, default_mapping) diff --git a/R/guide-legend.r b/R/guide-legend.r index 86d2286729..2428c9793d 100644 --- a/R/guide-legend.r +++ b/R/guide-legend.r @@ -122,7 +122,7 @@ #' # reversed order legend #' p + guides(col = guide_legend(reverse = TRUE)) #' } -guide_legend <- function(# title +guide_legend <- function( # title title = waiver(), title.position = NULL, title.theme = NULL, @@ -150,7 +150,6 @@ guide_legend <- function(# title reverse = FALSE, order = 0, ...) { - if (!is.null(keywidth) && !is.unit(keywidth)) { keywidth <- unit(keywidth, default.unit) } @@ -242,10 +241,11 @@ guide_merge.legend <- function(guide, new_guide) { } #' @export -guide_geom.legend <- function(guide, layers, default_mapping) { +guide_geom.legend <- function(guide, layers, default_mapping, theme) { # arrange common data for vertical and horizontal guide guide$geoms <- lapply(layers, function(layer) { matched <- matched_aes(layer, guide, default_mapping) + defaults <- layer$geom$eval_defaults(theme = theme) # check if this layer should be included include <- include_layer_in_guide(layer, matched) @@ -262,9 +262,9 @@ guide_geom.legend <- function(guide, layers, default_mapping) { aesthetics <- layer$mapping modifiers <- aesthetics[is_scaled_aes(aesthetics) | is_staged_aes(aesthetics)] - data <- layer$geom$use_defaults(guide$key[matched], params, modifiers) + data <- layer$geom$use_defaults(guide$key[matched], defaults = defaults, params, modifiers) } else { - data <- layer$geom$use_defaults(NULL, layer$aes_params)[rep(1, nrow(guide$key)), ] + data <- layer$geom$use_defaults(NULL, defaults = defaults, layer$aes_params)[rep(1, nrow(guide$key)), ] } # override.aes in guide_legend manually changes the geom @@ -302,7 +302,8 @@ guide_gengrob.legend <- function(guide, theme) { title.hjust <- guide$title.hjust %||% theme$legend.title.align %||% title.theme$hjust %||% 0 title.vjust <- guide$title.vjust %||% title.theme$vjust %||% 0.5 - grob.title <- ggname("guide.title", + grob.title <- ggname( + "guide.title", element_grob( title.theme, label = guide$title, @@ -321,7 +322,7 @@ guide_gengrob.legend <- function(guide, theme) { # gap between keys etc # the default horizontal and vertical gap need to be the same to avoid strange # effects for certain guide layouts - hgap <- width_cm(theme$legend.spacing.x %||% (0.5 * unit(title_fontsize, "pt"))) + hgap <- width_cm(theme$legend.spacing.x %||% (0.5 * unit(title_fontsize, "pt"))) vgap <- height_cm(theme$legend.spacing.y %||% (0.5 * unit(title_fontsize, "pt"))) # Labels @@ -501,7 +502,8 @@ guide_gengrob.legend <- function(guide, theme) { label.row = R * 2 - 1, label.col = C * 4 - 1 ) - }) + } + ) } else { switch( label.position, @@ -566,59 +568,65 @@ guide_gengrob.legend <- function(guide, theme) { label.row = R, label.col = C * 4 - 1 ) - }) + } + ) } # layout the title over key-label switch(guide$title.position, - "top" = { - widths <- c(kl_widths, max(0, title_width - sum(kl_widths))) - heights <- c(title_height, vgap, kl_heights) - vps <- transform( - vps, - key.row = key.row + 2, - key.col = key.col, - label.row = label.row + 2, - label.col = label.col - ) - vps.title.row = 1; vps.title.col = 1:length(widths) - }, - "bottom" = { - widths <- c(kl_widths, max(0, title_width - sum(kl_widths))) - heights <- c(kl_heights, vgap, title_height) - vps <- transform( - vps, - key.row = key.row, - key.col = key.col, - label.row = label.row, - label.col = label.col - ) - vps.title.row = length(heights); vps.title.col = 1:length(widths) - }, - "left" = { - widths <- c(title_width, hgap, kl_widths) - heights <- c(kl_heights, max(0, title_height - sum(kl_heights))) - vps <- transform( - vps, - key.row = key.row, - key.col = key.col + 2, - label.row = label.row, - label.col = label.col + 2 - ) - vps.title.row = 1:length(heights); vps.title.col = 1 - }, - "right" = { - widths <- c(kl_widths, hgap, title_width) - heights <- c(kl_heights, max(0, title_height - sum(kl_heights))) - vps <- transform( - vps, - key.row = key.row, - key.col = key.col, - label.row = label.row, - label.col = label.col - ) - vps.title.row = 1:length(heights); vps.title.col = length(widths) - }) + "top" = { + widths <- c(kl_widths, max(0, title_width - sum(kl_widths))) + heights <- c(title_height, vgap, kl_heights) + vps <- transform( + vps, + key.row = key.row + 2, + key.col = key.col, + label.row = label.row + 2, + label.col = label.col + ) + vps.title.row <- 1 + vps.title.col <- 1:length(widths) + }, + "bottom" = { + widths <- c(kl_widths, max(0, title_width - sum(kl_widths))) + heights <- c(kl_heights, vgap, title_height) + vps <- transform( + vps, + key.row = key.row, + key.col = key.col, + label.row = label.row, + label.col = label.col + ) + vps.title.row <- length(heights) + vps.title.col <- 1:length(widths) + }, + "left" = { + widths <- c(title_width, hgap, kl_widths) + heights <- c(kl_heights, max(0, title_height - sum(kl_heights))) + vps <- transform( + vps, + key.row = key.row, + key.col = key.col + 2, + label.row = label.row, + label.col = label.col + 2 + ) + vps.title.row <- 1:length(heights) + vps.title.col <- 1 + }, + "right" = { + widths <- c(kl_widths, hgap, title_width) + heights <- c(kl_heights, max(0, title_height - sum(kl_heights))) + vps <- transform( + vps, + key.row = key.row, + key.col = key.col, + label.row = label.row, + label.col = label.col + ) + vps.title.row <- 1:length(heights) + vps.title.col <- length(widths) + } + ) # grob for key key_size <- c(key_width, key_height) * 10 @@ -724,9 +732,7 @@ label_just_defaults.legend <- function(direction, position) { "left" = list(hjust = 1, vjust = 0.5), list(hjust = 0, vjust = 0.5) ) - } - } diff --git a/R/guides-.r b/R/guides-.r index 38b5708e0a..c7659aa4f8 100644 --- a/R/guides-.r +++ b/R/guides-.r @@ -129,7 +129,7 @@ build_guides <- function(scales, layers, default_mapping, position, theme, guide gdefs <- guides_merge(gdefs) # process layer information - gdefs <- guides_geom(gdefs, layers, default_mapping) + gdefs <- guides_geom(gdefs, layers, default_mapping, theme) if (length(gdefs) == 0) return(zeroGrob()) # generate grob of each guides @@ -229,8 +229,8 @@ guides_merge <- function(gdefs) { } # process layer information -guides_geom <- function(gdefs, layers, default_mapping) { - compact(lapply(gdefs, guide_geom, layers, default_mapping)) +guides_geom <- function(gdefs, layers, default_mapping, theme) { + compact(lapply(gdefs, guide_geom, layers, default_mapping, theme)) } # generate grob from each gdef (needs to write this function?) @@ -334,7 +334,7 @@ guide_merge <- function(guide, new_guide) UseMethod("guide_merge") #' @export #' @rdname guide-exts -guide_geom <- function(guide, layers, default_mapping) UseMethod("guide_geom") +guide_geom <- function(guide, layers, default_mapping, theme) UseMethod("guide_geom") #' @export #' @rdname guide-exts diff --git a/R/guides-axis.r b/R/guides-axis.r index 1b307d6bc1..c3ae1f7007 100644 --- a/R/guides-axis.r +++ b/R/guides-axis.r @@ -136,7 +136,7 @@ guide_merge.axis <- function(guide, new_guide) { # axis guides don't care which geometry uses these aesthetics #' @export -guide_geom.axis <- function(guide, layers, default_mapping) { +guide_geom.axis <- function(guide, layers, default_mapping, theme) { guide } diff --git a/R/guides-none.r b/R/guides-none.r index e27b6e9892..a76a3ad003 100644 --- a/R/guides-none.r +++ b/R/guides-none.r @@ -29,7 +29,7 @@ guide_merge.guide_none <- function(guide, new_guide) { } #' @export -guide_geom.guide_none <- function(guide, layers, default_mapping) { +guide_geom.guide_none <- function(guide, layers, default_mapping, theme) { guide } diff --git a/R/layer-sf.R b/R/layer-sf.R index b96075f500..9d636a8d35 100644 --- a/R/layer-sf.R +++ b/R/layer-sf.R @@ -53,6 +53,21 @@ LayerSf <- ggproto("LayerSf", Layer, self$show.legend <- TRUE } data + }, + + draw_geom = function(self, data, layout, theme) { + if (empty(data)) { + n <- nrow(layout$layout) + return(rep(list(zeroGrob()), n)) + } + + data <- self$geom$handle_na(data, self$geom_params) + + if(inherits(self$geom, "GeomSf")){ + self$geom$draw_layer(data, self$geom_params, layout, layout$coord, theme) + } else{ + self$geom$draw_layer(data, self$geom_params, layout, layout$coord) + } } ) diff --git a/R/layer.r b/R/layer.r index 1448762db0..855e3023c9 100644 --- a/R/layer.r +++ b/R/layer.r @@ -345,21 +345,22 @@ Layer <- ggproto("Layer", NULL, self$position$compute_layer(data, params, layout) }, - compute_geom_2 = function(self, data) { - # Combine aesthetics, defaults, & params + compute_geom_2 = function(self, data, plot) { if (empty(data)) return(data) + # evaluate defaults for theme + defaults <- self$geom$eval_defaults(theme = plot_theme(plot)) aesthetics <- self$mapping modifiers <- aesthetics[is_scaled_aes(aesthetics) | is_staged_aes(aesthetics)] - self$geom$use_defaults(data, self$aes_params, modifiers) + self$geom$use_defaults(data, defaults = defaults, self$aes_params, modifiers) }, finish_statistics = function(self, data) { self$stat$finish_layer(data, self$stat_params) }, - draw_geom = function(self, data, layout) { + draw_geom = function(self, data, layout, theme) { if (empty(data)) { n <- nrow(layout$layout) return(rep(list(zeroGrob()), n)) diff --git a/R/plot-build.r b/R/plot-build.r index dcac060141..784fdc8b86 100644 --- a/R/plot-build.r +++ b/R/plot-build.r @@ -97,7 +97,7 @@ ggplot_build.ggplot <- function(plot) { } # Fill in defaults etc. - data <- by_layer(function(l, d) l$compute_geom_2(d)) + data <- by_layer(function(l, d) l$compute_geom_2(d, plot)) # Let layer stat have a final say before rendering data <- by_layer(function(l, d) l$finish_statistics(d)) @@ -136,7 +136,7 @@ layer_scales <- function(plot, i = 1L, j = 1L) { layer_grob <- function(plot, i = 1L) { b <- ggplot_build(plot) - b$plot$layers[[i]]$draw_geom(b$data[[i]], b$layout) + b$plot$layers[[i]]$draw_geom(b$data[[i]], b$layout, plot_theme(plot)) } #' Build a plot with all the usual bits and pieces. @@ -165,7 +165,7 @@ ggplot_gtable.ggplot_built <- function(data) { data <- data$data theme <- plot_theme(plot) - geom_grobs <- Map(function(l, d) l$draw_geom(d, layout), plot$layers, data) + geom_grobs <- Map(function(l, d) l$draw_geom(d, layout, theme = theme), plot$layers, data) layout$setup_panel_guides(plot$guides, plot$layers, plot$mapping) plot_table <- layout$render(geom_grobs, data, theme, plot$labels) diff --git a/R/theme-defaults.r b/R/theme-defaults.r index 7d1d4bee94..9636b27251 100644 --- a/R/theme-defaults.r +++ b/R/theme-defaults.r @@ -128,7 +128,11 @@ theme_grey <- function(base_size = 11, base_family = "", lineheight = 0.9, hjust = 0.5, vjust = 0.5, angle = 0, margin = margin(), debug = FALSE ), - + geom = element_geom( + colour = "black", colour_1 = "grey20", + colour_2 = "#3366FF", + fill = "grey35", fill_1 = "white" + ), axis.line = element_blank(), axis.line.x = NULL, axis.line.y = NULL, @@ -377,6 +381,12 @@ theme_dark <- function(base_size = 11, base_family = "", panel.grid.major = element_line(size = rel(0.5)), panel.grid.minor = element_line(size = rel(0.25)), + # make the geom stand out + geom = element_geom( + colour = "white", colour_1 = "grey90", + colour_2 = "#809FFF", + fill = "grey75", fill_1 = "grey35" + ), # match axes ticks thickness to gridlines axis.ticks = element_line(colour = "grey20", size = rel(0.5)), @@ -468,6 +478,11 @@ theme_void <- function(base_size = 11, base_family = "", lineheight = 0.9, hjust = 0.5, vjust = 0.5, angle = 0, margin = margin(), debug = FALSE ), + geom = element_geom( + colour = "black", colour_1 = "grey20", + colour_2 = "#3366FF", + fill = "grey35", fill_1 = "white" + ), axis.text = element_blank(), axis.title = element_blank(), axis.ticks.length = unit(0, "pt"), @@ -540,7 +555,11 @@ theme_test <- function(base_size = 11, base_family = "", lineheight = 0.9, hjust = 0.5, vjust = 0.5, angle = 0, margin = margin(), debug = FALSE ), - + geom = element_geom( + colour = "black", colour_1 = "grey20", + colour_2 = "#3366FF", + fill = "grey35", fill_1 = "white" + ), axis.line = element_blank(), axis.line.x = NULL, axis.line.y = NULL, diff --git a/R/theme-elements.r b/R/theme-elements.r index 68bc7661d9..4c5a7edc4c 100644 --- a/R/theme-elements.r +++ b/R/theme-elements.r @@ -8,6 +8,7 @@ #' - `element_rect`: borders and backgrounds. #' - `element_line`: lines. #' - `element_text`: text. +#' - `element_geom`: geom defaults. #' #' `rel()` is used to specify sizes relative to the parent, #' `margin()` is used to specify the margins of elements. @@ -130,6 +131,38 @@ element_text <- function(family = NULL, face = NULL, colour = NULL, ) } +#' @param colour_1 geom accent colour 1, +#' typically a lighter version of colour +#' @param colour_2 geom accent colour 2, +#' typically a bright colour used for geom_smooth et al. +#' @param fill_1 geom accent fill colour, typically a darker version of fill +#' @param ... other accepted spellings of themable aesthetics, e.g. "color" +#' @export +#' @rdname element +element_geom <- function(fill = NULL, + fill_1 = NULL, + colour = NULL, + colour_1 = NULL, + colour_2 = NULL, + ..., + inherit.blank = FALSE) { + extra_aes <- rename_aes(list(...)) + + aes_list <- utils::modifyList( + list( + fill = fill, fill_1 = fill_1, colour = colour, + colour_1 = colour_1, colour_2 = colour_2, + inherit.blank = inherit.blank + ), + extra_aes, + keep.null = TRUE + ) + + structure( + aes_list, + class = c("element_geom", "element") + ) +} #' @export print.element <- function(x, ...) utils::str(x) @@ -401,7 +434,6 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) { panel.grid.major = el_def("element_line", "panel.grid"), panel.grid.minor = el_def("element_line", "panel.grid"), strip.text = el_def("element_text", "text"), - axis.line.x = el_def("element_line", "axis.line"), axis.line.x.top = el_def("element_line", "axis.line.x"), axis.line.x.bottom = el_def("element_line", "axis.line.x"), @@ -437,8 +469,8 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) { legend.background = el_def("element_rect", "rect"), legend.margin = el_def("margin"), legend.spacing = el_def("unit"), - legend.spacing.x = el_def("unit", "legend.spacing"), - legend.spacing.y = el_def("unit", "legend.spacing"), + legend.spacing.x = el_def("unit", "legend.spacing"), + legend.spacing.y = el_def("unit", "legend.spacing"), legend.key = el_def("element_rect", "rect"), legend.key.height = el_def("unit", "legend.key.size"), legend.key.width = el_def("unit", "legend.key.size"), @@ -491,7 +523,8 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) { plot.tag.position = el_def("character"), # Need to also accept numbers plot.margin = el_def("margin"), - aspect.ratio = el_def("character") + aspect.ratio = el_def("character"), + geom = el_def("element_geom") ) # Check that an element object has the proper class diff --git a/R/theme.r b/R/theme.r index 7cf5556b89..bd4700f97a 100644 --- a/R/theme.r +++ b/R/theme.r @@ -25,6 +25,7 @@ #' @param text all text elements ([element_text()]) #' @param title all title elements: plot, axes, legends ([element_text()]; #' inherits from `text`) +#' @param geom default geom aesthetics #' @param aspect.ratio aspect ratio of the panel #' #' @param axis.title,axis.title.x,axis.title.y,axis.title.x.top,axis.title.x.bottom,axis.title.y.left,axis.title.y.right @@ -268,6 +269,7 @@ theme <- function(line, rect, text, title, + geom, aspect.ratio, axis.title, axis.title.x, @@ -697,3 +699,16 @@ is.theme <- function(x) inherits(x, "theme") #' @export print.theme <- function(x, ...) utils::str(x) + + +#' Pulls default aesthetic from theme element +#' +#' defined and evaluated in environments with current plot theme, +#' e.g Geom$eval_defaults and sf_grob +#' +#' @param aes character string indicating the aesthetic e.g. color, fill +#' @param element The theme element where aes is specified, defaults to "geom" +#' @noRd +from_theme <- function(aes, element = "geom"){ + theme[[element]][[aes]] +} diff --git a/man/element.Rd b/man/element.Rd index 5ba0e940f9..234acd78ea 100644 --- a/man/element.Rd +++ b/man/element.Rd @@ -6,6 +6,7 @@ \alias{element_rect} \alias{element_line} \alias{element_text} +\alias{element_geom} \alias{rel} \title{Theme elements} \usage{ @@ -47,6 +48,16 @@ element_text( inherit.blank = FALSE ) +element_geom( + fill = NULL, + fill_1 = NULL, + colour = NULL, + colour_1 = NULL, + colour_2 = NULL, + ..., + inherit.blank = FALSE +) + rel(x) } \arguments{ @@ -96,6 +107,16 @@ side of the text facing towards the center of the plot.} rectangle behind the complete text area, and a point where each label is anchored.} +\item{fill_1}{geom accent fill colour, typically a darker version of fill} + +\item{colour_1}{geom accent colour 1, +typically a lighter version of colour} + +\item{colour_2}{geom accent colour 2, +typically a bright colour used for geom_smooth et al.} + +\item{...}{other accepted spellings of themable aesthetics, e.g. "color"} + \item{x}{A single number specifying size relative to parent element.} } \value{ @@ -109,6 +130,7 @@ specify the display of how non-data components of the plot are drawn. \item \code{element_rect}: borders and backgrounds. \item \code{element_line}: lines. \item \code{element_text}: text. +\item \code{element_geom}: geom defaults. } \code{rel()} is used to specify sizes relative to the parent, diff --git a/man/guide-exts.Rd b/man/guide-exts.Rd index 17c1591cb6..27e1020080 100644 --- a/man/guide-exts.Rd +++ b/man/guide-exts.Rd @@ -13,7 +13,7 @@ guide_train(guide, scale, aesthetic = NULL) guide_merge(guide, new_guide) -guide_geom(guide, layers, default_mapping) +guide_geom(guide, layers, default_mapping, theme) guide_transform(guide, coord, panel_params) diff --git a/man/theme.Rd b/man/theme.Rd index 457cdb5f02..eb136e53e6 100644 --- a/man/theme.Rd +++ b/man/theme.Rd @@ -9,6 +9,7 @@ theme( rect, text, title, + geom, aspect.ratio, axis.title, axis.title.x, @@ -112,6 +113,8 @@ theme( \item{title}{all title elements: plot, axes, legends (\code{\link[=element_text]{element_text()}}; inherits from \code{text})} +\item{geom}{default geom aesthetics} + \item{aspect.ratio}{aspect ratio of the panel} \item{axis.title, axis.title.x, axis.title.y, axis.title.x.top, axis.title.x.bottom, axis.title.y.left, axis.title.y.right}{labels of axes (\code{\link[=element_text]{element_text()}}). Specify all axes' labels (\code{axis.title}), diff --git a/tests/figs/coord-sf/sf-polygons.svg b/tests/figs/coord-sf/sf-polygons.svg index a3b1b6928c..e69808afe4 100644 --- a/tests/figs/coord-sf/sf-polygons.svg +++ b/tests/figs/coord-sf/sf-polygons.svg @@ -29,7 +29,7 @@ - + diff --git a/tests/figs/geom-polygon/basic-polygon-plot.svg b/tests/figs/geom-polygon/basic-polygon-plot.svg index 29a3195d0d..2ddbdcb778 100644 --- a/tests/figs/geom-polygon/basic-polygon-plot.svg +++ b/tests/figs/geom-polygon/basic-polygon-plot.svg @@ -19,8 +19,8 @@ - - + + diff --git a/tests/figs/geom-sf/north-carolina-county-boundaries.svg b/tests/figs/geom-sf/north-carolina-county-boundaries.svg index 805823d951..4195e79040 100644 --- a/tests/figs/geom-sf/north-carolina-county-boundaries.svg +++ b/tests/figs/geom-sf/north-carolina-county-boundaries.svg @@ -29,7 +29,7 @@ - + diff --git a/tests/figs/themes/default-aesthetics-can-be-set-by-theme.svg b/tests/figs/themes/default-aesthetics-can-be-set-by-theme.svg new file mode 100644 index 0000000000..63c1ca6dec --- /dev/null +++ b/tests/figs/themes/default-aesthetics-can-be-set-by-theme.svg @@ -0,0 +1,205 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +5 +6 +7 +8 + + + + + + + +setosa +versicolor +virginica +Species +Sepal.Length +default aesthetics can be set by theme + diff --git a/tests/figs/themes/geom-sf-respect-themed-aesthetics.svg b/tests/figs/themes/geom-sf-respect-themed-aesthetics.svg new file mode 100644 index 0000000000..20eaf0dd29 --- /dev/null +++ b/tests/figs/themes/geom-sf-respect-themed-aesthetics.svg @@ -0,0 +1,201 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +34 +° +N +34.5 +° +N +35 +° +N +35.5 +° +N +36 +° +N +36.5 +° +N + + + + + + + + + + + +84 +° +W +82 +° +W +80 +° +W +78 +° +W +76 +° +W +geom_sf respect themed aesthetics + diff --git a/tests/figs/themes/themed-aesthetics-respect-parameters.svg b/tests/figs/themes/themed-aesthetics-respect-parameters.svg new file mode 100644 index 0000000000..28fd3dbdb1 --- /dev/null +++ b/tests/figs/themes/themed-aesthetics-respect-parameters.svg @@ -0,0 +1,205 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +5 +6 +7 +8 + + + + + + + +setosa +versicolor +virginica +Species +Sepal.Length +themed aesthetics respect parameters + diff --git a/tests/figs/themes/themed-defaults-respect-aesthetics.svg b/tests/figs/themes/themed-defaults-respect-aesthetics.svg new file mode 100644 index 0000000000..4107d00f68 --- /dev/null +++ b/tests/figs/themes/themed-defaults-respect-aesthetics.svg @@ -0,0 +1,95 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 + + + + + + + + + + +5 +6 +7 +8 +Sepal.Length +Petal.Width + +Species + + + + + + + + + +setosa +versicolor +virginica +themed defaults respect aesthetics + diff --git a/tests/testthat/test-theme.r b/tests/testthat/test-theme.r index 19c28a5157..1233fd9260 100644 --- a/tests/testthat/test-theme.r +++ b/tests/testthat/test-theme.r @@ -217,14 +217,14 @@ test_that("complete and non-complete themes interact correctly with ggplot objec expect_identical(pt, tt) p <- ggplot_build(qplot(1:3, 1:3) + theme(text = element_text(colour = 'red', face = 'italic'))) - expect_false(attr(p$plot$theme, "complete")) + #expect_false(attr(p$plot$theme, "complete")) expect_equal(p$plot$theme$text$colour, "red") expect_equal(p$plot$theme$text$face, "italic") p <- ggplot_build(qplot(1:3, 1:3) + theme(text = element_text(colour = 'red')) + theme(text = element_text(face = 'italic'))) - expect_false(attr(p$plot$theme, "complete")) + #expect_false(attr(p$plot$theme, "complete")) expect_equal(p$plot$theme$text$colour, "red") expect_equal(p$plot$theme$text$face, "italic") }) @@ -635,3 +635,35 @@ test_that("Strips can render custom elements", { theme(strip.text = element_test()) expect_doppelganger("custom strip elements can render", plot) }) + + +test_that("Default aesthetics can be set via theme", { + p1 <- ggplot(iris) + + geom_point(aes(x = Species, y = Sepal.Length)) + + theme(geom = element_geom(color = "purple", fill = "blue")) + expect_doppelganger("default aesthetics can be set by theme", p1) + + # works with geom sf + if (requireNamespace("sf", quietly = TRUE)) { + nc <- sf::st_read(system.file("shape/nc.shp", package = "sf"), quiet = TRUE) + } + p2 <- ggplot(nc) + geom_sf() + + theme(geom = element_geom(color = "purple", colour_2 = "pink", fill = "blue")) + expect_doppelganger("geom_sf respect themed aesthetics", p2) + + # themed defaults respect parameters + + p3 <- ggplot(iris) + + geom_point(aes(x = Species, y = Sepal.Length), color = "red") + + theme(geom = element_geom(color = "purple", colour2 = "pink", fill = "blue")) + expect_doppelganger("themed aesthetics respect parameters", p1) + + # themed defaults respect user aesthetics + # legends respect themed aesthetics + p4 <- ggplot(iris) + + geom_smooth(aes(color = Species, x = Sepal.Length, y = Petal.Width)) + + theme(geom = element_geom(color = "purple", colour_1 = "pink", fill = "green")) + expect_doppelganger("themed defaults respect aesthetics ", p4) + +}) +