diff --git a/NEWS.md b/NEWS.md index 1bd8352..58c01fd 100644 --- a/NEWS.md +++ b/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 diff --git a/R/breaks-misc.R b/R/breaks-misc.R index 4f455d7..b830afe 100644 --- a/R/breaks-misc.R +++ b/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 } -} \ No newline at end of file +} diff --git a/R/utils.R b/R/utils.R index 093f270..c999278 100644 --- a/R/utils.R +++ b/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) } diff --git a/man/brk_manual.Rd b/man/brk_manual.Rd index ca6ce95..6778a6d 100644 --- a/man/brk_manual.Rd +++ b/man/brk_manual.Rd @@ -32,6 +32,10 @@ Singleton breaks are created by repeating a number in \code{breaks}. Singletons must be closed on both sides, so if there is a repeated number at indices \code{i}, \code{i+1}, \code{left[i]} \emph{must} be \code{TRUE} and \code{left[i+1]} must be \code{FALSE}. + +\code{brk_manual()} ignores \code{left} and \code{close_end} arguments passed in +from \code{\link[=chop]{chop()}}, since \code{left_vec} sets these manually. +\code{extend} and \code{drop} arguments are respected as usual. } \examples{ lbrks <- brk_manual(1:3, rep(TRUE, 3)) diff --git a/tests/testthat/test-Date-DateTime.R b/tests/testthat/test-Date-DateTime.R index e912f7e..c77dfff 100644 --- a/tests/testthat/test-Date-DateTime.R +++ b/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)" ) diff --git a/tests/testthat/test-chop.R b/tests/testthat/test-chop.R index c671a08..42eaa9f 100644 --- a/tests/testthat/test-chop.R +++ b/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)) ) diff --git a/tests/testthat/test-labels.R b/tests/testthat/test-labels.R index 66b8b2f..7a0a718 100644 --- a/tests/testthat/test-labels.R +++ b/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,43 +253,43 @@ 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), @@ -297,7 +297,7 @@ test_that("lbl_intervals arguments", { ) 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") ) }) diff --git a/tests/testthat/test-zzz-systematic.R b/tests/testthat/test-zzz-systematic.R index ebc4d5c..4312f38 100644 --- a/tests/testthat/test-zzz-systematic.R +++ b/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")