Fix brk_manual() not to warn when close_end is set to FALSE, no…

…w that `TRUE` is the default.

NEWS.md

@@ -14,6 +14,7 @@
   recalculates probabilities using `ecdf(x)`, which may give more accurate 
   interval labels.
 * `single = NULL` has been documented explicitly in `lbl_*` functions.
+* Bugfix: `brk_manual()` no longer warns if `close_end = TRUE` (the default).
 
 
 # santoku 1.0.0

R/breaks-misc.R

@@ -23,6 +23,10 @@
 #' at indices `i`, `i+1`, `left[i]` *must* be `TRUE` and `left[i+1]` must be
 #' `FALSE`.
 #'
+#' `brk_manual()` ignores `left` and `close_end` arguments passed in
+#' from [chop()], since `left_vec` sets these manually.
+#' `extend` and `drop` arguments are respected as usual.
+#'
 #' @export
 #'
 #' @examples
@@ -50,9 +54,9 @@ brk_manual <- function (breaks, left_vec) {
 
   function (x, extend, left, close_end) {
     if (! left) warning("Ignoring `left` with `brk_manual()`")
-    if (close_end) warning("Ignoring `close_end` with `brk_manual()`")
+    if (! close_end) warning("Ignoring `close_end` with `brk_manual()`")
     breaks <- create_breaks(breaks, left_vec)
-    breaks <- extend_and_close(breaks, x, extend, left, close_end)
+    breaks <- extend_and_close(breaks, x, extend, left = TRUE, close_end = FALSE)
   }
 }
 
@@ -144,4 +148,4 @@ brk_mean_sd <- function (sds = 1:3, sd = deprecated()) {
 
     breaks
   }
-}
+}

R/utils.R

@@ -128,7 +128,7 @@ brk_res <- function (
   x         = 1:2,
   extend    = FALSE,
   left      = TRUE,
-  close_end = FALSE
+  close_end = TRUE
 ) {
   brk_fun(x, extend = extend, left = left, close_end = close_end)
 }

tests/testthat/test-Date-DateTime.R

@@ -255,13 +255,14 @@ test_that("chop timezones", {
 
 test_that("Date labels", {
   li <- lbl_intervals()
-  b <- brk_res(brk_default(db1))
+  b <- brk_res(brk_default(db1), close_end = FALSE)
   expect_equivalent(
     li(b), "[1975-11-01, 1975-11-15)"
   )
 
   withr::local_options(santoku.infinity = "Inf")
-  b2 <- brk_res(brk_default(db1), x = as.Date("1975-01-01"), extend = TRUE)
+  b2 <- brk_res(brk_default(db1), x = as.Date("1975-01-01"), extend = TRUE,
+                close_end = FALSE)
   expect_equivalent(
     li(b2), c("[-Inf, 1975-11-01)", "[1975-11-01, 1975-11-15)", "[1975-11-15, Inf]")
   )
@@ -285,7 +286,7 @@ test_that("Date labels", {
 
 test_that("POSIXct labels", {
   li <- lbl_intervals()
-  b <- brk_res(brk_default(dtb1))
+  b <- brk_res(brk_default(dtb1), close_end = FALSE)
   expect_equivalent(
     li(b), "[2000-01-01 15:04:00, 2000-01-01 15:14:00)"
   )

tests/testthat/test-chop.R

@@ -6,15 +6,15 @@ test_that("basic functionality", {
   rc_brks <- brk_manual(1:3, c(TRUE, TRUE, FALSE))
 
   expect_equivalent(
-    chop(x, lbrks, lbl_seq("1"), extend = FALSE, close_end = FALSE),
+    chop(x, lbrks, lbl_seq("1"), extend = FALSE),
     factor(c(1, 2, NA))
   )
   expect_equivalent(
-    chop(x, rbrks, lbl_seq("1"), extend = FALSE, close_end = FALSE),
+    chop(x, rbrks, lbl_seq("1"), extend = FALSE),
     factor(c(NA, 1, 2))
   )
   expect_equivalent(
-    chop(x, rc_brks, lbl_seq("1"), extend = FALSE, close_end = FALSE),
+    chop(x, rc_brks, lbl_seq("1"), extend = FALSE),
     factor(c(1, 2, 2))
   )
 

tests/testthat/test-labels.R

@@ -242,7 +242,7 @@ test_that("lbl_intervals", {
   expect_equivalent(lbl_intervals()(rbrk), c("[1, 2]", "(2, 3]"))
 
   sbrk <- brk_res(brk_default(c(1, 2, 2, 3)))
-  expect_equivalent(lbl_intervals()(sbrk), c("[1, 2)", "{2}", "(2, 3)"))
+  expect_equivalent(lbl_intervals()(sbrk), c("[1, 2)", "{2}", "(2, 3]"))
 
   mbrk <- brk_res(brk_manual(1:4, c(FALSE, TRUE, FALSE, TRUE)))
   expect_equivalent(lbl_intervals()(mbrk), c("(1, 2)", "[2, 3]", "(3, 4)"))
@@ -253,51 +253,51 @@ test_that("lbl_intervals arguments", {
   lbrk <- brk_res(brk_default(c(1, 2, 2, 3) + 0.5))
   expect_equivalent(
     lbl_intervals(fmt = "%.2f")(lbrk),
-    c("[1.50, 2.50)", "{2.50}",  "(2.50, 3.50)")
+    c("[1.50, 2.50)", "{2.50}",  "(2.50, 3.50]")
   )
 
   expect_equivalent(
     lbl_intervals(fmt = list(digits = 2))(lbrk),
-    c("[1.5, 2.5)", "{2.5}",  "(2.5, 3.5)")
+    c("[1.5, 2.5)", "{2.5}",  "(2.5, 3.5]")
   )
 
   lbrk <- brk_res(brk_default(1:3 * 10000))
   expect_equivalent(
     lbl_intervals(fmt = "%2g")(lbrk),
-    c("[10000, 20000)", "[20000, 30000)")
+    c("[10000, 20000)", "[20000, 30000]")
   )
 
   qbrk <- brk_res(brk_quantiles(c(0, 0.5, 1)), x = 0:10)
   expect_equivalent(
     lbl_intervals()(qbrk),
-    c("[0%, 50%)", "[50%, 100%)")
+    c("[0%, 50%)", "[50%, 100%]")
   )
 
   expect_equivalent(
     lbl_intervals(fmt = "%.2f")(qbrk),
-    c("[0.00, 0.50)", "[0.50, 1.00)")
+    c("[0.00, 0.50)", "[0.50, 1.00]")
   )
   expect_equivalent(
     lbl_intervals(fmt = percent)(qbrk),
-    c("[0%, 50%)", "[50%, 100%)")
+    c("[0%, 50%)", "[50%, 100%]")
   )
   expect_equivalent(
     lbl_intervals(fmt = list(digits = 2))(qbrk),
-    c("[0.0, 0.5)", "[0.5, 1.0)")
+    c("[0.0, 0.5)", "[0.5, 1.0]")
   )
 
   lbrk <- brk_res(brk_default(c(1, 2, 2, 3)))
   expect_equivalent(
     lbl_intervals(first = "< {r}")(lbrk),
-    c("< 2", "{2}", "(2, 3)")
+    c("< 2", "{2}", "(2, 3]")
   )
   expect_equivalent(
     lbl_intervals(last = "> {l}")(lbrk),
     c("[1, 2)", "{2}", "> 2")
   )
   expect_equivalent(
     lbl_intervals(single = "[{l}]")(lbrk),
-    c("[1, 2)", "[2]", "(2, 3)")
+    c("[1, 2)", "[2]", "(2, 3]")
   )
 
   lifecycle::expect_deprecated(lbl_intervals(raw = TRUE))
@@ -306,11 +306,11 @@ test_that("lbl_intervals arguments", {
 
   expect_equivalent(
     lbl_intervals(raw = TRUE)(qbrk),
-    c("[0, 5)", "[5, 10)")
+    c("[0, 5)", "[5, 10]")
   )
   expect_equivalent(
     lbl_intervals(raw = TRUE, fmt = "%.2f")(qbrk),
-    c("[0.00, 5.00)", "[5.00, 10.00)")
+    c("[0.00, 5.00)", "[5.00, 10.00]")
   )
 })
 
@@ -341,22 +341,22 @@ test_that("lbl_discrete arguments", {
   lbrk <- brk_res(brk_default(c(1, 3, 5)))
   expect_equivalent(
     lbl_discrete("-", fmt = "(%s)")(lbrk),
-    c("(1)-(2)", "(3)-(4)")
+    c("(1)-(2)", "(3)-(5)")
   )
 
   expect_equivalent(
     lbl_discrete("-", fmt = brackets)(lbrk),
-    c("(1)-(2)", "(3)-(4)")
+    c("(1)-(2)", "(3)-(5)")
   )
 
   expect_equivalent(
     lbl_discrete("-", fmt = list(nsmall = 1))(lbrk),
-    c("1.0-2.0", "3.0-4.0")
+    c("1.0-2.0", "3.0-5.0")
   )
 
   expect_equivalent(
     lbl_discrete("-", first = "<= {r}")(lbrk),
-    c("<= 2", "3-4")
+    c("<= 2", "3-5")
   )
 
   expect_equivalent(
@@ -367,13 +367,13 @@ test_that("lbl_discrete arguments", {
   sbrk <- brk_res(brk_default(c(1, 3, 3, 6)))
   expect_equivalent(
     lbl_discrete("-", single = "[{l}]")(sbrk),
-    c("1-2", "[3]", "4-5")
+    c("1-2", "[3]", "4-6")
   )
 
   brk1000 <- brk_res(brk_default(c(1, 3, 5) * 1000))
   expect_equivalent(
     lbl_discrete("-", unit = 1000)(brk1000),
-    c("1000-2000", "3000-4000")
+    c("1000-2000", "3000-5000")
   )
 })
 

tests/testthat/test-zzz-systematic.R

@@ -68,7 +68,7 @@ test_that("systematic tests", {
   }
 
   skip_test(! left & brk_fun == "brk_manual")
-  skip_test(close_end & brk_fun == "brk_manual")
+  skip_test(! close_end & brk_fun == "brk_manual")
 
   POSIXct_breaks <- c("brk_def_POSIXct", "brk_w_difft_sec")
   Date_breaks <- c("brk_def_Date", "brk_w_difft_day")