Discard out-of-bounds binned breaks after generating labels

NEWS.md

@@ -1,5 +1,6 @@
 # ggplot2 (development version)
 
+* Fixed bug in out-of-bounds binned breaks (@teunbrand, #6054)
 * Passing empty unmapped aesthetics to layers raises a warning instead of
  throwing an error (@teunbrand, #6009).
 * Moved {mgcv} from Imports to Suggests (@teunbrand, #5986)

R/guide-bins.R

@@ -154,6 +154,8 @@ 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)) {
  limit_lab <- c(NA, NA)
  } else {
@@ -328,19 +330,22 @@ GuideBins <- ggproto(
 
 parse_binned_breaks <- function(scale, breaks = scale$get_breaks()) {
 
- breaks <- breaks[!is.na(breaks)]
+ if (is.waive(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

R/guide-colorsteps.R

@@ -110,11 +110,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

R/scale-.R

@@ -1305,9 +1305,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)

tests/testthat/test-guides.R

@@ -552,6 +552,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_binned(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"))
+})
+
 test_that("legends can be forced to display unrelated geoms", {
 
  df <- data.frame(x = 1:2)