Breaks deal with ranges more consistently

DESCRIPTION

@@ -40,4 +40,4 @@ Config/usethis/last-upkeep: 2025-04-23
 Encoding: UTF-8
 LazyLoad: yes
 Roxygen: list(markdown = TRUE, r6 = FALSE)
-RoxygenNote: 7.3.2
+RoxygenNote: 7.3.3

R/breaks.R

@@ -19,9 +19,9 @@
 #'
 #' @return
 #' All `breaks_()` functions return a function for generating breaks. These
-#' functions takes, as their first argument a vector of values that represent
+#' functions takes, as their first argument a vector of length 2 that represent
 #' the data range to provide breaks for. Some will optionally take a second
-#' argument that allows you to specify the number of breaks to recieve.
+#' argument that allows you to specify the number of breaks to receive.
 #'
 #' @export
 #' @examples
@@ -62,6 +62,14 @@ breaks_width <- function(width, offset = 0) {
   force_all(width, offset)
 
   function(x) {
+    x <- suppressWarnings(range(x, na.rm = TRUE))
+    x <- x[is.finite(x)]
+    if (length(x) == 0) {
+      return(x)
+    }
+    if (zero_range(as.numeric(x))) {
+      return(x[1])
+    }
     x <- fullseq(x, width)
     for (i in offset) {
       x <- offset_by(x, i)
@@ -92,13 +100,15 @@ breaks_width <- function(width, offset = 0) {
 breaks_extended <- function(n = 5, ...) {
   n_default <- n
   function(x, n = n_default) {
+    x <- suppressWarnings(range(x, na.rm = TRUE))
     x <- x[is.finite(x)]
     if (length(x) == 0) {
-      return(numeric())
+      return(x)
     }
-
-    rng <- range(x)
-    labeling::extended(rng[1], rng[2], n, ...)
+    if (zero_range(as.numeric(x))) {
+      return(x[1])
+    }
+    labeling::extended(x[1], x[2], n, ...)
   }
 }
 
@@ -135,7 +145,12 @@ breaks_pretty <- function(n = 5, ...) {
   force_all(n, ...)
   n_default <- n
   function(x, n = n_default) {
-    if (length(x) > 0 && zero_range(range(as.numeric(x), na.rm = TRUE))) {
+    x <- suppressWarnings(range(x, na.rm = TRUE))
+    x <- x[is.finite(x)]
+    if (length(x) == 0) {
+      return(x)
+    }
+    if (zero_range(as.numeric(x))) {
       return(x[1])
     }
     breaks <- pretty(x, n, ...)
@@ -180,8 +195,16 @@ breaks_timespan <- function(
   force(n)
   function(x) {
     x <- as.numeric(as.difftime(x, units = unit), units = "secs")
-    rng <- range(x)
-    diff <- rng[2] - rng[1]
+    x <- suppressWarnings(range(x, na.rm = TRUE))
+    x <- x[is.finite(x)]
+    if (length(x) == 0) {
+      return(as.difftime(x, units = "secs"))
+    }
+    if (zero_range(x)) {
+      return(as.difftime(x[1], units = "secs"))
+    }
+
+    diff <- x[2] - x[1]
 
     if (diff <= 2 * 60) {
       scale <- 1
@@ -195,10 +218,10 @@ breaks_timespan <- function(
       scale <- 604800
     }
 
-    rng <- rng / scale
+    x <- x / scale
     breaks <- labeling::extended(
-      rng[1],
-      rng[2],
+      x[1],
+      x[2],
       n,
       Q = c(1, 2, 1.5, 4, 3),
       only.loose = FALSE
@@ -228,7 +251,14 @@ breaks_exp <- function(n = 5, ...) {
   default <- extended_breaks(n = n_default, ...)
   function(x, n = n_default) {
     # Discard -Infs
-    x <- sort(pmax(x, 0))
+    x <- suppressWarnings(range(pmax(x, 0), na.rm = TRUE))
+    x <- x[is.finite(x)]
+    if (length(x) == 0) {
+      return(x)
+    }
+    if (zero_range(as.numeric(x))) {
+      return(x[1])
+    }
     top <- floor(x[2])
     if (top >= 3 && abs(diff(x)) >= 3) {
       unique(c(top - seq_len(min(top, n_default - 1)) + 1, 0))

tests/testthat/_snaps/breaks.md

@@ -0,0 +1,51 @@
+# break functions deal with longer input
+
+    Code
+      breaks_exp()(c(1, 10, 100))
+    Output
+      [1] 100  99  98  97   0
+
+---
+
+    Code
+      breaks_extended()(c(1, 10, 100))
+    Output
+      [1]   0  25  50  75 100
+
+---
+
+    Code
+      breaks_log()(c(1, 10, 100))
+    Output
+      [1]   1  10 100
+
+---
+
+    Code
+      breaks_pretty()(c(1, 10, 100))
+    Output
+      [1]   0  20  40  60  80 100
+
+---
+
+    Code
+      breaks_timespan()(as.difftime(c(1, 10, 10), units = "days"))
+    Output
+      Time differences in secs
+      [1]      0 172800 345600 518400 691200 864000
+
+---
+
+    Code
+      breaks_width(10)(c(1, 10, 100))
+    Output
+       [1]   0  10  20  30  40  50  60  70  80  90 100
+
+---
+
+    Code
+      breaks_width("1 day")(as.Date(c("2000-01-01", "2000-01-03", "2000-01-05")))
+    Output
+      [1] "2000-01-01" "2000-01-02" "2000-01-03" "2000-01-04" "2000-01-05"
+      [6] "2000-01-06"
+

tests/testthat/test-breaks.R

@@ -48,3 +48,45 @@ test_that("exponential breaks give sensible values", {
   x <- breaks_exp()(c(0, 100))
   expect_equal(x, c(100, 99, 98, 97, 0))
 })
+
+test_that("breaks functions deal with length 0 input", {
+  expect_equal(breaks_exp()(numeric()), numeric())
+  expect_equal(breaks_extended()(numeric()), numeric())
+  expect_equal(breaks_log()(numeric()), numeric())
+  expect_equal(breaks_pretty()(numeric()), numeric())
+  expect_equal(
+    breaks_timespan()(as.difftime(numeric(), units = "days")),
+    as.difftime(numeric(), units = "secs")
+  )
+  expect_equal(breaks_width(1)(numeric()), numeric())
+  expect_equal(
+    breaks_width("1 day")(as.Date(character())),
+    as.Date(character())
+  )
+})
+
+test_that("break functions deal with NA input", {
+  expect_equal(breaks_exp()(c(10, NA)), 10)
+  expect_equal(breaks_extended()(c(10, NA)), 10)
+  expect_equal(breaks_log()(c(10, NA)), 10)
+  expect_equal(breaks_pretty()(c(10, NA)), 10)
+  expect_equal(
+    breaks_timespan()(as.difftime(c(10, NA), units = "days")),
+    as.difftime(10 * 3600 * 24, units = "secs")
+  )
+  expect_equal(breaks_width(1)(c(10, NA)), 10)
+  expect_equal(
+    breaks_width("1 day")(as.Date(c("2000-01-01", NA))),
+    as.Date("2000-01-01")
+  )
+})
+
+test_that("break functions deal with longer input", {
+  expect_snapshot(breaks_exp()(c(1, 10, 100)))
+  expect_snapshot(breaks_extended()(c(1, 10, 100)))
+  expect_snapshot(breaks_log()(c(1, 10, 100)))
+  expect_snapshot(breaks_pretty()(c(1, 10, 100)))
+  expect_snapshot(breaks_timespan()(as.difftime(c(1, 10, 10), units = 'days')))
+  expect_snapshot(breaks_width(10)(c(1, 10, 100)))
+  expect_snapshot(breaks_width("1 day")(as.Date(c("2000-01-01", "2000-01-03", "2000-01-05"))))
+})