From debe2b7e23a13c989ca1cd7cf301298af8f8002c Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Tue, 29 Oct 2019 19:59:26 -0300 Subject: [PATCH 1/4] add tests for guide merging --- tests/testthat/test-guides.R | 44 ++++++++++++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index 87e3898f0d..29f951d0a3 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -113,6 +113,50 @@ test_that("Using non-position guides for position scales results in an informati expect_error(ggplot_gtable(built), "does not implement guide_transform()") }) +test_that("guide merging for guide_legend() works as expected", { + + merge_test_guides <- function(scale1, scale2) { + scale1$guide <- guide_legend(direction = "vertical") + scale2$guide <- guide_legend(direction = "vertical") + scales <- scales_list() + scales$add(scale1) + scales$add(scale2) + + direction <- "vertical" + guide_list <- guides_train(scales, theme = theme_gray(), labels = labs(), guides = guides()) + guides_merge(guide_list) + } + + different_limits <- merge_test_guides( + scale_colour_discrete(limits = c("a", "b", "c", "d")), + scale_linetype_discrete(limits = c("a", "b", "c")) + ) + expect_length(different_limits, 2) + expect_equal(different_limits[[1]]$key$.label, c("a", "b", "c", "d")) + expect_equal(different_limits[[2]]$key$.label, c("a", "b", "c")) + + same_limits <- merge_test_guides( + scale_colour_discrete(limits = c("a", "b", "c")), + scale_linetype_discrete(limits = c("a", "b", "c")) + ) + expect_length(same_limits, 1) + expect_equal(same_limits[[1]]$key$.label, c("a", "b", "c")) + + same_labels_different_limits <- merge_test_guides( + scale_colour_discrete(limits = c("a", "b", "c")), + scale_linetype_discrete(limits = c("one", "two", "three"), labels = c("a", "b", "c")) + ) + expect_length(same_labels_different_limits, 1) + expect_equal(same_labels_different_limits[[1]]$key$.label, c("a", "b", "c")) + + same_labels_different_scale <- merge_test_guides( + scale_colour_continuous(limits = c(0, 4), breaks = 1:3, labels = c("a", "b", "c")), + scale_linetype_discrete(limits = c("a", "b", "c")) + ) + expect_length(same_labels_different_scale, 1) + expect_equal(same_labels_different_scale[[1]]$key$.label, c("a", "b", "c")) +}) + # Visual tests ------------------------------------------------------------ test_that("axis guides are drawn correctly", { From e9bda4f8e1605be0bcd2cb97f8e1608208475089 Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Tue, 29 Oct 2019 20:07:08 -0300 Subject: [PATCH 2/4] fix guide merging when there are duplicated labels --- R/guide-legend.r | 3 ++- tests/testthat/test-guides.R | 7 +++++++ 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/R/guide-legend.r b/R/guide-legend.r index 3558d38b1f..77ba2f67c0 100644 --- a/R/guide-legend.r +++ b/R/guide-legend.r @@ -230,7 +230,8 @@ guide_train.legend <- function(guide, scale, aesthetic = NULL) { #' @export guide_merge.legend <- function(guide, new_guide) { - guide$key <- merge(guide$key, new_guide$key, sort = FALSE) + new_guide$key$.label <- NULL + guide$key <- cbind(guide$key, new_guide$key) guide$override.aes <- c(guide$override.aes, new_guide$override.aes) if (any(duplicated(names(guide$override.aes)))) { warning("Duplicated override.aes is ignored.") diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index 29f951d0a3..2b735ac861 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -155,6 +155,13 @@ test_that("guide merging for guide_legend() works as expected", { ) expect_length(same_labels_different_scale, 1) expect_equal(same_labels_different_scale[[1]]$key$.label, c("a", "b", "c")) + + repeated_identical_labels <- merge_test_guides( + scale_colour_discrete(limits = c("one", "two", "three"), labels = c("label1", "label1", "label2")), + scale_linetype_discrete(limits = c("1", "2", "3"), labels = c("label1", "label1", "label2")) + ) + expect_length(repeated_identical_labels, 1) + expect_equal(repeated_identical_labels[[1]]$key$.label, c("label1", "label1", "label2")) }) # Visual tests ------------------------------------------------------------ From 5bb8a4d876df8961275472a7f2b9178a18c9a7ef Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Tue, 29 Oct 2019 21:01:47 -0300 Subject: [PATCH 3/4] remove expectations that depended on the guide order as returned by guides_merge() --- tests/testthat/test-guides.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index 2b735ac861..a2b00d44bb 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -132,8 +132,6 @@ test_that("guide merging for guide_legend() works as expected", { scale_linetype_discrete(limits = c("a", "b", "c")) ) expect_length(different_limits, 2) - expect_equal(different_limits[[1]]$key$.label, c("a", "b", "c", "d")) - expect_equal(different_limits[[2]]$key$.label, c("a", "b", "c")) same_limits <- merge_test_guides( scale_colour_discrete(limits = c("a", "b", "c")), From 7a8ee2f1383a85d4d00e01e5f06a1f6005519d79 Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Wed, 30 Oct 2019 09:41:04 -0300 Subject: [PATCH 4/4] remove unnecessary line in test --- tests/testthat/test-guides.R | 1 - 1 file changed, 1 deletion(-) diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index a2b00d44bb..eeb1c7fe4d 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -122,7 +122,6 @@ test_that("guide merging for guide_legend() works as expected", { scales$add(scale1) scales$add(scale2) - direction <- "vertical" guide_list <- guides_train(scales, theme = theme_gray(), labels = labs(), guides = guides()) guides_merge(guide_list) }