diff --git a/NEWS.md b/NEWS.md
index d86340c476..1b02530a3e 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,9 @@
# ggplot2 (development version)
+* By default, `guide_legend()` now only draws a key glyph for a layer when
+ the value is is the layer's data. To revert to the old behaviour, you
+ can still set `show.legend = c({aesthetic} = TRUE)` (@teunbrand, #3648).
+
* The spacing between legend keys and their labels, in addition to legends
and their titles, is now controlled by the text's `margin` setting. Not
specifying margins will automatically add appropriate text margins. To
diff --git a/R/guide-legend.R b/R/guide-legend.R
index fe383f81d0..3a0d2bb8a7 100644
--- a/R/guide-legend.R
+++ b/R/guide-legend.R
@@ -322,7 +322,7 @@ GuideLegend <- ggproto(
get_layer_key = function(params, layers, data) {
- decor <- lapply(layers, function(layer) {
+ decor <- Map(layer = layers, df = data, f = function(layer, df) {
matched_aes <- matched_aes(layer, params)
@@ -343,9 +343,10 @@ GuideLegend <- ggproto(
"Failed to apply {.fn after_scale} modifications to legend",
parent = cnd
)
- layer$geom$use_defaults(params$key[matched], layer_params, list())
+ layer$geom$use_defaults(params$key[matched_aes], layer_params, list())
}
)
+ data$.draw <- keep_key_data(params$key, df, matched_aes, layer$show.legend)
} else {
reps <- rep(1, nrow(params$key))
data <- layer$geom$use_defaults(NULL, layer$aes_params)[reps, ]
@@ -510,7 +511,12 @@ GuideLegend <- ggproto(
draw <- function(i) {
bg <- elements$key
keys <- lapply(decor, function(g) {
- g$draw_key(vec_slice(g$data, i), g$params, key_size)
+ data <- vec_slice(g$data, i)
+ if (data$.draw %||% TRUE) {
+ g$draw_key(data, g$params, key_size)
+ } else {
+ zeroGrob()
+ }
})
c(list(bg), keys)
}
@@ -804,3 +810,38 @@ measure_legend_keys <- function(decor, n, dim, byrow = FALSE,
heights = pmax(default_height, apply(size, 1, max))
)
}
+
+# For legend keys, check if the guide key's `.value` also occurs in the layer
+# data when `show.legend = NA` and data is discrete. Note that `show.legend`
+# besides TRUE (always show), FALSE (never show) and NA (show in relevant legend),
+# can also take *named* logical vector to set this behaviour per aesthetic.
+keep_key_data <- function(key, data, aes, show) {
+ # First, can we exclude based on anything else than actually checking the
+ # data that we should include or drop the key?
+ if (!is.discrete(key$.value)) {
+ return(TRUE)
+ }
+ if (is_named(show)) {
+ aes <- intersect(aes, names(show))
+ show <- show[aes]
+ } else {
+ show <- show[rep(1L, length(aes))]
+ }
+ if (isTRUE(any(show)) || length(show) == 0) {
+ return(TRUE)
+ }
+ if (isTRUE(all(!show))) {
+ return(FALSE)
+ }
+ # Second, we go find if the value is actually present in the data.
+ aes <- aes[is.na(show)]
+ match <- which(names(data) %in% aes)
+ if (length(match) == 0) {
+ return(TRUE)
+ }
+ keep <- rep(FALSE, nrow(key))
+ for (column in match) {
+ keep <- keep | vec_in(key$.value, data[[column]])
+ }
+ keep
+}
diff --git a/tests/testthat/_snaps/draw-key/appropriate-colour-key-with-alpha-key-as-lines.svg b/tests/testthat/_snaps/draw-key/appropriate-colour-key-with-alpha-key-as-lines.svg
new file mode 100644
index 0000000000..2975ed8e74
--- /dev/null
+++ b/tests/testthat/_snaps/draw-key/appropriate-colour-key-with-alpha-key-as-lines.svg
@@ -0,0 +1,76 @@
+
+
diff --git a/tests/testthat/_snaps/geom-polygon/open-and-closed-munched-polygons.svg b/tests/testthat/_snaps/geom-polygon/open-and-closed-munched-polygons.svg
index 74816059df..b970c9f317 100644
--- a/tests/testthat/_snaps/geom-polygon/open-and-closed-munched-polygons.svg
+++ b/tests/testthat/_snaps/geom-polygon/open-and-closed-munched-polygons.svg
@@ -33,8 +33,6 @@
colour
-
-
closed
open
diff --git a/tests/testthat/test-draw-key.R b/tests/testthat/test-draw-key.R
index 340ffb4c6d..923191b475 100644
--- a/tests/testthat/test-draw-key.R
+++ b/tests/testthat/test-draw-key.R
@@ -55,3 +55,42 @@ test_that("horizontal key glyphs work", {
guides(color = guide_legend(order = 1))
)
})
+
+test_that("keep_draw_key", {
+
+ key <- data_frame0(.value = c("A", "C"))
+ data <- data_frame0(foo = c("A", "B"), bar = c("B", "C"))
+
+ expect_true( keep_key_data(key, data, "foo", show = TRUE))
+ expect_false(keep_key_data(key, data, "foo", show = FALSE))
+ expect_equal(keep_key_data(key, data, "foo", show = NA), c(TRUE, FALSE))
+ expect_equal(keep_key_data(key, data, "bar", show = NA), c(FALSE, TRUE))
+ expect_equal(keep_key_data(key, data, c("foo", "bar"), show = NA), c(TRUE, TRUE))
+
+ # Named show
+ expect_true(
+ keep_key_data(key, data, c("foo", "bar"), show = c(foo = TRUE, bar = FALSE))
+ )
+ expect_equal(
+ keep_key_data(key, data, c("foo", "bar"), show = c(foo = NA, bar = FALSE)),
+ c(TRUE, FALSE)
+ )
+ expect_equal(
+ keep_key_data(key, data, c("foo", "bar"), show = c(foo = FALSE, bar = NA)),
+ c(FALSE, TRUE)
+ )
+
+ p <- ggplot(data.frame(x = 1:2), aes(x, x)) +
+ geom_point(
+ aes(colour = "point", alpha = "point"),
+ show.legend = c("colour" = NA, alpha = FALSE)
+ ) +
+ geom_line(
+ aes(colour = "line", alpha = "line"),
+ show.legend = c("colour" = NA, alpha = TRUE)
+ ) +
+ suppressWarnings(scale_alpha_discrete())
+
+ expect_doppelganger("appropriate colour key with alpha key as lines", p)
+
+})