Discard out-of-bounds binned breaks after generating labels (#6061)

* scales don't discard oob breaks

* guides deal with NA-breaks better

* `parse_binned_breaks()` preserves break length

* add test

* add news bullet

* choose non-default scale for test

Author: teunbrand

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 

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

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

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)

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", {