From 19b0cc7fcea76a44eb98c75f6f050e4f2a5e318f Mon Sep 17 00:00:00 2001 From: Dana Seidel Date: Tue, 10 Jul 2018 20:22:04 -0700 Subject: [PATCH 01/21] Add new theme element "geom" --- R/theme-defaults.r | 7 ++++++- R/theme-elements.r | 15 ++++++++++++++- R/theme.r | 3 +++ 3 files changed, 23 insertions(+), 2 deletions(-) diff --git a/R/theme-defaults.r b/R/theme-defaults.r index 7719744360..b2c0612332 100644 --- a/R/theme-defaults.r +++ b/R/theme-defaults.r @@ -129,6 +129,7 @@ theme_grey <- function(base_size = 11, base_family = "", margin = margin(), debug = FALSE ), + geom = element_geom(colour = "black", fill = "grey35"), axis.line = element_blank(), axis.line.x = NULL, axis.line.y = NULL, @@ -365,6 +366,9 @@ 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", fill = "grey85"), + # match axes ticks thickness to gridlines axis.ticks = element_line(colour = "grey20", size = rel(0.5)), @@ -456,6 +460,7 @@ 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", fill = "grey35"), axis.text = element_blank(), axis.title = element_blank(), axis.ticks.length = unit(0, "pt"), @@ -517,7 +522,7 @@ 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", fill = "grey35"), 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 3af3875fb1..32dde82180 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, #' `margins()` is used to specify the margins of elements. @@ -120,6 +121,18 @@ element_text <- function(family = NULL, face = NULL, colour = NULL, ) } +#' @export +#' @rdname element +element_geom <- function(fill = NULL, colour = NULL, color = NULL, + inherit.blank = FALSE) { + + if (!is.null(color)) colour <- color + structure( + list(fill = fill, colour = colour, inherit.blank = inherit.blank), + class = c("element_geom", "element") + ) +} + #' @export print.element <- function(x, ...) utils::str(x) @@ -271,7 +284,7 @@ ggplot_global$element_tree <- list( 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"), - + geom = el_def("element_geom", "geom"), 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"), diff --git a/R/theme.r b/R/theme.r index dbd4b8d4ad..e7b70da3ba 100644 --- a/R/theme.r +++ b/R/theme.r @@ -21,6 +21,7 @@ #' inherits from `text`) #' @param aspect.ratio aspect ratio of the panel #' +#' @param geom default geom aesthetics #' @param axis.title label of axes (`element_text`; inherits from #' `text`) #' @param axis.title.x x axis label (`element_text`; inherits from @@ -290,6 +291,7 @@ theme <- function(line, text, title, aspect.ratio, + geom, axis.title, axis.title.x, axis.title.x.top, @@ -510,6 +512,7 @@ update_theme <- function(oldtheme, newtheme) { if (is_theme_complete(newtheme)) return(newtheme) + if (length(oldtheme) == 0) oldtheme <- theme_get() # These are elements in newtheme that aren't already set in oldtheme. # They will be pulled from the default theme. newitems <- !names(newtheme) %in% names(oldtheme) From 7dc76d53eb31f44ad90e033c9142d6354fbc0f9b Mon Sep 17 00:00:00 2001 From: Dana Seidel Date: Tue, 10 Jul 2018 20:23:29 -0700 Subject: [PATCH 02/21] Set default_aes from theme --- R/geom-.r | 13 ++++++++++--- R/geom-point.r | 8 ++++---- R/geom-rect.r | 9 +++++++-- R/layer.r | 6 +++--- R/plot-build.r | 2 +- 5 files changed, 25 insertions(+), 13 deletions(-) diff --git a/R/geom-.r b/R/geom-.r index 6ddb7a1499..9935307db3 100644 --- a/R/geom-.r +++ b/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) diff --git a/R/geom-point.r b/R/geom-point.r index 3863e7e64a..f35a76b17b 100644 --- a/R/geom-point.r +++ b/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 = NA, stroke = 0.5 + )), draw_panel = function(data, panel_params, coord, na.rm = FALSE) { if (is.character(data$shape)) { diff --git a/R/geom-rect.r b/R/geom-rect.r index 1d132d4215..0460441858 100644 --- a/R/geom-rect.r +++ b/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 = NA + )), required_aes = c("xmin", "xmax", "ymin", "ymax"), diff --git a/R/layer.r b/R/layer.r index baeea7be72..db538ea481 100644 --- a/R/layer.r +++ b/R/layer.r @@ -303,11 +303,11 @@ 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) - self$geom$use_defaults(data, self$aes_params) + # Combine aesthetics, defaults, & params + self$geom$use_defaults(data, self$aes_params, plot$theme) }, finish_statistics = function(self, data) { diff --git a/R/plot-build.r b/R/plot-build.r index 6fb2689090..3d8fc5767c 100644 --- a/R/plot-build.r +++ b/R/plot-build.r @@ -87,7 +87,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)) From 21acff93d25eed133608a17f441df1be6c905810 Mon Sep 17 00:00:00 2001 From: Dana Seidel Date: Tue, 10 Jul 2018 20:25:17 -0700 Subject: [PATCH 03/21] Expand functionality to guides, update_geom_defaults(), and tests --- R/geom-defaults.r | 6 +++++- R/guide-colorbar.r | 2 +- R/guide-legend.r | 4 ++-- R/guides-.r | 8 ++++---- tests/testthat/test-theme.r | 4 ++-- 5 files changed, 14 insertions(+), 10 deletions(-) diff --git a/R/geom-defaults.r b/R/geom-defaults.r index 1fefa8c66e..07fa5f84db 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.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/guide-colorbar.r b/R/guide-colorbar.r index da8df740ed..ced51086aa 100644 --- a/R/guide-colorbar.r +++ b/R/guide-colorbar.r @@ -239,7 +239,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 <- plyr::llply(layers, function(layer) { matched <- matched_aes(layer, guide, default_mapping) diff --git a/R/guide-legend.r b/R/guide-legend.r index 0f4b36f255..2566c0c90c 100644 --- a/R/guide-legend.r +++ b/R/guide-legend.r @@ -240,7 +240,7 @@ 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 <- plyr::llply(layers, function(layer) { matched <- matched_aes(layer, guide, default_mapping) @@ -265,7 +265,7 @@ guide_geom.legend <- 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], params, theme) } else { return(NULL) } diff --git a/R/guides-.r b/R/guides-.r index 06525a1b0b..b9ed64f766 100644 --- a/R/guides-.r +++ b/R/guides-.r @@ -121,7 +121,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 @@ -214,8 +214,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?) @@ -318,7 +318,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/tests/testthat/test-theme.r b/tests/testthat/test-theme.r index 63cc5a04c3..30f03a5361 100644 --- a/tests/testthat/test-theme.r +++ b/tests/testthat/test-theme.r @@ -142,14 +142,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") }) From 0bc4041fcb8a8fdaa683d09b62aae3c5205f79d3 Mon Sep 17 00:00:00 2001 From: Dana Seidel Date: Tue, 17 Jul 2018 14:35:43 -0700 Subject: [PATCH 04/21] Add theme geom elements colour.accent1, colour.accent2, fill.accent, and alpha. --- R/theme-defaults.r | 29 ++++++++++++++++++++++++----- R/theme-elements.r | 23 ++++++++++++++++++----- 2 files changed, 42 insertions(+), 10 deletions(-) diff --git a/R/theme-defaults.r b/R/theme-defaults.r index b2c0612332..e2ee0f021a 100644 --- a/R/theme-defaults.r +++ b/R/theme-defaults.r @@ -129,7 +129,12 @@ theme_grey <- function(base_size = 11, base_family = "", margin = margin(), debug = FALSE ), - geom = element_geom(colour = "black", fill = "grey35"), + geom = element_geom( + colour = "black", colour.accent1 = "grey20", + colour.accent2 = "#3366FF", + fill = "grey35", fill.accent = "white", + alpha = NA + ), axis.line = element_blank(), axis.line.x = NULL, axis.line.y = NULL, @@ -367,8 +372,12 @@ theme_dark <- function(base_size = 11, base_family = "", panel.grid.minor = element_line(size = rel(0.25)), # make the geom stand out - geom = element_geom(colour = "white", fill = "grey85"), - + geom = element_geom( + colour = "white", colour.accent1 = "grey90", + colour.accent2 = "#3366FF", + fill = "grey75", fill.accent = "grey35", + alpha = NA + ), # match axes ticks thickness to gridlines axis.ticks = element_line(colour = "grey20", size = rel(0.5)), @@ -460,7 +469,12 @@ 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", fill = "grey35"), + geom = element_geom( + colour = "black", colour.accent1 = "grey20", + colour.accent2 = "#3366FF", + fill = "grey35", fill.accent = "white", + alpha = NA + ), axis.text = element_blank(), axis.title = element_blank(), axis.ticks.length = unit(0, "pt"), @@ -522,7 +536,12 @@ 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", fill = "grey35"), + geom = element_geom( + colour = "black", colour.accent1 = "grey20", + colour.accent2 = "#3366FF", + fill = "grey35", fill.accent = "white", + alpha = NA + ), 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 32dde82180..7a70e59176 100644 --- a/R/theme-elements.r +++ b/R/theme-elements.r @@ -123,17 +123,30 @@ element_text <- function(family = NULL, face = NULL, colour = NULL, #' @export #' @rdname element -element_geom <- function(fill = NULL, colour = NULL, color = NULL, - inherit.blank = FALSE) { +element_geom <- function(fill = NULL, fill.accent = NULL, + colour = NULL, color = NULL, + colour.accent1 = NULL, color.accent1 = NULL, + colour.accent2 = NULL, color.accent2 = NULL, + alpha = NULL, inherit.blank = FALSE) { + + if (!is.null(color)) colour <- color + if (!is.null(color.accent1)) colour.accent1 <- color.accent1 + if (!is.null(color.accent2)) colour.accent2 <- color.accent2 - if (!is.null(color)) colour <- color structure( - list(fill = fill, colour = colour, inherit.blank = inherit.blank), + list( + fill = fill, + colour = colour, + fill.accent = fill.accent, + colour.accent1 = colour.accent1, + colour.accent2 = colour.accent2, + alpha = alpha, + inherit.blank = inherit.blank + ), class = c("element_geom", "element") ) } - #' @export print.element <- function(x, ...) utils::str(x) From ecf1356d1a75436bd5f6480c50a1668fd2c28173 Mon Sep 17 00:00:00 2001 From: Dana Seidel Date: Tue, 17 Jul 2018 14:43:43 -0700 Subject: [PATCH 05/21] Implement new theme$geom elements for all geoms --- R/annotation-logticks.r | 5 ++++- R/geom-abline.r | 7 ++++++- R/geom-boxplot.r | 7 +++++-- R/geom-contour.r | 6 ++++-- R/geom-crossbar.r | 6 ++++-- R/geom-curve.r | 5 ++++- R/geom-density2d.r | 5 ++++- R/geom-dotplot.r | 6 +++++- R/geom-errorbar.r | 7 +++++-- R/geom-errorbarh.r | 9 ++++++--- R/geom-hex.r | 8 ++++---- R/geom-hline.r | 6 +++++- R/geom-label.R | 11 ++++++----- R/geom-linerange.r | 6 +++++- R/geom-path.r | 5 ++++- R/geom-point.r | 2 +- R/geom-pointrange.r | 9 +++++++-- R/geom-polygon.r | 8 ++++++-- R/geom-raster.r | 2 +- R/geom-rect.r | 2 +- R/geom-ribbon.r | 12 ++++++++---- R/geom-rug.r | 6 +++++- R/geom-segment.r | 5 ++++- R/geom-smooth.r | 8 +++++--- R/geom-text.r | 18 ++++++++++-------- R/geom-tile.r | 6 ++++-- R/geom-violin.r | 15 +++++++++------ R/geom-vline.r | 5 ++++- R/sf.R | 6 +++--- 29 files changed, 139 insertions(+), 64 deletions(-) diff --git a/R/annotation-logticks.r b/R/annotation-logticks.r index e4980649c8..2e1367ad8e 100644 --- a/R/annotation-logticks.r +++ b/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 + )) ) diff --git a/R/geom-abline.r b/R/geom-abline.r index ebd293adc2..3de8650e5c 100644 --- a/R/geom-abline.r +++ b/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 diff --git a/R/geom-boxplot.r b/R/geom-boxplot.r index 778a600d43..ed8667e1e1 100644 --- a/R/geom-boxplot.r +++ b/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") ) diff --git a/R/geom-contour.r b/R/geom-contour.r index 51236b901f..bd7a344bca 100644 --- a/R/geom-contour.r +++ b/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 + )) ) diff --git a/R/geom-crossbar.r b/R/geom-crossbar.r index c7ae1863eb..36ea1eabd4 100644 --- a/R/geom-crossbar.r +++ b/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"), diff --git a/R/geom-curve.r b/R/geom-curve.r index e9faa3730b..8adc00f356 100644 --- a/R/geom-curve.r +++ b/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) { diff --git a/R/geom-density2d.r b/R/geom-density2d.r index 9eb7c46cd5..50df9eaffc 100644 --- a/R/geom-density2d.r +++ b/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 + )) ) diff --git a/R/geom-dotplot.r b/R/geom-dotplot.r index aa07c35e7f..6ea477dc95 100644 --- a/R/geom-dotplot.r +++ b/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 %||% diff --git a/R/geom-errorbar.r b/R/geom-errorbar.r index f6cfb76cc4..b0f95b954d 100644 --- a/R/geom-errorbar.r +++ b/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, diff --git a/R/geom-errorbarh.r b/R/geom-errorbarh.r index 40ed876579..21dcec24e1 100644 --- a/R/geom-errorbarh.r +++ b/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), diff --git a/R/geom-hex.r b/R/geom-hex.r index e669914264..f8da21f243 100644 --- a/R/geom-hex.r +++ b/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 ) diff --git a/R/geom-hline.r b/R/geom-hline.r index 6b3438aaf0..2e14715031 100644 --- a/R/geom-hline.r +++ b/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 diff --git a/R/geom-label.R b/R/geom-label.R index 921f4784ac..a73a589434 100644 --- a/R/geom-label.R +++ b/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, diff --git a/R/geom-linerange.r b/R/geom-linerange.r index 6758cde3e5..ee50fccc26 100644 --- a/R/geom-linerange.r +++ b/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, diff --git a/R/geom-path.r b/R/geom-path.r index 6a0ba6d19f..e335bb11b7 100644 --- a/R/geom-path.r +++ b/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 diff --git a/R/geom-point.r b/R/geom-point.r index f35a76b17b..da623f54de 100644 --- a/R/geom-point.r +++ b/R/geom-point.r @@ -112,7 +112,7 @@ GeomPoint <- ggproto("GeomPoint", Geom, non_missing_aes = c("size", "shape", "colour"), default_aes = expr(aes( shape = 19, colour = theme$geom$colour, size = 1.5, - fill = NA, alpha = NA, stroke = 0.5 + fill = NA, alpha = theme$geom$alpha, 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 6777aa0151..e62d70a650 100644 --- a/R/geom-pointrange.r +++ b/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, diff --git a/R/geom-polygon.r b/R/geom-polygon.r index 9e9c7525ee..275a02b59c 100644 --- a/R/geom-polygon.r +++ b/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 diff --git a/R/geom-raster.r b/R/geom-raster.r index fac51e9345..36428cdd78 100644 --- a/R/geom-raster.r +++ b/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"), diff --git a/R/geom-rect.r b/R/geom-rect.r index 0460441858..f5d7238d10 100644 --- a/R/geom-rect.r +++ b/R/geom-rect.r @@ -31,7 +31,7 @@ GeomRect <- ggproto("GeomRect", Geom, fill = theme$geom$fill, size = 0.5, linetype = 1, - alpha = NA + alpha = theme$geom$alpha )), required_aes = c("xmin", "xmax", "ymin", "ymax"), diff --git a/R/geom-ribbon.r b/R/geom-ribbon.r index b60e87f349..34d8834d6b 100644 --- a/R/geom-ribbon.r +++ b/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"), diff --git a/R/geom-rug.r b/R/geom-rug.r index 4e25da0027..2ad60a531f 100644 --- a/R/geom-rug.r +++ b/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 ) diff --git a/R/geom-segment.r b/R/geom-segment.r index 017d88a9de..8b3bec1624 100644 --- a/R/geom-segment.r +++ b/R/geom-segment.r @@ -101,7 +101,10 @@ geom_segment <- function(mapping = NULL, data = NULL, 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 = expr(aes( + colour = theme$geom$colour, size = 0.5, linetype = 1, + alpha = theme$geom$alpha + )), draw_panel = function(data, panel_params, coord, arrow = NULL, arrow.fill = NULL, lineend = "butt", linejoin = "round", na.rm = FALSE) { diff --git a/R/geom-smooth.r b/R/geom-smooth.r index 277bd91cf9..553846a33f 100644 --- a/R/geom-smooth.r +++ b/R/geom-smooth.r @@ -84,7 +84,6 @@ geom_smooth <- function(mapping = NULL, data = NULL, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) { - params <- list( na.rm = na.rm, se = se, @@ -140,6 +139,9 @@ 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 = expr(aes( + colour = theme$geom$colour.accent2, + fill = theme$geom$fill, size = 1, + linetype = 1, weight = 1, alpha = 0.4 + )) ) diff --git a/R/geom-text.r b/R/geom-text.r index 1ab334ee55..f66fc12871 100644 --- a/R/geom-text.r +++ b/R/geom-text.r @@ -132,8 +132,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)) { stop("Specify either `position` or `nudge_x`/`nudge_y`", call. = FALSE) @@ -167,13 +166,15 @@ geom_text <- function(mapping = NULL, data = NULL, 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 - ), + default_aes = expr(aes( + colour = theme$text$colour, + 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(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(text = as.character(lab)) @@ -189,7 +190,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 3ffb97ae03..c90afd237a 100644 --- a/R/geom-tile.r +++ b/R/geom-tile.r @@ -93,8 +93,10 @@ GeomTile <- ggproto("GeomTile", GeomRect, ) }, - default_aes = aes(fill = "grey20", colour = NA, size = 0.1, linetype = 1, - alpha = NA, width = NA, height = NA), + default_aes = expr(aes( + fill = theme$geom$fill, colour = NA, size = 0.1, + linetype = 1, alpha = theme$geom$alpha, width = NA, height = NA + )), required_aes = c("x", "y"), diff --git a/R/geom-violin.r b/R/geom-violin.r index 81a677a504..998c41ca72 100644 --- a/R/geom-violin.r +++ b/R/geom-violin.r @@ -126,7 +126,7 @@ GeomViolin <- ggproto("GeomViolin", Geom, # Close the polygon: set first and last point the same # Needed for coord_polar and such - newdata <- rbind(newdata, newdata[1,]) + newdata <- rbind(newdata, newdata[1, ]) # Draw quantiles if requested, so long as there is non-zero y range if (length(draw_quantiles) > 0 & !scales::zero_range(range(data$y))) { @@ -145,8 +145,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, ...)) } @@ -154,8 +154,12 @@ 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 = expr(aes( + weight = 1, colour = theme$geom$colour.accent1, + fill = theme$geom$fill.accent, + size = 0.5, alpha = theme$geom$alpha, + linetype = "solid" + )), required_aes = c("x", "y") ) @@ -177,4 +181,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 b2e29f9bdc..54d7ee1f8d 100644 --- a/R/geom-vline.r +++ b/R/geom-vline.r @@ -47,7 +47,10 @@ 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 = expr(aes( + colour = theme$geom$colour, size = 0.5, linetype = 1, + alpha = theme$geom$alpha + )), required_aes = "xintercept", draw_key = draw_key_vline diff --git a/R/sf.R b/R/sf.R index 0aaca34ecd..44a0d69848 100644 --- a/R/sf.R +++ b/R/sf.R @@ -141,15 +141,15 @@ stat_sf <- function(mapping = NULL, data = NULL, geom = "rect", #' @format NULL GeomSf <- ggproto("GeomSf", Geom, required_aes = "geometry", - default_aes = aes( + default_aes = expr(aes( shape = NULL, colour = NULL, fill = NULL, size = NULL, linetype = 1, - alpha = NA, + alpha = theme$geom$alpha, stroke = 0.5 - ), + )), draw_panel = function(data, panel_params, coord, legend = NULL) { if (!inherits(coord, "CoordSf")) { From 42acbd3fd9b788e1bf2517bf3a519559f284b3a5 Mon Sep 17 00:00:00 2001 From: Dana Seidel Date: Wed, 1 Aug 2018 14:50:49 -0700 Subject: [PATCH 06/21] Adjust geom_density, geom_quantile, and geom_sf geom_sf is now the only geom that does not allow aesthetic setting from themes due to a unique way of setting default aesthetics. Presumably should be adapted in a future commit. --- NAMESPACE | 1 + R/geom-density.r | 8 ++++---- R/geom-quantile.r | 8 ++++---- R/sf.R | 14 +++++++------- R/theme-elements.r | 8 +++++++- man/element.Rd | 33 ++++++++++++++++++++++++++------- man/guide-exts.Rd | 2 +- man/theme.Rd | 43 +++++++++++++++++++++++-------------------- 8 files changed, 73 insertions(+), 44 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index f09568dd1c..8a5df3a3bc 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/geom-density.r b/R/geom-density.r index 5d96c3ac1a..5f0a556757 100644 --- a/R/geom-density.r +++ b/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 + )) ) diff --git a/R/geom-quantile.r b/R/geom-quantile.r index 85729b42d0..a434b930f3 100644 --- a/R/geom-quantile.r +++ b/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 + )) ) diff --git a/R/sf.R b/R/sf.R index 44a0d69848..c5a5e2be88 100644 --- a/R/sf.R +++ b/R/sf.R @@ -141,15 +141,15 @@ stat_sf <- function(mapping = NULL, data = NULL, geom = "rect", #' @format NULL GeomSf <- ggproto("GeomSf", Geom, required_aes = "geometry", - default_aes = expr(aes( + default_aes = aes( shape = NULL, colour = NULL, fill = NULL, size = NULL, linetype = 1, - alpha = theme$geom$alpha, + alpha = NA, stroke = 0.5 - )), + ), draw_panel = function(data, panel_params, coord, legend = NULL) { if (!inherits(coord, "CoordSf")) { @@ -178,11 +178,11 @@ GeomSf <- ggproto("GeomSf", Geom, default_aesthetics <- function(type) { if (type == "point") { - GeomPoint$default_aes + aes(shape = 19, colour = "black", size = 1.5, fill = NA, alpha = NA, stroke = 0.5) } else if (type == "line") { - GeomLine$default_aes - } else { - utils::modifyList(GeomPolygon$default_aes, list(fill = "grey90", colour = "grey35")) + aes(colour = "black", size = 0.5, linetype = 1, alpha = NA) + } else { + aes(size = 0.5, linetype = 1, fill = "grey90", colour = "grey35", alpha = NA) } } diff --git a/R/theme-elements.r b/R/theme-elements.r index 7a70e59176..c50b231ade 100644 --- a/R/theme-elements.r +++ b/R/theme-elements.r @@ -1,7 +1,7 @@ #' Theme elements #' #' @description -#' In conjunction with the \link{theme} system, the `element_` functions +#' In conjunction with the [theme()] system, the `element_` functions #' specify the display of how non-data components of the plot are a drawn. #' #' - `element_blank`: draws nothing, and assigns no space. @@ -121,6 +121,12 @@ element_text <- function(family = NULL, face = NULL, colour = NULL, ) } +#' @param colour.accent1,color.accent1 accent colour 1, +#' typically a lighter version of colour +#' @param colour.accent2,color.accent2 accent colour 2, +#' typically a bright colour used for geom_smooth et al. +#' @param fill.accent accent fill colour, typically a darker version of fill +#' @param alpha colour/fill transparency, between 0 & 1. #' @export #' @rdname element element_geom <- function(fill = NULL, fill.accent = NULL, diff --git a/man/element.Rd b/man/element.Rd index 1d4b3f1a43..928f18cbe9 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{ @@ -13,15 +14,22 @@ margin(t = 0, r = 0, b = 0, l = 0, unit = "pt") element_blank() -element_rect(fill = NULL, colour = NULL, size = NULL, linetype = NULL, - color = NULL, inherit.blank = FALSE) +element_rect(fill = NULL, colour = NULL, size = NULL, + linetype = NULL, color = NULL, inherit.blank = FALSE) element_line(colour = NULL, size = NULL, linetype = NULL, - lineend = NULL, color = NULL, arrow = NULL, inherit.blank = FALSE) + lineend = NULL, color = NULL, arrow = NULL, + inherit.blank = FALSE) -element_text(family = NULL, face = NULL, colour = NULL, size = NULL, - hjust = NULL, vjust = NULL, angle = NULL, lineheight = NULL, - color = NULL, margin = NULL, debug = NULL, inherit.blank = FALSE) +element_text(family = NULL, face = NULL, colour = NULL, + size = NULL, hjust = NULL, vjust = NULL, angle = NULL, + lineheight = NULL, color = NULL, margin = NULL, debug = NULL, + inherit.blank = FALSE) + +element_geom(fill = NULL, fill.accent = NULL, colour = NULL, + color = NULL, colour.accent1 = NULL, color.accent1 = NULL, + colour.accent2 = NULL, color.accent2 = NULL, alpha = NULL, + inherit.blank = FALSE) rel(x) } @@ -72,19 +80,30 @@ 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.accent}{accent fill colour, typically a darker version of fill} + +\item{colour.accent1, color.accent1}{accent colour 1, +typically a lighter version of colour} + +\item{colour.accent2, color.accent2}{accent colour 2, +typically a bright colour used for geom_smooth et al.} + +\item{alpha}{colour/fill transparency, between 0 & 1.} + \item{x}{A single number specifying size relative to parent element.} } \value{ An S3 object of class \code{element}, \code{rel}, or \code{margin}. } \description{ -In conjunction with the \link{theme} system, the \code{element_} functions +In conjunction with the \code{\link[=theme]{theme()}} system, the \code{element_} functions specify the display of how non-data components of the plot are a drawn. \itemize{ \item \code{element_blank}: draws nothing, and assigns no space. \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 8d4fb270f4..400cb1d958 100644 --- a/man/guide-exts.Rd +++ b/man/guide-exts.Rd @@ -12,7 +12,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_gengrob(guide, theme) } diff --git a/man/theme.Rd b/man/theme.Rd index bb0f543812..8a96a4d5b2 100644 --- a/man/theme.Rd +++ b/man/theme.Rd @@ -4,26 +4,27 @@ \alias{theme} \title{Modify components of a theme} \usage{ -theme(line, rect, text, title, aspect.ratio, axis.title, axis.title.x, - axis.title.x.top, axis.title.x.bottom, axis.title.y, axis.title.y.left, - axis.title.y.right, axis.text, axis.text.x, axis.text.x.top, - axis.text.x.bottom, axis.text.y, axis.text.y.left, axis.text.y.right, - axis.ticks, axis.ticks.x, axis.ticks.x.top, axis.ticks.x.bottom, axis.ticks.y, - axis.ticks.y.left, axis.ticks.y.right, axis.ticks.length, axis.line, - axis.line.x, axis.line.x.top, axis.line.x.bottom, axis.line.y, - axis.line.y.left, axis.line.y.right, legend.background, legend.margin, - legend.spacing, legend.spacing.x, legend.spacing.y, legend.key, - legend.key.size, legend.key.height, legend.key.width, legend.text, - legend.text.align, legend.title, legend.title.align, legend.position, - legend.direction, legend.justification, legend.box, legend.box.just, - legend.box.margin, legend.box.background, legend.box.spacing, - panel.background, panel.border, panel.spacing, panel.spacing.x, - panel.spacing.y, panel.grid, panel.grid.major, panel.grid.minor, - panel.grid.major.x, panel.grid.major.y, panel.grid.minor.x, - panel.grid.minor.y, panel.ontop, plot.background, plot.title, plot.subtitle, - plot.caption, plot.tag, plot.tag.position, plot.margin, strip.background, - strip.background.x, strip.background.y, strip.placement, strip.text, - strip.text.x, strip.text.y, strip.switch.pad.grid, strip.switch.pad.wrap, ..., +theme(line, rect, text, title, aspect.ratio, geom, axis.title, + axis.title.x, axis.title.x.top, axis.title.x.bottom, axis.title.y, + axis.title.y.left, axis.title.y.right, axis.text, axis.text.x, + axis.text.x.top, axis.text.x.bottom, axis.text.y, axis.text.y.left, + axis.text.y.right, axis.ticks, axis.ticks.x, axis.ticks.x.top, + axis.ticks.x.bottom, axis.ticks.y, axis.ticks.y.left, axis.ticks.y.right, + axis.ticks.length, axis.line, axis.line.x, axis.line.x.top, + axis.line.x.bottom, axis.line.y, axis.line.y.left, axis.line.y.right, + legend.background, legend.margin, legend.spacing, legend.spacing.x, + legend.spacing.y, legend.key, legend.key.size, legend.key.height, + legend.key.width, legend.text, legend.text.align, legend.title, + legend.title.align, legend.position, legend.direction, + legend.justification, legend.box, legend.box.just, legend.box.margin, + legend.box.background, legend.box.spacing, panel.background, + panel.border, panel.spacing, panel.spacing.x, panel.spacing.y, + panel.grid, panel.grid.major, panel.grid.minor, panel.grid.major.x, + panel.grid.major.y, panel.grid.minor.x, panel.grid.minor.y, panel.ontop, + plot.background, plot.title, plot.subtitle, plot.caption, plot.tag, + plot.tag.position, plot.margin, strip.background, strip.background.x, + strip.background.y, strip.placement, strip.text, strip.text.x, + strip.text.y, strip.switch.pad.grid, strip.switch.pad.wrap, ..., complete = FALSE, validate = TRUE) } \arguments{ @@ -38,6 +39,8 @@ inherits from \code{text})} \item{aspect.ratio}{aspect ratio of the panel} +\item{geom}{default geom aesthetics} + \item{axis.title}{label of axes (\code{element_text}; inherits from \code{text})} From 58a677d7fa33bfc7114a090f71aae743157cb232 Mon Sep 17 00:00:00 2001 From: Dana Seidel Date: Thu, 9 Aug 2018 11:38:28 -0700 Subject: [PATCH 07/21] Remove expr() and update aes names --- R/annotation-logticks.r | 10 +++++--- R/geom-abline.r | 11 +++++---- R/geom-boxplot.r | 14 +++++++---- R/geom-contour.r | 11 ++++++--- R/geom-crossbar.r | 11 ++++++--- R/geom-curve.r | 11 ++++++--- R/geom-density.r | 12 ++++++--- R/geom-density2d.r | 10 +++++--- R/geom-dotplot.r | 10 ++++---- R/geom-errorbar.r | 12 +++++---- R/geom-errorbarh.r | 12 +++++---- R/geom-hex.r | 6 ++--- R/geom-hline.r | 12 +++++---- R/geom-label.R | 18 +++++++++----- R/geom-linerange.r | 11 +++++---- R/geom-path.r | 10 +++++--- R/geom-point.r | 12 ++++++--- R/geom-pointrange.r | 14 ++++++----- R/geom-polygon.r | 9 ++++--- R/geom-quantile.r | 11 ++++++--- R/geom-raster.r | 2 +- R/geom-rect.r | 6 ++--- R/geom-ribbon.r | 22 +++++++++++------ R/geom-rug.r | 11 +++++---- R/geom-segment.r | 12 ++++++--- R/geom-smooth.r | 13 ++++++---- R/geom-text.r | 15 ++++++++---- R/geom-tile.r | 13 +++++++--- R/geom-violin.r | 12 +++++---- R/geom-vline.r | 11 ++++++--- R/theme-defaults.r | 28 +++++++++------------ R/theme-elements.r | 54 +++++++++++++++++++++++------------------ R/theme.r | 2 +- man/element.Rd | 16 ++++++------ 34 files changed, 261 insertions(+), 183 deletions(-) diff --git a/R/annotation-logticks.r b/R/annotation-logticks.r index 2e1367ad8e..331d751154 100644 --- a/R/annotation-logticks.r +++ b/R/annotation-logticks.r @@ -200,10 +200,12 @@ GeomLogticks <- ggproto("GeomLogticks", Geom, gTree(children = do.call("gList", ticks)) }, - default_aes = expr(aes( - colour = theme$geom$colour, size = 0.5, linetype = 1, - alpha = theme$geom$alpha - )) + default_aes = aes( + colour = theme$geom$col, + size = 0.5, + linetype = 1, + alpha = NA + ) ) diff --git a/R/geom-abline.r b/R/geom-abline.r index c3d228c140..b46e1ca22d 100644 --- a/R/geom-abline.r +++ b/R/geom-abline.r @@ -121,11 +121,12 @@ GeomAbline <- ggproto("GeomAbline", Geom, GeomSegment$draw_panel(unique(data), panel_params, coord) }, - default_aes = expr(aes( - colour = theme$geom$colour, - size = 0.5, linetype = 1, - alpha = theme$geom$alpha - )), + default_aes = aes( + colour = theme$geom$col, + size = 0.5, + linetype = 1, + alpha = NA + ), required_aes = c("slope", "intercept"), diff --git a/R/geom-boxplot.r b/R/geom-boxplot.r index 9ee4d26d1b..46bff9c44f 100644 --- a/R/geom-boxplot.r +++ b/R/geom-boxplot.r @@ -255,11 +255,15 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, draw_key = draw_key_boxplot, - 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" - )), + default_aes = aes( + weight = 1, + colour = theme$geom$col_1 , + fill = theme$geom$fill_1, + size = 0.5, + alpha = NA, + shape = 19, + linetype = "solid" + ), required_aes = c("x", "lower", "upper", "middle", "ymin", "ymax") ) diff --git a/R/geom-contour.r b/R/geom-contour.r index bd7a344bca..4c2e93aae5 100644 --- a/R/geom-contour.r +++ b/R/geom-contour.r @@ -73,8 +73,11 @@ geom_contour <- function(mapping = NULL, data = NULL, #' @export #' @include geom-path.r GeomContour <- ggproto("GeomContour", GeomPath, - default_aes = expr(aes( - weight = 1, colour = theme$geom$colour.accent2, - size = 0.5, linetype = 1, alpha = theme$geom$alpha - )) + default_aes = aes( + weight = 1, + colour = theme$geom$col_2, + size = 0.5, + linetype = 1, + alpha = NA + ) ) diff --git a/R/geom-crossbar.r b/R/geom-crossbar.r index 36ea1eabd4..5a4168050d 100644 --- a/R/geom-crossbar.r +++ b/R/geom-crossbar.r @@ -32,10 +32,13 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom, GeomErrorbar$setup_data(data, params) }, - default_aes = expr(aes( - colour = theme$geom$colour, fill = NA, size = 0.5, - linetype = 1, alpha = theme$geom$alpha - )), + default_aes = aes( + colour = theme$geom$col, + fill = NA, + size = 0.5, + linetype = 1, + alpha = NA + ), required_aes = c("x", "y", "ymin", "ymax"), diff --git a/R/geom-curve.r b/R/geom-curve.r index 8adc00f356..23bb8c660e 100644 --- a/R/geom-curve.r +++ b/R/geom-curve.r @@ -40,10 +40,13 @@ geom_curve <- function(mapping = NULL, data = NULL, #' @usage NULL #' @export GeomCurve <- ggproto("GeomCurve", GeomSegment, - default_aes = expr(aes( - colour = theme$geom$colour, size = 0.5, linetype = 1, - alpha = theme$geom$alpha - )), + default_aes = aes( + colour = theme$geom$col, + 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-density.r b/R/geom-density.r index 5f0a556757..556dba6bcd 100644 --- a/R/geom-density.r +++ b/R/geom-density.r @@ -73,8 +73,12 @@ geom_density <- function(mapping = NULL, data = NULL, #' @export #' @include geom-ribbon.r GeomDensity <- ggproto("GeomDensity", GeomArea, - default_aes = expr(aes( - fill = NA, weight = 1, colour = theme$geom$colour, - alpha = theme$geom$alpha, size = 0.5, linetype = 1 - )) + default_aes = aes( + fill = NA, + weight = 1, + colour = theme$geom$col, + alpha = NA, + size = 0.5, + linetype = 1 + ) ) diff --git a/R/geom-density2d.r b/R/geom-density2d.r index 19ec9c515c..7ce0f9f433 100644 --- a/R/geom-density2d.r +++ b/R/geom-density2d.r @@ -82,8 +82,10 @@ geom_density2d <- geom_density_2d #' @usage NULL #' @export GeomDensity2d <- ggproto("GeomDensity2d", GeomPath, - default_aes = expr(aes( - colour = theme$geom$colour.accent2, - size = 0.5, linetype = 1, alpha = theme$geom$alpha - )) + default_aes = aes( + colour = theme$geom$col_2, + size = 0.5, + linetype = 1, + alpha = NA + ) ) diff --git a/R/geom-dotplot.r b/R/geom-dotplot.r index 6ea477dc95..c4958e4b23 100644 --- a/R/geom-dotplot.r +++ b/R/geom-dotplot.r @@ -175,11 +175,11 @@ GeomDotplot <- ggproto("GeomDotplot", Geom, required_aes = c("x", "y"), non_missing_aes = c("size", "shape"), - default_aes = expr(aes( - colour = theme$geom$colour, - fill = theme$geom$colour, - alpha = theme$geom$alpha - )), + default_aes = aes( + colour = theme$geom$col, + fill = theme$geom$col, + alpha = NA + ), setup_data = function(data, params) { data$width <- data$width %||% diff --git a/R/geom-errorbar.r b/R/geom-errorbar.r index b0f95b954d..369291a843 100644 --- a/R/geom-errorbar.r +++ b/R/geom-errorbar.r @@ -26,11 +26,13 @@ geom_errorbar <- function(mapping = NULL, data = NULL, #' @usage NULL #' @export GeomErrorbar <- ggproto("GeomErrorbar", Geom, - default_aes = expr(aes( - colour = theme$geom$colour, - size = 0.5, linetype = 1, width = 0.5, - alpha = theme$geom$alpha - )), + default_aes = aes( + colour = theme$geom$col, + 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 21dcec24e1..7de57bc043 100644 --- a/R/geom-errorbarh.r +++ b/R/geom-errorbarh.r @@ -48,11 +48,13 @@ geom_errorbarh <- function(mapping = NULL, data = NULL, #' @usage NULL #' @export GeomErrorbarh <- ggproto("GeomErrorbarh", Geom, - default_aes = expr(aes( - colour = theme$geom$colour, - size = 0.5, linetype = 1, height = 0.5, - alpha = theme$geom$alpha - )), + default_aes = aes( + colour = theme$geom$col, + size = 0.5, + linetype = 1, + height = 0.5, + alpha = NA + ), draw_key = draw_key_path, diff --git a/R/geom-hex.r b/R/geom-hex.r index f8da21f243..750b5742d6 100644 --- a/R/geom-hex.r +++ b/R/geom-hex.r @@ -73,13 +73,13 @@ GeomHex <- ggproto("GeomHex", Geom, required_aes = c("x", "y"), - default_aes = expr(aes( + default_aes = aes( colour = NA, fill = theme$geom$fill, size = 0.5, linetype = 1, - alpha = theme$geom$alpha - )), + alpha = NA + ), draw_key = draw_key_polygon ) diff --git a/R/geom-hline.r b/R/geom-hline.r index 2e14715031..dac7214338 100644 --- a/R/geom-hline.r +++ b/R/geom-hline.r @@ -47,11 +47,13 @@ GeomHline <- ggproto("GeomHline", Geom, GeomSegment$draw_panel(unique(data), panel_params, coord) }, - default_aes = expr(aes( - colour = theme$geom$colour, - size = 0.5, linetype = 1, - alpha = theme$geom$alpha - )), + default_aes = aes( + colour = theme$geom$col, + 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 a73a589434..b624d971c7 100644 --- a/R/geom-label.R +++ b/R/geom-label.R @@ -50,12 +50,18 @@ geom_label <- function(mapping = NULL, data = NULL, GeomLabel <- ggproto("GeomLabel", Geom, required_aes = c("x", "y", "label"), - 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 - )), + default_aes = aes( + colour = theme$text$colour, + fill = theme$geom$fill_1, + size = 3.88, + angle = 0, + hjust = 0.5, + vjust = 0.5, + alpha = NA, + 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, diff --git a/R/geom-linerange.r b/R/geom-linerange.r index ee50fccc26..f1eaf956fa 100644 --- a/R/geom-linerange.r +++ b/R/geom-linerange.r @@ -83,11 +83,12 @@ geom_linerange <- function(mapping = NULL, data = NULL, #' @usage NULL #' @export GeomLinerange <- ggproto("GeomLinerange", Geom, - default_aes = expr(aes( - colour = theme$geom$colour, - size = 0.5, linetype = 1, - alpha = theme$geom$alpha - )), + default_aes = aes( + colour = theme$geom$col, + 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 e335bb11b7..b1e7a59eca 100644 --- a/R/geom-path.r +++ b/R/geom-path.r @@ -123,10 +123,12 @@ geom_path <- function(mapping = NULL, data = NULL, GeomPath <- ggproto("GeomPath", Geom, required_aes = c("x", "y"), - default_aes = expr(aes( - colour = theme$geom$colour, size = 0.5, linetype = 1, - alpha = theme$geom$alpha - )), + default_aes = aes( + colour = theme$geom$col, + 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 f41fa67362..5bdccfa787 100644 --- a/R/geom-point.r +++ b/R/geom-point.r @@ -108,10 +108,14 @@ 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 = expr(aes( - shape = 19, colour = theme$geom$colour, size = 1.5, - fill = NA, alpha = theme$geom$alpha, stroke = 0.5 - )), + default_aes = aes( + shape = 19, + colour = theme_aes("col", theme), + size = 1.5, + fill = NA, + alpha = NA, + stroke = 0.5 + ), draw_panel = function(data, panel_params, coord, na.rm = FALSE) { if (is.character(data$shape)) { diff --git a/R/geom-pointrange.r b/R/geom-pointrange.r index e62d70a650..44b1c3f4cf 100644 --- a/R/geom-pointrange.r +++ b/R/geom-pointrange.r @@ -28,13 +28,15 @@ geom_pointrange <- function(mapping = NULL, data = NULL, #' @usage NULL #' @export GeomPointrange <- ggproto("GeomPointrange", Geom, - default_aes = expr(aes( - colour = theme$geom$colour, - size = 0.5, linetype = 1, - shape = 19, fill = NA, - alpha = theme$geom$alpha, + default_aes = aes( + colour = theme$geom$col, + 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 275a02b59c..9af88332be 100644 --- a/R/geom-polygon.r +++ b/R/geom-polygon.r @@ -105,12 +105,13 @@ GeomPolygon <- ggproto("GeomPolygon", Geom, ) }, - default_aes = expr(aes( + default_aes = aes( colour = NA, fill = theme$geom$fill, - size = 0.5, linetype = 1, - alpha = theme$geom$alpha - )), + size = 0.5, + linetype = 1, + alpha = NA + ), handle_na = function(data, params) { data diff --git a/R/geom-quantile.r b/R/geom-quantile.r index a434b930f3..11cea3857a 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 = expr(aes( - weight = 1, colour = theme$geom$colour.accent2, size = 0.5, linetype = 1, - alpha = theme$geom$alpha - )) + default_aes = aes( + weight = 1, + colour = theme$geom$col_2, + size = 0.5, + linetype = 1, + alpha = NA + ) ) diff --git a/R/geom-raster.r b/R/geom-raster.r index 36428cdd78..a1b08f4c52 100644 --- a/R/geom-raster.r +++ b/R/geom-raster.r @@ -44,7 +44,7 @@ geom_raster <- function(mapping = NULL, data = NULL, #' @usage NULL #' @export GeomRaster <- ggproto("GeomRaster", Geom, - default_aes = expr(aes(fill = theme$geom$fill, alpha = theme$geom$alpha)), + default_aes = aes(fill = theme$geom$fill, alpha = NA), non_missing_aes = "fill", required_aes = c("x", "y"), diff --git a/R/geom-rect.r b/R/geom-rect.r index f5d7238d10..5f4e5a4ab6 100644 --- a/R/geom-rect.r +++ b/R/geom-rect.r @@ -26,13 +26,13 @@ geom_rect <- function(mapping = NULL, data = NULL, #' @usage NULL #' @export GeomRect <- ggproto("GeomRect", Geom, - default_aes = expr(aes( + default_aes = aes( colour = NA, fill = theme$geom$fill, size = 0.5, linetype = 1, - alpha = theme$geom$alpha - )), + alpha = NA + ), required_aes = c("xmin", "xmax", "ymin", "ymax"), diff --git a/R/geom-ribbon.r b/R/geom-ribbon.r index 34d8834d6b..7f4c6806d7 100644 --- a/R/geom-ribbon.r +++ b/R/geom-ribbon.r @@ -57,10 +57,13 @@ geom_ribbon <- function(mapping = NULL, data = NULL, #' @usage NULL #' @export GeomRibbon <- ggproto("GeomRibbon", Geom, - default_aes = expr(aes( - colour = NA, fill = theme$geom$fill, - size = 0.5, linetype = 1, alpha = theme$geom$alpha - )), + default_aes = aes( + colour = NA, + fill = theme$geom$fill, + size = 0.5, + linetype = 1, + alpha = NA + ), required_aes = c("x", "ymin", "ymax"), @@ -133,10 +136,13 @@ geom_area <- function(mapping = NULL, data = NULL, stat = "identity", #' @usage NULL #' @export GeomArea <- ggproto("GeomArea", GeomRibbon, - default_aes = expr(aes( - colour = NA, fill = theme$geom$fill, - size = 0.5, linetype = 1, alpha = theme$geom$alpha - )), + default_aes = aes( + colour = NA, + fill = theme$geom$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 2ad60a531f..83419aa291 100644 --- a/R/geom-rug.r +++ b/R/geom-rug.r @@ -106,11 +106,12 @@ GeomRug <- ggproto("GeomRug", Geom, gTree(children = do.call("gList", rugs)) }, - default_aes = expr(aes( - colour = theme$geom$colour, - size = 0.5, linetype = 1, - alpha = theme$geom$alpha - )), + default_aes = aes( + colour = theme$geom$col, + 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 8b3bec1624..8ff0df491f 100644 --- a/R/geom-segment.r +++ b/R/geom-segment.r @@ -100,11 +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 = expr(aes( - colour = theme$geom$colour, size = 0.5, linetype = 1, - alpha = theme$geom$alpha - )), + + default_aes = aes( + colour = theme$geom$col, + 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-smooth.r b/R/geom-smooth.r index c147431c20..61aafc04fd 100644 --- a/R/geom-smooth.r +++ b/R/geom-smooth.r @@ -139,9 +139,12 @@ GeomSmooth <- ggproto("GeomSmooth", Geom, required_aes = c("x", "y"), optional_aes = c("ymin", "ymax"), - default_aes = expr(aes( - colour = theme$geom$colour.accent2, - fill = theme$geom$fill, size = 1, - linetype = 1, weight = 1, alpha = 0.4 - )) + default_aes = aes( + colour = theme$geom$col_2, + fill = theme$geom$fill, + size = 1, + linetype = 1, + weight = 1, + alpha = 0.4 + ) ) diff --git a/R/geom-text.r b/R/geom-text.r index 0175cd4ca6..65ca7ccebd 100644 --- a/R/geom-text.r +++ b/R/geom-text.r @@ -166,12 +166,17 @@ geom_text <- function(mapping = NULL, data = NULL, GeomText <- ggproto("GeomText", Geom, required_aes = c("x", "y", "label"), - default_aes = expr(aes( + default_aes = aes( colour = theme$text$colour, - 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 - )), + size = 3.88, + angle = 0, + hjust = 0.5, + vjust = 0.5, + alpha = NA, + family = theme$text$family, + fontface = theme$text$face, + lineheight = theme$text$lineheight + ), draw_panel = function(data, panel_params, coord, parse = FALSE, na.rm = FALSE, check_overlap = FALSE) { diff --git a/R/geom-tile.r b/R/geom-tile.r index c90afd237a..4c17ab6dc2 100644 --- a/R/geom-tile.r +++ b/R/geom-tile.r @@ -93,10 +93,15 @@ GeomTile <- ggproto("GeomTile", GeomRect, ) }, - default_aes = expr(aes( - fill = theme$geom$fill, colour = NA, size = 0.1, - linetype = 1, alpha = theme$geom$alpha, width = NA, height = NA - )), + default_aes = aes( + fill = theme$geom$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 998c41ca72..668a04a6bf 100644 --- a/R/geom-violin.r +++ b/R/geom-violin.r @@ -154,12 +154,14 @@ GeomViolin <- ggproto("GeomViolin", Geom, draw_key = draw_key_polygon, - default_aes = expr(aes( - weight = 1, colour = theme$geom$colour.accent1, - fill = theme$geom$fill.accent, - size = 0.5, alpha = theme$geom$alpha, + default_aes = aes( + weight = 1, + colour = theme$geom$col_1, + fill = theme$geom$fill_1, + size = 0.5, + alpha = NA, linetype = "solid" - )), + ), required_aes = c("x", "y") ) diff --git a/R/geom-vline.r b/R/geom-vline.r index 54d7ee1f8d..384fa37b18 100644 --- a/R/geom-vline.r +++ b/R/geom-vline.r @@ -47,10 +47,13 @@ GeomVline <- ggproto("GeomVline", Geom, GeomSegment$draw_panel(unique(data), panel_params, coord) }, - default_aes = expr(aes( - colour = theme$geom$colour, size = 0.5, linetype = 1, - alpha = theme$geom$alpha - )), + default_aes = aes( + colour = theme$geom$col, + size = 0.5, + linetype = 1, + alpha = NA + ), + required_aes = "xintercept", draw_key = draw_key_vline diff --git a/R/theme-defaults.r b/R/theme-defaults.r index e2ee0f021a..09adc4bd26 100644 --- a/R/theme-defaults.r +++ b/R/theme-defaults.r @@ -130,10 +130,9 @@ theme_grey <- function(base_size = 11, base_family = "", ), geom = element_geom( - colour = "black", colour.accent1 = "grey20", - colour.accent2 = "#3366FF", - fill = "grey35", fill.accent = "white", - alpha = NA + col = "black", col_1 = "grey20", + col_2 = "#3366FF", + fill = "grey35", fill_1 = "white" ), axis.line = element_blank(), axis.line.x = NULL, @@ -373,10 +372,9 @@ theme_dark <- function(base_size = 11, base_family = "", # make the geom stand out geom = element_geom( - colour = "white", colour.accent1 = "grey90", - colour.accent2 = "#3366FF", - fill = "grey75", fill.accent = "grey35", - alpha = NA + col = "white", col_1 = "grey90", + col_2 = "#3366FF", + fill = "grey75", fill_1 = "grey35" ), # match axes ticks thickness to gridlines axis.ticks = element_line(colour = "grey20", size = rel(0.5)), @@ -470,10 +468,9 @@ theme_void <- function(base_size = 11, base_family = "", margin = margin(), debug = FALSE ), geom = element_geom( - colour = "black", colour.accent1 = "grey20", - colour.accent2 = "#3366FF", - fill = "grey35", fill.accent = "white", - alpha = NA + col = "black", col_1 = "grey20", + col_2 = "#3366FF", + fill = "grey35", fill_1 = "white" ), axis.text = element_blank(), axis.title = element_blank(), @@ -537,10 +534,9 @@ theme_test <- function(base_size = 11, base_family = "", margin = margin(), debug = FALSE ), geom = element_geom( - colour = "black", colour.accent1 = "grey20", - colour.accent2 = "#3366FF", - fill = "grey35", fill.accent = "white", - alpha = NA + col = "black", col_1 = "grey20", + col_2 = "#3366FF", + fill = "grey35", fill_1 = "white" ), axis.line = element_blank(), axis.line.x = NULL, diff --git a/R/theme-elements.r b/R/theme-elements.r index c50b231ade..8062b3e1e5 100644 --- a/R/theme-elements.r +++ b/R/theme-elements.r @@ -121,38 +121,47 @@ element_text <- function(family = NULL, face = NULL, colour = NULL, ) } -#' @param colour.accent1,color.accent1 accent colour 1, +#' @param col default geom colour +#' @param col_1 accent colour 1, #' typically a lighter version of colour -#' @param colour.accent2,color.accent2 accent colour 2, +#' @param col_2 accent colour 2, #' typically a bright colour used for geom_smooth et al. -#' @param fill.accent accent fill colour, typically a darker version of fill -#' @param alpha colour/fill transparency, between 0 & 1. +#' @param fill_1 accent fill colour, typically a darker version of fill #' @export #' @rdname element -element_geom <- function(fill = NULL, fill.accent = NULL, - colour = NULL, color = NULL, - colour.accent1 = NULL, color.accent1 = NULL, - colour.accent2 = NULL, color.accent2 = NULL, - alpha = NULL, inherit.blank = FALSE) { - - if (!is.null(color)) colour <- color - if (!is.null(color.accent1)) colour.accent1 <- color.accent1 - if (!is.null(color.accent2)) colour.accent2 <- color.accent2 +element_geom <- function(fill = NULL, + fill_1 = NULL, + col = NULL, + col_1 = NULL, + col_2 = NULL, + inherit.blank = FALSE) { structure( list( fill = fill, - colour = colour, - fill.accent = fill.accent, - colour.accent1 = colour.accent1, - colour.accent2 = colour.accent2, - alpha = alpha, + col = col, + fill_1 = fill_1, + col_1 = col_1, + col_2 = col_2, inherit.blank = inherit.blank ), class = c("element_geom", "element") ) } +#' Retrieve geom defaults from plot theme +#' +#' @param aes character string nameing a themeable aesthetic, see [element_geom()] +#' @param theme plot theme +#' +#' @keywords internal +#' @noRd +#' +theme_aes <- function(aes, theme){ + theme$geom[aes][[1]] +} + + #' @export print.element <- function(x, ...) utils::str(x) @@ -286,7 +295,6 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) { list(class = class, inherit = inherit, description = description) } - # This data structure represents the theme elements and the inheritance # among them. ggplot_global$element_tree <- list( @@ -303,7 +311,6 @@ ggplot_global$element_tree <- list( 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"), - geom = el_def("element_geom", "geom"), 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"), @@ -333,8 +340,8 @@ ggplot_global$element_tree <- list( 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"), @@ -381,7 +388,8 @@ ggplot_global$element_tree <- list( 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", "geom") ) diff --git a/R/theme.r b/R/theme.r index 0d08d0ffee..5446d0b0c4 100644 --- a/R/theme.r +++ b/R/theme.r @@ -253,8 +253,8 @@ theme <- function(line, rect, text, title, - aspect.ratio, geom, + aspect.ratio, axis.title, axis.title.x, axis.title.x.top, diff --git a/man/element.Rd b/man/element.Rd index 928f18cbe9..961982754f 100644 --- a/man/element.Rd +++ b/man/element.Rd @@ -26,10 +26,8 @@ element_text(family = NULL, face = NULL, colour = NULL, lineheight = NULL, color = NULL, margin = NULL, debug = NULL, inherit.blank = FALSE) -element_geom(fill = NULL, fill.accent = NULL, colour = NULL, - color = NULL, colour.accent1 = NULL, color.accent1 = NULL, - colour.accent2 = NULL, color.accent2 = NULL, alpha = NULL, - inherit.blank = FALSE) +element_geom(fill = NULL, fill_1 = NULL, col = NULL, col_1 = NULL, + col_2 = NULL, inherit.blank = FALSE) rel(x) } @@ -80,16 +78,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.accent}{accent fill colour, typically a darker version of fill} +\item{fill_1}{accent fill colour, typically a darker version of fill} + +\item{col}{default geom colour} -\item{colour.accent1, color.accent1}{accent colour 1, +\item{col_1}{accent colour 1, typically a lighter version of colour} -\item{colour.accent2, color.accent2}{accent colour 2, +\item{col_2}{accent colour 2, typically a bright colour used for geom_smooth et al.} -\item{alpha}{colour/fill transparency, between 0 & 1.} - \item{x}{A single number specifying size relative to parent element.} } \value{ From 23fdf39de17ae2ac32e976e581927eac523637d3 Mon Sep 17 00:00:00 2001 From: Dana Seidel Date: Thu, 9 Aug 2018 11:38:48 -0700 Subject: [PATCH 08/21] Update implementation given feedback --- R/geom-.r | 14 ++--- R/guide-legend.r | 136 ++++++++++++++++++++++++++--------------------- R/layer.r | 5 +- 3 files changed, 87 insertions(+), 68 deletions(-) diff --git a/R/geom-.r b/R/geom-.r index 9935307db3..7b8feed1e9 100644 --- a/R/geom-.r +++ b/R/geom-.r @@ -106,15 +106,15 @@ 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(), theme) { - - # evaluates defaults given plot theme + # evaluate defaults according to theme + eval_defaults = function(self, theme) { if (length(theme) == 0) theme <- theme_grey() - env <- new.env() - env$theme <- theme - defaults <- rlang::eval_tidy(self$default_aes, env) + lapply(self$default_aes, rlang::eval_tidy, data = list(theme = theme)) + }, + + # Combine data with defaults and set aesthetics from parameters + use_defaults = function(self, data, defaults, params = list()) { # Fill in missing aesthetics with their defaults missing_aes <- setdiff(names(defaults), names(data)) diff --git a/R/guide-legend.r b/R/guide-legend.r index a4e1d3570f..b1456c8698 100644 --- a/R/guide-legend.r +++ b/R/guide-legend.r @@ -121,7 +121,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, @@ -149,7 +149,6 @@ guide_legend <- function(# title reverse = FALSE, order = 0, ...) { - if (!is.null(keywidth) && !is.unit(keywidth)) { keywidth <- unit(keywidth, default.unit) } @@ -264,7 +263,12 @@ guide_geom.legend <- function(guide, layers, default_mapping, theme) { n <- vapply(layer$aes_params, length, integer(1)) params <- layer$aes_params[n == 1] - data <- layer$geom$use_defaults(guide$key[matched], params, theme) + defaults <- layer$geom$eval_defaults(theme = theme) + data <- layer$geom$use_defaults( + data = guide$key[matched], + defaults = defaults, + params = params + ) } else { return(NULL) } @@ -274,7 +278,12 @@ guide_geom.legend <- function(guide, layers, default_mapping, theme) { # Default is to exclude it return(NULL) } else { - data <- layer$geom$use_defaults(NULL, layer$aes_params)[rep(1, nrow(guide$key)), ] + defaults <- layer$geom$eval_defaults(theme = theme) + data <- layer$geom$use_defaults( + data = NULL, + defaults = defaults, + params = layer$aes_params + )[rep(1, nrow(guide$key)), ] } } @@ -301,8 +310,9 @@ guide_gengrob.legend <- function(guide, theme) { # default setting label.position <- guide$label.position %||% "right" - if (!label.position %in% c("top", "bottom", "left", "right")) + if (!label.position %in% c("top", "bottom", "left", "right")) { stop("label position \"", label.position, "\" is invalid") + } nbreak <- nrow(guide$key) @@ -313,7 +323,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, @@ -331,7 +342,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 @@ -391,7 +402,7 @@ guide_gengrob.legend <- function(guide, theme) { key_sizes <- apply(key_size_mat, 1, max) if (!is.null(guide$nrow) && !is.null(guide$ncol) && - guide$nrow * guide$ncol < nbreak) { + guide$nrow * guide$ncol < nbreak) { stop( "`nrow` * `ncol` needs to be larger than the number of breaks", call. = FALSE @@ -515,7 +526,8 @@ guide_gengrob.legend <- function(guide, theme) { label.row = R * 2 - 1, label.col = C * 4 - 1 ) - }) + } + ) } else { switch( label.position, @@ -580,59 +592,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 @@ -738,9 +756,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/layer.r b/R/layer.r index e8a8393f11..114cbd9b39 100644 --- a/R/layer.r +++ b/R/layer.r @@ -305,8 +305,11 @@ Layer <- ggproto("Layer", NULL, compute_geom_2 = function(self, data, plot) { if (empty(data)) return(data) + # evaluate defaults for theme + defaults <- self$geom$eval_defaults(theme = plot$theme) + # Combine aesthetics, defaults, & params - self$geom$use_defaults(data, self$aes_params, plot$theme) + self$geom$use_defaults(data, defaults = defaults, params = self$aes_params) }, finish_statistics = function(self, data) { From af8c4620f43616081c3ac17a639fcbd506cdf864 Mon Sep 17 00:00:00 2001 From: Dana Seidel Date: Wed, 5 Sep 2018 18:44:11 -0700 Subject: [PATCH 09/21] Implement element_geom() as suggested by Claus --- R/theme-defaults.r | 16 ++++++++-------- R/theme-elements.r | 41 ++++++++++++++++------------------------- 2 files changed, 24 insertions(+), 33 deletions(-) diff --git a/R/theme-defaults.r b/R/theme-defaults.r index 09adc4bd26..a99fcce56b 100644 --- a/R/theme-defaults.r +++ b/R/theme-defaults.r @@ -130,8 +130,8 @@ theme_grey <- function(base_size = 11, base_family = "", ), geom = element_geom( - col = "black", col_1 = "grey20", - col_2 = "#3366FF", + colour = "black", colour_1 = "grey20", + colour_2 = "#3366FF", fill = "grey35", fill_1 = "white" ), axis.line = element_blank(), @@ -372,8 +372,8 @@ theme_dark <- function(base_size = 11, base_family = "", # make the geom stand out geom = element_geom( - col = "white", col_1 = "grey90", - col_2 = "#3366FF", + colour = "white", colour_1 = "grey90", + colour_2 = "#809FFF", fill = "grey75", fill_1 = "grey35" ), # match axes ticks thickness to gridlines @@ -468,8 +468,8 @@ theme_void <- function(base_size = 11, base_family = "", margin = margin(), debug = FALSE ), geom = element_geom( - col = "black", col_1 = "grey20", - col_2 = "#3366FF", + colour = "black", colour_1 = "grey20", + colour_2 = "#3366FF", fill = "grey35", fill_1 = "white" ), axis.text = element_blank(), @@ -534,8 +534,8 @@ theme_test <- function(base_size = 11, base_family = "", margin = margin(), debug = FALSE ), geom = element_geom( - col = "black", col_1 = "grey20", - col_2 = "#3366FF", + colour = "black", colour_1 = "grey20", + colour_2 = "#3366FF", fill = "grey35", fill_1 = "white" ), axis.line = element_blank(), diff --git a/R/theme-elements.r b/R/theme-elements.r index 8062b3e1e5..3349a88483 100644 --- a/R/theme-elements.r +++ b/R/theme-elements.r @@ -121,47 +121,38 @@ element_text <- function(family = NULL, face = NULL, colour = NULL, ) } -#' @param col default geom colour -#' @param col_1 accent colour 1, +#' @param colour_1 accent colour 1, #' typically a lighter version of colour -#' @param col_2 accent colour 2, +#' @param colour_2 accent colour 2, #' typically a bright colour used for geom_smooth et al. #' @param fill_1 accent fill colour, typically a darker version of fill #' @export #' @rdname element element_geom <- function(fill = NULL, fill_1 = NULL, - col = NULL, - col_1 = NULL, - col_2 = NULL, + colour = NULL, + colour_1 = NULL, + colour_2 = NULL, + ..., inherit.blank = FALSE) { + extra_aes <- ggplot2:::rename_aes(list(...)) - structure( + aes_list <- modifyList( list( - fill = fill, - col = col, - fill_1 = fill_1, - col_1 = col_1, - col_2 = col_2, + fill = fill, fill_1 = fill_1, colour = colour, + colour_1 = colour_1, colour_2 = colour_2, inherit.blank = inherit.blank ), - class = c("element_geom", "element") + extra_aes, + keep.null = TRUE ) -} -#' Retrieve geom defaults from plot theme -#' -#' @param aes character string nameing a themeable aesthetic, see [element_geom()] -#' @param theme plot theme -#' -#' @keywords internal -#' @noRd -#' -theme_aes <- function(aes, theme){ - theme$geom[aes][[1]] + structure( + aes_list, + class = c("element_geom", "element") + ) } - #' @export print.element <- function(x, ...) utils::str(x) From a4f5c2f62db2dc646dc68fc0d04b3bad7ebc8816 Mon Sep 17 00:00:00 2001 From: Dana Seidel Date: Wed, 5 Sep 2018 18:46:43 -0700 Subject: [PATCH 10/21] Embed and implement from_theme() to evaluate aes --- R/annotation-logticks.r | 2 +- R/geom-.r | 7 ++++++- R/geom-abline.r | 2 +- R/geom-boxplot.r | 4 ++-- R/geom-contour.r | 2 +- R/geom-crossbar.r | 2 +- R/geom-curve.r | 2 +- R/geom-density.r | 2 +- R/geom-density2d.r | 2 +- R/geom-dotplot.r | 4 ++-- R/geom-errorbar.r | 2 +- R/geom-errorbarh.r | 2 +- R/geom-hex.r | 2 +- R/geom-hline.r | 2 +- R/geom-label.R | 10 +++++----- R/geom-linerange.r | 2 +- R/geom-path.r | 2 +- R/geom-point.r | 2 +- R/geom-pointrange.r | 2 +- R/geom-polygon.r | 2 +- R/geom-quantile.r | 2 +- R/geom-raster.r | 7 +++++-- R/geom-rect.r | 2 +- R/geom-ribbon.r | 4 ++-- R/geom-rug.r | 2 +- R/geom-segment.r | 2 +- R/geom-smooth.r | 4 ++-- R/geom-text.r | 8 ++++---- R/geom-tile.r | 2 +- R/geom-violin.r | 4 ++-- R/geom-vline.r | 2 +- 31 files changed, 52 insertions(+), 44 deletions(-) diff --git a/R/annotation-logticks.r b/R/annotation-logticks.r index 331d751154..b7d40c6faf 100644 --- a/R/annotation-logticks.r +++ b/R/annotation-logticks.r @@ -201,7 +201,7 @@ GeomLogticks <- ggproto("GeomLogticks", Geom, }, default_aes = aes( - colour = theme$geom$col, + colour = from_theme("colour"), size = 0.5, linetype = 1, alpha = NA diff --git a/R/geom-.r b/R/geom-.r index 964043ff24..ff5e5aef50 100644 --- a/R/geom-.r +++ b/R/geom-.r @@ -108,9 +108,14 @@ Geom <- ggproto("Geom", # evaluate defaults according to theme eval_defaults = function(self, theme) { + if (length(theme) == 0) theme <- theme_grey() - lapply(self$default_aes, rlang::eval_tidy, data = list(theme = theme)) + 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 diff --git a/R/geom-abline.r b/R/geom-abline.r index b46e1ca22d..65eb2548f8 100644 --- a/R/geom-abline.r +++ b/R/geom-abline.r @@ -122,7 +122,7 @@ GeomAbline <- ggproto("GeomAbline", Geom, }, default_aes = aes( - colour = theme$geom$col, + colour = from_theme("colour"), size = 0.5, linetype = 1, alpha = NA diff --git a/R/geom-boxplot.r b/R/geom-boxplot.r index 46bff9c44f..cc4de71c5f 100644 --- a/R/geom-boxplot.r +++ b/R/geom-boxplot.r @@ -257,8 +257,8 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, default_aes = aes( weight = 1, - colour = theme$geom$col_1 , - fill = theme$geom$fill_1, + colour = from_theme("colour_1") , + fill = from_theme("fill_1"), size = 0.5, alpha = NA, shape = 19, diff --git a/R/geom-contour.r b/R/geom-contour.r index 4c2e93aae5..43bb6dea64 100644 --- a/R/geom-contour.r +++ b/R/geom-contour.r @@ -75,7 +75,7 @@ geom_contour <- function(mapping = NULL, data = NULL, GeomContour <- ggproto("GeomContour", GeomPath, default_aes = aes( weight = 1, - colour = theme$geom$col_2, + 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 5a4168050d..a9360f35f1 100644 --- a/R/geom-crossbar.r +++ b/R/geom-crossbar.r @@ -33,7 +33,7 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom, }, default_aes = aes( - colour = theme$geom$col, + colour = from_theme("colour"), fill = NA, size = 0.5, linetype = 1, diff --git a/R/geom-curve.r b/R/geom-curve.r index 23bb8c660e..1faab4653a 100644 --- a/R/geom-curve.r +++ b/R/geom-curve.r @@ -41,7 +41,7 @@ geom_curve <- function(mapping = NULL, data = NULL, #' @export GeomCurve <- ggproto("GeomCurve", GeomSegment, default_aes = aes( - colour = theme$geom$col, + colour = from_theme("colour"), size = 0.5, linetype = 1, alpha = NA diff --git a/R/geom-density.r b/R/geom-density.r index 556dba6bcd..959e0578cd 100644 --- a/R/geom-density.r +++ b/R/geom-density.r @@ -76,7 +76,7 @@ GeomDensity <- ggproto("GeomDensity", GeomArea, default_aes = aes( fill = NA, weight = 1, - colour = theme$geom$col, + colour = from_theme("colour"), alpha = NA, size = 0.5, linetype = 1 diff --git a/R/geom-density2d.r b/R/geom-density2d.r index 7ce0f9f433..2d71c1654a 100644 --- a/R/geom-density2d.r +++ b/R/geom-density2d.r @@ -83,7 +83,7 @@ geom_density2d <- geom_density_2d #' @export GeomDensity2d <- ggproto("GeomDensity2d", GeomPath, default_aes = aes( - colour = theme$geom$col_2, + 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 c4958e4b23..5b3e673d81 100644 --- a/R/geom-dotplot.r +++ b/R/geom-dotplot.r @@ -176,8 +176,8 @@ GeomDotplot <- ggproto("GeomDotplot", Geom, non_missing_aes = c("size", "shape"), default_aes = aes( - colour = theme$geom$col, - fill = theme$geom$col, + colour = from_theme("colour"), + fill = from_theme("colour"), alpha = NA ), diff --git a/R/geom-errorbar.r b/R/geom-errorbar.r index 369291a843..4dde000a5e 100644 --- a/R/geom-errorbar.r +++ b/R/geom-errorbar.r @@ -27,7 +27,7 @@ geom_errorbar <- function(mapping = NULL, data = NULL, #' @export GeomErrorbar <- ggproto("GeomErrorbar", Geom, default_aes = aes( - colour = theme$geom$col, + colour = from_theme("colour"), size = 0.5, linetype = 1, width = 0.5, diff --git a/R/geom-errorbarh.r b/R/geom-errorbarh.r index 7de57bc043..5d848700be 100644 --- a/R/geom-errorbarh.r +++ b/R/geom-errorbarh.r @@ -49,7 +49,7 @@ geom_errorbarh <- function(mapping = NULL, data = NULL, #' @export GeomErrorbarh <- ggproto("GeomErrorbarh", Geom, default_aes = aes( - colour = theme$geom$col, + colour = from_theme("colour"), size = 0.5, linetype = 1, height = 0.5, diff --git a/R/geom-hex.r b/R/geom-hex.r index 750b5742d6..95c2b8a626 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 = theme$geom$fill, + fill = from_theme("fill"), size = 0.5, linetype = 1, alpha = NA diff --git a/R/geom-hline.r b/R/geom-hline.r index dac7214338..754687639d 100644 --- a/R/geom-hline.r +++ b/R/geom-hline.r @@ -48,7 +48,7 @@ GeomHline <- ggproto("GeomHline", Geom, }, default_aes = aes( - colour = theme$geom$col, + colour = from_theme("colour"), size = 0.5, linetype = 1, alpha = NA diff --git a/R/geom-label.R b/R/geom-label.R index b624d971c7..8427407e36 100644 --- a/R/geom-label.R +++ b/R/geom-label.R @@ -51,16 +51,16 @@ GeomLabel <- ggproto("GeomLabel", Geom, required_aes = c("x", "y", "label"), default_aes = aes( - colour = theme$text$colour, - fill = theme$geom$fill_1, + 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 = theme$text$family, - fontface = theme$text$face, - lineheight = theme$text$lineheight + 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, diff --git a/R/geom-linerange.r b/R/geom-linerange.r index f1eaf956fa..86d9289d1f 100644 --- a/R/geom-linerange.r +++ b/R/geom-linerange.r @@ -84,7 +84,7 @@ geom_linerange <- function(mapping = NULL, data = NULL, #' @export GeomLinerange <- ggproto("GeomLinerange", Geom, default_aes = aes( - colour = theme$geom$col, + colour = from_theme("colour"), size = 0.5, linetype = 1, alpha = NA diff --git a/R/geom-path.r b/R/geom-path.r index b1e7a59eca..2a75b4d2b7 100644 --- a/R/geom-path.r +++ b/R/geom-path.r @@ -124,7 +124,7 @@ GeomPath <- ggproto("GeomPath", Geom, required_aes = c("x", "y"), default_aes = aes( - colour = theme$geom$col, + colour = from_theme("colour"), size = 0.5, linetype = 1, alpha = NA diff --git a/R/geom-point.r b/R/geom-point.r index 5bdccfa787..97a252a15f 100644 --- a/R/geom-point.r +++ b/R/geom-point.r @@ -110,7 +110,7 @@ GeomPoint <- ggproto("GeomPoint", Geom, non_missing_aes = c("size", "shape", "colour"), default_aes = aes( shape = 19, - colour = theme_aes("col", theme), + colour = from_theme("colour"), size = 1.5, fill = NA, alpha = NA, diff --git a/R/geom-pointrange.r b/R/geom-pointrange.r index 44b1c3f4cf..3eb3c6aa96 100644 --- a/R/geom-pointrange.r +++ b/R/geom-pointrange.r @@ -29,7 +29,7 @@ geom_pointrange <- function(mapping = NULL, data = NULL, #' @export GeomPointrange <- ggproto("GeomPointrange", Geom, default_aes = aes( - colour = theme$geom$col, + colour = from_theme("colour"), size = 0.5, linetype = 1, shape = 19, diff --git a/R/geom-polygon.r b/R/geom-polygon.r index 9af88332be..2b1a584356 100644 --- a/R/geom-polygon.r +++ b/R/geom-polygon.r @@ -107,7 +107,7 @@ GeomPolygon <- ggproto("GeomPolygon", Geom, default_aes = aes( colour = NA, - fill = theme$geom$fill, + fill = from_theme("fill"), size = 0.5, linetype = 1, alpha = NA diff --git a/R/geom-quantile.r b/R/geom-quantile.r index 11cea3857a..e381f3674f 100644 --- a/R/geom-quantile.r +++ b/R/geom-quantile.r @@ -63,7 +63,7 @@ geom_quantile <- function(mapping = NULL, data = NULL, GeomQuantile <- ggproto("GeomQuantile", GeomPath, default_aes = aes( weight = 1, - colour = theme$geom$col_2, + 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 a1b08f4c52..0e67d4c77f 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 = theme$geom$fill, alpha = NA), + default_aes = aes( + fill = from_theme("fill"), + alpha = NA + ), non_missing_aes = "fill", required_aes = c("x", "y"), @@ -63,7 +66,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")) { stop("geom_raster only works with Cartesian coordinates", call. = FALSE) } diff --git a/R/geom-rect.r b/R/geom-rect.r index 5f4e5a4ab6..7a697b0ec6 100644 --- a/R/geom-rect.r +++ b/R/geom-rect.r @@ -28,7 +28,7 @@ geom_rect <- function(mapping = NULL, data = NULL, GeomRect <- ggproto("GeomRect", Geom, default_aes = aes( colour = NA, - fill = theme$geom$fill, + fill = from_theme("fill"), size = 0.5, linetype = 1, alpha = NA diff --git a/R/geom-ribbon.r b/R/geom-ribbon.r index 7f4c6806d7..805622a1fa 100644 --- a/R/geom-ribbon.r +++ b/R/geom-ribbon.r @@ -59,7 +59,7 @@ geom_ribbon <- function(mapping = NULL, data = NULL, GeomRibbon <- ggproto("GeomRibbon", Geom, default_aes = aes( colour = NA, - fill = theme$geom$fill, + fill = from_theme("fill"), size = 0.5, linetype = 1, alpha = NA @@ -138,7 +138,7 @@ geom_area <- function(mapping = NULL, data = NULL, stat = "identity", GeomArea <- ggproto("GeomArea", GeomRibbon, default_aes = aes( colour = NA, - fill = theme$geom$fill, + fill = from_theme("fill"), size = 0.5, linetype = 1, alpha = NA diff --git a/R/geom-rug.r b/R/geom-rug.r index 83419aa291..d1e9f7f6c3 100644 --- a/R/geom-rug.r +++ b/R/geom-rug.r @@ -107,7 +107,7 @@ GeomRug <- ggproto("GeomRug", Geom, }, default_aes = aes( - colour = theme$geom$col, + colour = from_theme("colour"), size = 0.5, linetype = 1, alpha = NA diff --git a/R/geom-segment.r b/R/geom-segment.r index 8ff0df491f..c187e89923 100644 --- a/R/geom-segment.r +++ b/R/geom-segment.r @@ -104,7 +104,7 @@ GeomSegment <- ggproto("GeomSegment", Geom, non_missing_aes = c("linetype", "size", "shape"), default_aes = aes( - colour = theme$geom$col, + colour = from_theme("colour"), size = 0.5, linetype = 1, alpha = NA diff --git a/R/geom-smooth.r b/R/geom-smooth.r index 61aafc04fd..5522329e37 100644 --- a/R/geom-smooth.r +++ b/R/geom-smooth.r @@ -140,8 +140,8 @@ GeomSmooth <- ggproto("GeomSmooth", Geom, optional_aes = c("ymin", "ymax"), default_aes = aes( - colour = theme$geom$col_2, - fill = theme$geom$fill, + colour = from_theme("colour_2"), + fill = from_theme("fill"), size = 1, linetype = 1, weight = 1, diff --git a/R/geom-text.r b/R/geom-text.r index 65ca7ccebd..45cbde51ea 100644 --- a/R/geom-text.r +++ b/R/geom-text.r @@ -167,15 +167,15 @@ GeomText <- ggproto("GeomText", Geom, required_aes = c("x", "y", "label"), default_aes = aes( - colour = theme$text$colour, + colour = from_theme("colour", element = "text"), size = 3.88, angle = 0, hjust = 0.5, vjust = 0.5, alpha = NA, - family = theme$text$family, - fontface = theme$text$face, - lineheight = theme$text$lineheight + 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, diff --git a/R/geom-tile.r b/R/geom-tile.r index 4c17ab6dc2..21d9edf444 100644 --- a/R/geom-tile.r +++ b/R/geom-tile.r @@ -94,7 +94,7 @@ GeomTile <- ggproto("GeomTile", GeomRect, }, default_aes = aes( - fill = theme$geom$fill, + fill = from_theme("fill"), colour = NA, size = 0.1, linetype = 1, diff --git a/R/geom-violin.r b/R/geom-violin.r index 668a04a6bf..d2a5e991d8 100644 --- a/R/geom-violin.r +++ b/R/geom-violin.r @@ -156,8 +156,8 @@ GeomViolin <- ggproto("GeomViolin", Geom, default_aes = aes( weight = 1, - colour = theme$geom$col_1, - fill = theme$geom$fill_1, + colour = from_theme("colour_1"), + fill = from_theme("fill_1"), size = 0.5, alpha = NA, linetype = "solid" diff --git a/R/geom-vline.r b/R/geom-vline.r index 384fa37b18..044a3efd12 100644 --- a/R/geom-vline.r +++ b/R/geom-vline.r @@ -48,7 +48,7 @@ GeomVline <- ggproto("GeomVline", Geom, }, default_aes = aes( - colour = theme$geom$col, + colour = from_theme("colour"), size = 0.5, linetype = 1, alpha = NA From bf34c2b5915bc9b9c7d15d79c20ea80d3bc4776e Mon Sep 17 00:00:00 2001 From: Dana Seidel Date: Thu, 6 Sep 2018 16:52:08 -0700 Subject: [PATCH 11/21] Minor edits to element_geom and documentation rebuild --- R/theme-elements.r | 11 ++++++----- man/element.Rd | 14 +++++++------- 2 files changed, 13 insertions(+), 12 deletions(-) diff --git a/R/theme-elements.r b/R/theme-elements.r index 3349a88483..d51a8c3c7e 100644 --- a/R/theme-elements.r +++ b/R/theme-elements.r @@ -121,11 +121,12 @@ element_text <- function(family = NULL, face = NULL, colour = NULL, ) } -#' @param colour_1 accent colour 1, +#' @param colour_1 geom accent colour 1, #' typically a lighter version of colour -#' @param colour_2 accent colour 2, +#' @param colour_2 geom accent colour 2, #' typically a bright colour used for geom_smooth et al. -#' @param fill_1 accent fill colour, typically a darker version of fill +#' @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, @@ -135,9 +136,9 @@ element_geom <- function(fill = NULL, colour_2 = NULL, ..., inherit.blank = FALSE) { - extra_aes <- ggplot2:::rename_aes(list(...)) + extra_aes <- rename_aes(list(...)) - aes_list <- modifyList( + aes_list <- utils::modifyList( list( fill = fill, fill_1 = fill_1, colour = colour, colour_1 = colour_1, colour_2 = colour_2, diff --git a/man/element.Rd b/man/element.Rd index 961982754f..da3b4cf2d0 100644 --- a/man/element.Rd +++ b/man/element.Rd @@ -26,8 +26,8 @@ element_text(family = NULL, face = NULL, colour = NULL, lineheight = NULL, color = NULL, margin = NULL, debug = NULL, inherit.blank = FALSE) -element_geom(fill = NULL, fill_1 = NULL, col = NULL, col_1 = NULL, - col_2 = NULL, inherit.blank = FALSE) +element_geom(fill = NULL, fill_1 = NULL, colour = NULL, + colour_1 = NULL, colour_2 = NULL, ..., inherit.blank = FALSE) rel(x) } @@ -78,16 +78,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}{accent fill colour, typically a darker version of fill} +\item{fill_1}{geom accent fill colour, typically a darker version of fill} -\item{col}{default geom colour} - -\item{col_1}{accent colour 1, +\item{colour_1}{geom accent colour 1, typically a lighter version of colour} -\item{col_2}{accent colour 2, +\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{ From 144566554c19053b79ac567b0b829f1f9b54084e Mon Sep 17 00:00:00 2001 From: Dana Seidel Date: Fri, 31 Jan 2020 09:40:19 -0800 Subject: [PATCH 12/21] pull new `defaults` argument through use_defaults function. --- R/geom-.r | 4 ++-- R/layer.r | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/geom-.r b/R/geom-.r index 233da6046c..5fa7242129 100644 --- a/R/geom-.r +++ b/R/geom-.r @@ -121,10 +121,10 @@ Geom <- ggproto("Geom", }, # 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(defaults), names(data)) - missing_eval <- lapply(self$default_aes[missing_aes], eval_tidy) + missing_eval <- lapply(defaults[missing_aes], eval_tidy) # Needed for geoms with defaults set to NULL (e.g. GeomSf) missing_eval <- compact(missing_eval) diff --git a/R/layer.r b/R/layer.r index e493a1e038..863a7765ed 100644 --- a/R/layer.r +++ b/R/layer.r @@ -353,7 +353,7 @@ Layer <- ggproto("Layer", NULL, 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) { From 0630120a15b1e9cc33056c2f6775e6a15af31bae Mon Sep 17 00:00:00 2001 From: Dana Seidel Date: Fri, 31 Jan 2020 12:49:18 -0800 Subject: [PATCH 13/21] eval_defaults retrieves the currently set default theme --- R/geom-.r | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/geom-.r b/R/geom-.r index 5fa7242129..830dcaee9a 100644 --- a/R/geom-.r +++ b/R/geom-.r @@ -111,7 +111,7 @@ Geom <- ggproto("Geom", # evaluate defaults according to theme eval_defaults = function(self, theme) { - if (length(theme) == 0) theme <- theme_grey() + if (length(theme) == 0) theme <- theme_get() from_theme <- function(aes, element = "geom") { theme[[element]][[aes]] From dc2daa032a00f6adcbfbe25e4ac56f6844bc2683 Mon Sep 17 00:00:00 2001 From: Dana Seidel Date: Fri, 31 Jan 2020 14:48:11 -0800 Subject: [PATCH 14/21] evaluate from defaults using completed theme object --- R/layer.r | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/layer.r b/R/layer.r index 863a7765ed..f3757cef1a 100644 --- a/R/layer.r +++ b/R/layer.r @@ -349,7 +349,7 @@ Layer <- ggproto("Layer", NULL, if (empty(data)) return(data) # evaluate defaults for theme - defaults <- self$geom$eval_defaults(theme = plot$theme) + defaults <- self$geom$eval_defaults(theme = plot_theme(plot)) aesthetics <- self$mapping modifiers <- aesthetics[is_scaled_aes(aesthetics) | is_staged_aes(aesthetics)] From ce57ba9a3eac830aacdcda26fa435e3b00d9eacd Mon Sep 17 00:00:00 2001 From: Dana Seidel Date: Fri, 31 Jan 2020 14:48:29 -0800 Subject: [PATCH 15/21] pull evaluated defaults through guides --- R/guide-bins.R | 7 ++++--- R/guide-legend.r | 4 ++-- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/R/guide-bins.R b/R/guide-bins.R index 5f243bb216..d29eff2bb8 100644 --- a/R/guide-bins.R +++ b/R/guide-bins.R @@ -156,7 +156,7 @@ 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) @@ -172,10 +172,11 @@ guide_geom.bins <- function(guide, layers, default_mapping) { # Filter out set aesthetics that can't be applied to the legend n <- vapply(layer$aes_params, length, integer(1)) params <- layer$aes_params[n == 1] + defaults <- layer$geom$eval_defaults(theme = theme) - 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-legend.r b/R/guide-legend.r index 74a014df27..242931b675 100644 --- a/R/guide-legend.r +++ b/R/guide-legend.r @@ -262,9 +262,9 @@ guide_geom.legend <- function(guide, layers, default_mapping, theme) { modifiers <- aesthetics[is_scaled_aes(aesthetics) | is_staged_aes(aesthetics)] defaults <- layer$geom$eval_defaults(theme = theme) - 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 From 844df2af8a218a68c4f9f3c9e94fa02f97087d51 Mon Sep 17 00:00:00 2001 From: Dana Seidel Date: Mon, 24 Feb 2020 08:13:25 -0800 Subject: [PATCH 16/21] evaluate defaults outside the condistion guide_geom.legend --- R/guide-bins.R | 2 +- R/guide-legend.r | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/guide-bins.R b/R/guide-bins.R index d29eff2bb8..ab9da10892 100644 --- a/R/guide-bins.R +++ b/R/guide-bins.R @@ -160,6 +160,7 @@ 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) @@ -172,7 +173,6 @@ guide_geom.bins <- function(guide, layers, default_mapping, theme) { # Filter out set aesthetics that can't be applied to the legend n <- vapply(layer$aes_params, length, integer(1)) params <- layer$aes_params[n == 1] - defaults <- layer$geom$eval_defaults(theme = theme) data <- layer$geom$use_defaults(guide$key[matched], defaults = defaults, params) } else { diff --git a/R/guide-legend.r b/R/guide-legend.r index 242931b675..2428c9793d 100644 --- a/R/guide-legend.r +++ b/R/guide-legend.r @@ -245,6 +245,7 @@ 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) @@ -260,7 +261,6 @@ guide_geom.legend <- function(guide, layers, default_mapping, theme) { aesthetics <- layer$mapping modifiers <- aesthetics[is_scaled_aes(aesthetics) | is_staged_aes(aesthetics)] - defaults <- layer$geom$eval_defaults(theme = theme) data <- layer$geom$use_defaults(guide$key[matched], defaults = defaults, params, modifiers) } else { From 517f0561a113cf5d381539a975a6ec8fc962d645 Mon Sep 17 00:00:00 2001 From: Dana Seidel Date: Mon, 24 Feb 2020 08:14:32 -0800 Subject: [PATCH 17/21] Functional aesthetic theming in geom_sf! - pull theme through draw_geom into LayerSf and GeomSf --- R/geom-sf.R | 68 +++++++++++++++++++++++++++++++++++++++----------- R/layer-sf.R | 15 +++++++++++ R/layer.r | 2 +- R/plot-build.r | 4 +-- 4 files changed, 72 insertions(+), 17 deletions(-) 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/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 f3757cef1a..855e3023c9 100644 --- a/R/layer.r +++ b/R/layer.r @@ -360,7 +360,7 @@ Layer <- ggproto("Layer", NULL, 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 139bc45fcd..784fdc8b86 100644 --- a/R/plot-build.r +++ b/R/plot-build.r @@ -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) From ddad3704756da7abdb0c4a209df54d71fffa5b96 Mon Sep 17 00:00:00 2001 From: Dana Seidel Date: Mon, 24 Feb 2020 08:15:31 -0800 Subject: [PATCH 18/21] remove self referencing in theme element, dummy document `from_theme`. Update test files --- R/theme-defaults.r | 1 - R/theme-elements.r | 2 +- R/theme.r | 12 ++++++++++++ tests/figs/coord-sf/sf-polygons.svg | 2 +- tests/figs/geom-polygon/basic-polygon-plot.svg | 4 ++-- .../geom-sf/north-carolina-county-boundaries.svg | 2 +- 6 files changed, 17 insertions(+), 6 deletions(-) diff --git a/R/theme-defaults.r b/R/theme-defaults.r index 1c372741d0..9636b27251 100644 --- a/R/theme-defaults.r +++ b/R/theme-defaults.r @@ -128,7 +128,6 @@ 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", diff --git a/R/theme-elements.r b/R/theme-elements.r index b76d4acfa0..c5f6a5f683 100644 --- a/R/theme-elements.r +++ b/R/theme-elements.r @@ -524,7 +524,7 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) { plot.margin = el_def("margin"), aspect.ratio = el_def("character"), - geom = el_def("element_geom", "geom") + 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 f0f29f8143..dbc27e9aea 100644 --- a/R/theme.r +++ b/R/theme.r @@ -698,3 +698,15 @@ 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" +from_theme <- function(aes, element = "geom"){ + theme[[element]][[aes]] +} 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 @@ - + From 5f312e8eacabc93959d8525fc19f662cb560fe69 Mon Sep 17 00:00:00 2001 From: Dana Seidel Date: Mon, 24 Feb 2020 17:39:47 -0800 Subject: [PATCH 19/21] a few intial tests --- ...default-aesthetics-can-be-set-by-theme.svg | 205 ++++++++++++++++++ .../geom-sf-respect-themed-aesthetics.svg | 201 +++++++++++++++++ .../themed-aesthetics-respect-parameters.svg | 205 ++++++++++++++++++ .../themed-defaults-respect-aesthetics.svg | 95 ++++++++ tests/testthat/test-theme.r | 32 +++ 5 files changed, 738 insertions(+) create mode 100644 tests/figs/themes/default-aesthetics-can-be-set-by-theme.svg create mode 100644 tests/figs/themes/geom-sf-respect-themed-aesthetics.svg create mode 100644 tests/figs/themes/themed-aesthetics-respect-parameters.svg create mode 100644 tests/figs/themes/themed-defaults-respect-aesthetics.svg 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 2bf7f57aef..f66677cf21 100644 --- a/tests/testthat/test-theme.r +++ b/tests/testthat/test-theme.r @@ -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) + +}) + From 08feee1eeb9c7289b852b93d9214967dbf4274a1 Mon Sep 17 00:00:00 2001 From: Dana Seidel Date: Tue, 25 Feb 2020 22:21:23 -0800 Subject: [PATCH 20/21] minor fixes to preserve S3 method consistency for guide_geom read Rd for from_theme --- R/guides-axis.r | 2 +- R/guides-none.r | 2 +- R/theme.r | 1 + 3 files changed, 3 insertions(+), 2 deletions(-) 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/theme.r b/R/theme.r index dbc27e9aea..caa88676db 100644 --- a/R/theme.r +++ b/R/theme.r @@ -707,6 +707,7 @@ print.theme <- function(x, ...) utils::str(x) #' #' @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]] } From 33e7dc62ad5169b5f4d2b9c735767e4630423183 Mon Sep 17 00:00:00 2001 From: Dana Seidel Date: Wed, 4 Mar 2020 21:34:48 -0800 Subject: [PATCH 21/21] silence rlang data mask warning --- R/geom-defaults.r | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/geom-defaults.r b/R/geom-defaults.r index 07fa5f84db..4b82b2245a 100644 --- a/R/geom-defaults.r +++ b/R/geom-defaults.r @@ -14,7 +14,7 @@ update_geom_defaults <- function(geom, new) { g <- check_subclass(geom, "Geom", env = parent.frame()) - env <- new.env() + env <- new_data_mask(new.env()) env$theme <- theme_get() old <- rlang::eval_tidy(g$default_aes, env)