diff --git a/R/guides-.R b/R/guides-.R index fc9d6e2b3c..67f1ad9373 100644 --- a/R/guides-.R +++ b/R/guides-.R @@ -292,16 +292,27 @@ Guides <- ggproto( no_guides <- custom # Extract the non-position scales - scales <- scales$non_position_scales()$scales - if (length(scales) == 0) { - return(no_guides) - } + scales <- scales$scales # Ensure a 1:1 mapping between aesthetics and scales aesthetics <- lapply(scales, `[[`, "aesthetics") scales <- rep.int(scales, lengths(aesthetics)) aesthetics <- unlist(aesthetics, recursive = FALSE, use.names = FALSE) + extra_guides <- setdiff( + names(self$guides), + c(aesthetics, "custom", + "x", "y", "x.sec", "y.sec", + "r", "theta", "r.sec", "theta.sec") + ) + if (length(extra_guides) > 0) { + cli::cli_warn("Ignoring unknown guide{?s}: {.val {extra_guides}}.") + } + + if (length(scales) < 1) { + return(no_guides) + } + # Setup and train scales guides <- self$setup(scales, aesthetics = aesthetics) guides$train(scales, labels) diff --git a/R/layer.R b/R/layer.R index 8b4621bde2..7a2f2125ee 100644 --- a/R/layer.R +++ b/R/layer.R @@ -354,7 +354,7 @@ Layer <- ggproto("Layer", NULL, compute_statistic = function(self, data, layout) { if (empty(data)) - return(data_frame0()) + return(data) self$computed_stat_params <- self$stat$setup_params(data, self$stat_params) data <- self$stat$setup_data(data, self$computed_stat_params) @@ -362,7 +362,7 @@ Layer <- ggproto("Layer", NULL, }, map_statistic = function(self, data, plot) { - if (empty(data)) return(data_frame0()) + if (empty(data)) return(data) # Make sure data columns are converted to correct names. If not done, a # column with e.g. a color name will not be found in an after_stat() @@ -418,7 +418,7 @@ Layer <- ggproto("Layer", NULL, }, compute_geom_1 = function(self, data) { - if (empty(data)) return(data_frame0()) + if (empty(data)) return(data) check_required_aesthetics( self$geom$required_aes, @@ -430,7 +430,7 @@ Layer <- ggproto("Layer", NULL, }, compute_position = function(self, data, layout) { - if (empty(data)) return(data_frame0()) + if (empty(data)) return(data) params <- self$position$setup_params(data) data <- self$position$setup_data(data, params) diff --git a/R/plot-build.R b/R/plot-build.R index 2a68dd550f..58b13caa62 100644 --- a/R/plot-build.R +++ b/R/plot-build.R @@ -102,14 +102,9 @@ ggplot_build.ggplot <- function(plot) { # Train and map non-position scales and guides npscales <- scales$non_position_scales() - if (npscales$n() > 0) { - lapply(data, npscales$train_df) - plot$guides <- plot$guides$build(npscales, plot$layers, plot$labels, data) - data <- lapply(data, npscales$map_df) - } else { - # Only keep custom guides if there are no non-position scales - plot$guides <- plot$guides$get_custom() - } + npscales$train(data) + plot$guides <- plot$guides$build(npscales, plot$layers, plot$labels, data) + data <- npscales$map(data, layers) data <- .expose_data(data) # Fill in defaults etc. diff --git a/R/scales-.R b/R/scales-.R index e62eb0e8cb..24da1cdeaf 100644 --- a/R/scales-.R +++ b/R/scales-.R @@ -61,6 +61,13 @@ ScalesList <- ggproto("ScalesList", NULL, scale[[1]] }, + train = function(self, data, drop = FALSE) { + if (length(self$scales) == 0) { + return() + } + lapply(data, self$train_df, drop = drop) + }, + train_df = function(self, df, drop = FALSE) { if (empty(df) || length(self$scales) == 0) { return() @@ -68,6 +75,30 @@ ScalesList <- ggproto("ScalesList", NULL, lapply(self$scales, function(scale) scale$train_df(df = df)) }, + map = function(self, data, layers) { + if (length(self$scales) == 0) { + return(data) + } + aesthetics <- lapply(self$scales, `[[`, "aesthetics") + + known <- unique(unlist(c( + lapply(data, colnames), + lapply(layers, function(x) names(x$computed_mapping)) + ))) + + known <- unlist(aesthetics) %in% known + known <- vapply(vec_chop(known, sizes = lengths(aesthetics)), any, logical(1)) + + unknown <- unlist(aesthetics[!known]) + if (length(unknown) > 0) { + cli::cli_warn( + "Ignoring scale{?s} for unused aesthetics: {.val {unknown}}." + ) + } + + lapply(data, self$map_df) + }, + map_df = function(self, df) { if (empty(df) || length(self$scales) == 0) { return(df) diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index a2e5ae918d..fd69b15d6a 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -95,6 +95,11 @@ test_that("axis_label_overlap_priority always returns the correct number of elem expect_setequal(axis_label_priority(100), seq_len(100)) }) +test_that("a warning is generated when declaring unused guides", { + plot <- ggplot(mtcars, aes(disp, mpg)) + geom_point() + guides(colour = "legend") + expect_warning(ggplot_build(plot), "Ignoring unknown guide") +}) + test_that("a warning is generated when guides are drawn at a location that doesn't make sense", { plot <- ggplot(mpg, aes(class, hwy)) + geom_point() + @@ -137,16 +142,13 @@ test_that("guide_none() can be used in non-position scales", { geom_point() + scale_color_discrete(guide = guide_none()) - built <- ggplot_build(p) - plot <- built$plot - guides <- guides_list(plot$guides) - guides <- guides$build( - plot$scales, - plot$layers, - plot$labels - ) + expect_length(ggplot_build(p)$plot$guides$guides, 0) + + p <- ggplot(mpg, aes(cty, hwy, colour = class)) + + geom_point() + + guides(colour = guide_none()) - expect_length(guides$guides, 0) + expect_length(ggplot_build(p)$plot$guides$guides, 0) }) test_that("Using non-position guides for position scales results in an informative error", { @@ -562,7 +564,12 @@ test_that("legends can be forced to display unrelated geoms", { limits = c("A", "B") ) - b <- ggplot_build(p) + # Should complain about useless scale, as it doesn't map anything + expect_warning( + b <- ggplot_build(p), + "Ignoring scale" + ) + legend <- b$plot$guides$params[[1]] expect_equal( @@ -944,8 +951,8 @@ test_that("guides title and text are positioned correctly", { geom_point() + # setting the order explicitly removes the risk for failed doppelgangers # due to legends switching order - guides(shape = guide_legend(order = 1), - color = guide_colorbar(order = 2)) + + guides(size = guide_legend(order = 2), + color = guide_colorbar(order = 1)) + theme_test() expect_doppelganger("guide title and text positioning and alignment via themes",