diff --git a/NEWS.md b/NEWS.md index 2bd655a5c1..6e3896e061 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # ggplot2 (development version) +* Fixed bug in out-of-bounds binned breaks (@teunbrand, #6054) * Binned guides now accept expressions as labels (@teunbrand, #6005) * (internal) `Scale$get_labels()` format expressions as lists. * In non-orthogonal coordinate systems (`coord_sf()`, `coord_polar()` and diff --git a/R/guide-bins.R b/R/guide-bins.R index 5bc695b010..c0344bbbe0 100644 --- a/R/guide-bins.R +++ b/R/guide-bins.R @@ -161,6 +161,9 @@ GuideBins <- ggproto( key$.show <- NA labels <- scale$get_labels(breaks) + labels <- labels[!is.na(breaks)] + breaks <- breaks[!is.na(breaks)] + if (is.character(scale$labels) || is.numeric(scale$labels) || is.expression(scale$labels)) { limit_lab <- c(NA, NA) } else { @@ -335,19 +338,22 @@ GuideBins <- ggproto( parse_binned_breaks <- function(scale, breaks = scale$get_breaks()) { - breaks <- breaks[!is.na(breaks)] + if (is.waiver(scale$labels) || is.function(scale$labels)) { + breaks <- breaks[!is.na(breaks)] + } if (length(breaks) == 0) { return(NULL) } if (is.numeric(breaks)) { - breaks <- sort(breaks) limits <- scale$get_limits() if (!is.numeric(scale$breaks)) { - breaks <- breaks[!breaks %in% limits] + breaks[breaks %in% limits] <- NA } - breaks <- oob_discard(breaks, limits) + breaks <- oob_censor(breaks, limits) all_breaks <- unique0(c(limits[1], breaks, limits[2])) + # Sorting drops NAs on purpose here + all_breaks <- sort(all_breaks, na.last = NA) bin_at <- all_breaks[-1] - diff(all_breaks) / 2 } else { bin_at <- breaks diff --git a/R/guide-colorsteps.R b/R/guide-colorsteps.R index 54cd89a948..240a1e607c 100644 --- a/R/guide-colorsteps.R +++ b/R/guide-colorsteps.R @@ -112,11 +112,13 @@ GuideColoursteps <- ggproto( key <- data_frame0(!!aesthetic := scale$map(breaks)) if (even.steps) { - key$.value <- seq_along(breaks) + key$.value <- NA_integer_ + key$.value[!is.na(breaks)] <- seq_along(breaks[!is.na(breaks)]) } else { key$.value <- breaks } key$.label <- scale$get_labels(breaks) + key <- vec_slice(key, !is.na(breaks)) if (breaks[1] %in% limits) { key$.value <- key$.value - 1L diff --git a/R/scale-.R b/R/scale-.R index f345310e4b..6732e22ba3 100644 --- a/R/scale-.R +++ b/R/scale-.R @@ -1307,9 +1307,6 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, breaks <- self$breaks } - # Breaks must be within limits - breaks <- oob_discard(breaks, sort(limits)) - self$breaks <- breaks transformation$transform(breaks) diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index 5904676541..03848b85f2 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -190,6 +190,20 @@ test_that("bins can be parsed by guides for all scale types", { ) }) +test_that("binned breaks can have hardcoded labels when oob", { + + sc <- scale_colour_steps(breaks = 1:3, labels = as.character(1:3)) + sc$train(c(1, 2)) + + g <- guide_bins() + key <- g$train(scale = sc, aesthetic = "colour")$key + expect_equal(key$.label, c("1", "2")) + + g <- guide_coloursteps() + key <- g$train(scale = sc, aesthetic = "colour")$key + expect_equal(key$.label, c("1", "2")) +}) + # Visual tests ------------------------------------------------------------ test_that("guides are positioned correctly", {