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)