diff --git a/R/guide-bins.R b/R/guide-bins.R index 2395595ce0..09a7e835ba 100644 --- a/R/guide-bins.R +++ b/R/guide-bins.R @@ -194,7 +194,7 @@ guide_merge.bins <- function(guide, new_guide) { guide_geom.bins <- function(guide, layers, default_mapping) { # arrange common data for vertical and horizontal guide guide$geoms <- lapply(layers, function(layer) { - matched <- matched_aes(layer, guide, default_mapping) + matched <- matched_aes(layer, guide) # check if this layer should be included include <- include_layer_in_guide(layer, matched) @@ -208,7 +208,7 @@ guide_geom.bins <- function(guide, layers, default_mapping) { n <- vapply(layer$aes_params, length, integer(1)) params <- layer$aes_params[n == 1] - aesthetics <- layer$mapping + aesthetics <- layer$computed_mapping modifiers <- aesthetics[is_scaled_aes(aesthetics) | is_staged_aes(aesthetics)] data <- tryCatch( diff --git a/R/guide-colorbar.r b/R/guide-colorbar.r index fd352fd789..5c933fa5f0 100644 --- a/R/guide-colorbar.r +++ b/R/guide-colorbar.r @@ -248,7 +248,7 @@ guide_merge.colorbar <- function(guide, new_guide) { guide_geom.colorbar <- function(guide, layers, default_mapping) { # Layers that use this guide guide_layers <- lapply(layers, function(layer) { - matched <- matched_aes(layer, guide, default_mapping) + matched <- matched_aes(layer, guide) if (length(matched) == 0) { # This layer does not use this guide diff --git a/R/guide-legend.r b/R/guide-legend.r index 6aa593342c..4393a69345 100644 --- a/R/guide-legend.r +++ b/R/guide-legend.r @@ -247,7 +247,7 @@ guide_merge.legend <- function(guide, new_guide) { guide_geom.legend <- function(guide, layers, default_mapping) { # arrange common data for vertical and horizontal guide guide$geoms <- lapply(layers, function(layer) { - matched <- matched_aes(layer, guide, default_mapping) + matched <- matched_aes(layer, guide) # check if this layer should be included include <- include_layer_in_guide(layer, matched) @@ -261,7 +261,7 @@ guide_geom.legend <- function(guide, layers, default_mapping) { n <- vapply(layer$aes_params, length, integer(1)) params <- layer$aes_params[n == 1] - aesthetics <- layer$mapping + aesthetics <- layer$computed_mapping modifiers <- aesthetics[is_scaled_aes(aesthetics) | is_staged_aes(aesthetics)] data <- tryCatch( diff --git a/R/guides-.r b/R/guides-.r index 8ab257857e..2bc6cc611d 100644 --- a/R/guides-.r +++ b/R/guides-.r @@ -244,6 +244,7 @@ guides_merge <- function(gdefs) { } # process layer information +# TODO: `default_mapping` is unused internally but kept for backwards compitability until guide rewrite guides_geom <- function(gdefs, layers, default_mapping) { compact(lapply(gdefs, guide_geom, layers, default_mapping)) } @@ -372,8 +373,8 @@ guide_gengrob <- function(guide, theme) UseMethod("guide_gengrob") # Helpers ----------------------------------------------------------------- -matched_aes <- function(layer, guide, defaults) { - all <- names(c(layer$mapping, if (layer$inherit.aes) defaults, layer$stat$default_aes)) +matched_aes <- function(layer, guide) { + all <- names(c(layer$computed_mapping, layer$stat$default_aes)) geom <- c(layer$geom$required_aes, names(layer$geom$default_aes)) matched <- intersect(intersect(all, geom), names(guide$key)) matched <- setdiff(matched, names(layer$geom_params)) diff --git a/R/layer-sf.R b/R/layer-sf.R index b5634ce4e3..2ad59f535b 100644 --- a/R/layer-sf.R +++ b/R/layer-sf.R @@ -38,11 +38,12 @@ LayerSf <- ggproto("LayerSf", Layer, # automatically determine the name of the geometry column # and add the mapping if it doesn't exist - if ((isTRUE(self$inherit.aes) && is.null(self$mapping$geometry) && is.null(plot$mapping$geometry)) || - (!isTRUE(self$inherit.aes) && is.null(self$mapping$geometry))) { + if ((isTRUE(self$inherit.aes) && is.null(self$computed_mapping$geometry) && + is.null(plot$computed_mapping$geometry)) || + (!isTRUE(self$inherit.aes) && is.null(self$computed_mapping$geometry))) { if (is_sf(data)) { geometry_col <- attr(data, "sf_column") - self$mapping$geometry <- sym(geometry_col) + self$computed_mapping$geometry <- sym(geometry_col) } } @@ -52,8 +53,8 @@ LayerSf <- ggproto("LayerSf", Layer, self$geom_params$legend <- "polygon" # now check if the type should not be polygon - if (!is.null(self$mapping$geometry) && quo_is_symbol(self$mapping$geometry)) { - geometry_column <- as_name(self$mapping$geometry) + if (!is.null(self$computed_mapping$geometry) && quo_is_symbol(self$computed_mapping$geometry)) { + geometry_column <- as_name(self$computed_mapping$geometry) if (inherits(data[[geometry_column]], "sfc")) { sf_type <- detect_sf_type(data[[geometry_column]]) if (sf_type == "point") { diff --git a/R/layer.r b/R/layer.r index facd74a1d3..197d32549d 100644 --- a/R/layer.r +++ b/R/layer.r @@ -174,6 +174,7 @@ Layer <- ggproto("Layer", NULL, # calculated before use computed_geom_params = NULL, computed_stat_params = NULL, + computed_mapping = NULL, data = NULL, aes_params = NULL, @@ -211,16 +212,18 @@ Layer <- ggproto("Layer", NULL, setup_layer = function(self, data, plot) { # For annotation geoms, it is useful to be able to ignore the default aes if (isTRUE(self$inherit.aes)) { - self$mapping <- defaults(self$mapping, plot$mapping) + self$computed_mapping <- defaults(self$mapping, plot$mapping) # defaults() strips class, but it needs to be preserved for now - class(self$mapping) <- "uneval" + class(self$computed_mapping) <- "uneval" + } else { + self$computed_mapping <- self$mapping } data }, compute_aesthetics = function(self, data, plot) { - aesthetics <- self$mapping + aesthetics <- self$computed_mapping # Drop aesthetics that are set or calculated set <- names(aesthetics) %in% names(self$aes_params) @@ -296,7 +299,7 @@ Layer <- ggproto("Layer", NULL, data <- rename_aes(data) # Assemble aesthetics from layer, plot and stat mappings - aesthetics <- self$mapping + aesthetics <- self$computed_mapping aesthetics <- defaults(aesthetics, self$stat$default_aes) aesthetics <- compact(aesthetics) @@ -362,7 +365,7 @@ Layer <- ggproto("Layer", NULL, # Combine aesthetics, defaults, & params if (empty(data)) return(data) - aesthetics <- self$mapping + aesthetics <- self$computed_mapping modifiers <- aesthetics[is_scaled_aes(aesthetics) | is_staged_aes(aesthetics)] self$geom$use_defaults(data, self$aes_params, modifiers) diff --git a/tests/testthat/test-layer.r b/tests/testthat/test-layer.r index 50b95c72e2..e5b70eff29 100644 --- a/tests/testthat/test-layer.r +++ b/tests/testthat/test-layer.r @@ -68,11 +68,22 @@ test_that("layers are stateless except for the computed params", { p <- ggplot(df) + geom_col(aes(x = x, y = y), width = 0.8, fill = "red") col_layer <- as.list(p$layers[[1]]) - stateless_names <- setdiff(names(col_layer), c("computed_geom_params", "computed_stat_params")) + stateless_names <- setdiff(names(col_layer), c("computed_geom_params", "computed_stat_params", "computed_mapping")) invisible(ggplotGrob(p)) expect_identical(as.list(p$layers[[1]])[stateless_names], col_layer[stateless_names]) }) +test_that("inherit.aes works", { + df <- data.frame(x = 1:10, y = 1:10) + p1 <- ggplot(df, aes(y = y)) + + geom_col(aes(x = x), inherit.aes = TRUE) + p2 <- ggplot(df, aes(colour = y)) + + geom_col(aes(x = x, y = y), inherit.aes = FALSE) + invisible(ggplotGrob(p1)) + invisible(ggplotGrob(p2)) + expect_identical(p1$layers[[1]]$computed_mapping, p2$layers[[1]]$computed_mapping) +}) + # Data extraction --------------------------------------------------------- test_that("layer_data returns a data.frame", {