From 5e3cfc0ce48f8d335ba577e9cdf27028714042d8 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Mon, 30 Oct 2023 11:34:41 +0100
Subject: [PATCH 1/7] fix typo
---
R/guide-legend.R | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/R/guide-legend.R b/R/guide-legend.R
index 341bee47c8..ba550a808a 100644
--- a/R/guide-legend.R
+++ b/R/guide-legend.R
@@ -324,7 +324,7 @@ 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())
}
)
} else {
From 2b65013c180f1d131ec176ad8ec83249efe9dba8 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Mon, 30 Oct 2023 11:36:25 +0100
Subject: [PATCH 2/7] Switch for drawing keys
---
R/guide-legend.R | 7 ++++++-
1 file changed, 6 insertions(+), 1 deletion(-)
diff --git a/R/guide-legend.R b/R/guide-legend.R
index ba550a808a..3590e74cb6 100644
--- a/R/guide-legend.R
+++ b/R/guide-legend.R
@@ -469,7 +469,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)
}
From f005166a0dbb20886145cf083945901ca55f41ba Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Mon, 30 Oct 2023 16:53:05 +0100
Subject: [PATCH 3/7] `lapply` -> `Map()`
---
R/guide-legend.R | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/R/guide-legend.R b/R/guide-legend.R
index 3590e74cb6..573059fa09 100644
--- a/R/guide-legend.R
+++ b/R/guide-legend.R
@@ -303,7 +303,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)
From c22cebe315b5b7daa344b0e11053463ed10fb593 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Mon, 30 Oct 2023 16:53:19 +0100
Subject: [PATCH 4/7] Helper function
---
R/guide-legend.R | 36 ++++++++++++++++++++++++++++++++++++
1 file changed, 36 insertions(+)
diff --git a/R/guide-legend.R b/R/guide-legend.R
index 573059fa09..82c400a80b 100644
--- a/R/guide-legend.R
+++ b/R/guide-legend.R
@@ -327,6 +327,7 @@ GuideLegend <- ggproto(
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, ]
@@ -767,3 +768,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
+}
From 03a90aff13c13db2a847c74757260d8a221e1882 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Mon, 30 Oct 2023 16:53:31 +0100
Subject: [PATCH 5/7] write test
---
tests/testthat/test-draw-key.R | 39 ++++++++++++++++++++++++++++++++++
1 file changed, 39 insertions(+)
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)
+
+})
From 6775dd25a9e5aeb98b3b171c6bdab755c267af8e Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Mon, 30 Oct 2023 16:53:43 +0100
Subject: [PATCH 6/7] accept snapshots
---
...ate-colour-key-with-alpha-key-as-lines.svg | 76 +++++++++++++++++++
.../open-and-closed-munched-polygons.svg | 2 -
2 files changed, 76 insertions(+), 2 deletions(-)
create mode 100644 tests/testthat/_snaps/draw-key/appropriate-colour-key-with-alpha-key-as-lines.svg
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
From b54a50668a2c60a5594b519f436094904a00ef18 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Mon, 30 Oct 2023 16:58:44 +0100
Subject: [PATCH 7/7] Add news bullet
---
NEWS.md | 4 ++++
1 file changed, 4 insertions(+)
diff --git a/NEWS.md b/NEWS.md
index 2d54ba1b84..fcf884d4f0 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).
+
* (internal) guide building is now part of `ggplot_build()` instead of
`ggplot_gtable()` to allow guides to observe unmapped data (#5483).