diff --git a/NEWS.md b/NEWS.md index a96a2e4b02..68bb2f2c48 100644 --- a/NEWS.md +++ b/NEWS.md @@ -26,6 +26,8 @@ * When legends detect the presence of values in a layer, `NA` is now detected if the data contains values outside the given breaks (@teunbrand, #5749). * `annotate()` now warns about `stat` or `position` arguments (@teunbrand, #5151) +* `guide_coloursteps(even.steps = FALSE)` now works with discrete data that has + been formatted by `cut()` (@teunbrand, #3877). # ggplot2 3.5.0 diff --git a/R/guide-bins.R b/R/guide-bins.R index c5f39c9490..571a461d4b 100644 --- a/R/guide-bins.R +++ b/R/guide-bins.R @@ -326,8 +326,7 @@ GuideBins <- ggproto( } ) -parse_binned_breaks = function(scale, breaks = scale$get_breaks(), - even.steps = TRUE) { +parse_binned_breaks = function(scale, breaks = scale$get_breaks()) { breaks <- breaks[!is.na(breaks)] if (length(breaks) == 0) { @@ -343,12 +342,6 @@ parse_binned_breaks = function(scale, breaks = scale$get_breaks(), all_breaks <- unique0(c(limits[1], breaks, limits[2])) bin_at <- all_breaks[-1] - diff(all_breaks) / 2 } else { - if (isFALSE(even.steps)) { - cli::cli_warn(paste0( - "{.code even.steps = FALSE} is not supported when used with a ", - "discrete scale." - )) - } bin_at <- breaks nums <- as.character(breaks) nums <- strsplit(gsub("\\(|\\)|\\[|\\]", "", nums), ",\\s?") diff --git a/R/guide-colorsteps.R b/R/guide-colorsteps.R index 5a8a4b7e76..d85421bbc9 100644 --- a/R/guide-colorsteps.R +++ b/R/guide-colorsteps.R @@ -98,7 +98,7 @@ GuideColoursteps <- ggproto( return(Guide$extract_key(scale, aesthetic)) } - parsed <- parse_binned_breaks(scale, breaks, even.steps) + parsed <- parse_binned_breaks(scale, breaks) if (is.null(parsed)) { return(parsed) } @@ -106,7 +106,11 @@ GuideColoursteps <- ggproto( breaks <- parsed$breaks key <- data_frame0(!!aesthetic := scale$map(breaks)) - key$.value <- seq_along(breaks) + if (even.steps) { + key$.value <- seq_along(breaks) + } else { + key$.value <- breaks + } key$.label <- scale$get_labels(breaks) if (breaks[1] %in% limits) { @@ -117,35 +121,34 @@ GuideColoursteps <- ggproto( key[[1]][nrow(key)] <- NA } # To avoid having to recalculate these variables in other methods, we - # attach these as attributes. It might not be very elegant, but it works. - attr(key, "limits") <- parsed$limits - attr(key, "bin_at") <- parsed$bin_at - return(key) + # attach the parsed values as attributes. It might not be very elegant, + # but it works. + attr(key, "parsed") <- parsed + key }, extract_decor = function(scale, aesthetic, key, reverse = FALSE, even.steps = TRUE, nbin = 100, alpha = NA,...) { + + parsed <- attr(key, "parsed") + breaks <- parsed$breaks %||% scale$get_breaks() + limits <- parsed$limits %||% scale$get_limits() + + breaks <- sort(unique0(c(limits, breaks))) + n <- length(breaks) + bin_at <- parsed$bin_at %||% ((breaks[-1] + breaks[-n]) / 2) + if (even.steps) { - bin_at <- attr(key, "bin_at", TRUE) - bar <- data_frame0( - colour = alpha(scale$map(bin_at), alpha), - min = seq_along(bin_at) - 1, - max = seq_along(bin_at), - .size = length(bin_at) - ) - } else { - breaks <- unique(sort(c(scale$get_limits(), scale$get_breaks()))) - n <- length(breaks) - bin_at <- (breaks[-1] + breaks[-n]) / 2 - bar <- data_frame0( - colour = alpha(scale$map(bin_at), alpha), - min = head(breaks, -1), - max = tail(breaks, -1), - .size = length(bin_at) - ) + breaks <- seq_len(n) - 1L } - return(bar) + + data_frame0( + colour = alpha(scale$map(bin_at), alpha), + min = breaks[-n], + max = breaks[-1], + .size = length(bin_at) + ) }, extract_params = function(scale, params, direction = "vertical", title = waiver(), ...) { @@ -166,7 +169,7 @@ GuideColoursteps <- ggproto( if (show.limits) { key <- params$key - limits <- attr(key, "limits", TRUE) %||% scale$get_limits() + limits <- attr(key, "parsed")$limits %||% scale$get_limits() key <- key[c(NA, seq_len(nrow(key)), NA), , drop = FALSE] n <- nrow(key) key$.value[c(1, n)] <- range(params$decor$min, params$decor$max) diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index f1a9f613d5..bc359938ae 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -302,6 +302,21 @@ test_that("guide_coloursteps and guide_bins return ordered breaks", { expect_true(all(diff(key$.value) > 0)) }) +test_that("guide_coloursteps can parse (un)even steps from discrete scales", { + + val <- cut(1:10, breaks = c(0, 3, 5, 10), include.lowest = TRUE) + scale <- scale_colour_viridis_d() + scale$train(val) + + g <- guide_coloursteps(even.steps = TRUE) + decor <- g$train(scale = scale, aesthetics = "colour")$decor + expect_equal(decor$max - decor$min, rep(1/3, 3)) + + g <- guide_coloursteps(even.steps = FALSE) + decor <- g$train(scale = scale, aesthetics = "colour")$decor + expect_equal(decor$max - decor$min, c(0.3, 0.2, 0.5)) +}) + test_that("guide_colourbar merging preserves both aesthetics", { # See issue 5324