diff --git a/DESCRIPTION b/DESCRIPTION index dd766565..50a5b7d1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -29,6 +29,7 @@ Suggests: magrittr, pillar, rmarkdown, + slider (>= 0.3.0), testthat (>= 3.0.0), withr LinkingTo: diff --git a/NEWS.md b/NEWS.md index 5319c328..cd588112 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,8 @@ # clock (development version) +* Duration vectors now work as `.before` and `.after` arguments of + `slider::slide_index()` and friends (#306). + * R >=3.5.0 is now required, which is in line with tidyverse standards. * vctrs >=0.6.1 and rlang >=1.1.0 are now required. diff --git a/R/date.R b/R/date.R index 646767c6..f8288e66 100644 --- a/R/date.R +++ b/R/date.R @@ -356,6 +356,18 @@ arith_duration_and_date <- function(op, x, y, ...) { # ------------------------------------------------------------------------------ +# @export - .onLoad() +slider_plus.Date.clock_duration <- function(x, y) { + vec_arith("+", x, y) +} + +# @export - .onLoad() +slider_minus.Date.clock_duration <- function(x, y) { + vec_arith("-", x, y) +} + +# ------------------------------------------------------------------------------ + #' Arithmetic: date #' #' @description diff --git a/R/posixt.R b/R/posixt.R index 12b5c169..53b1c689 100644 --- a/R/posixt.R +++ b/R/posixt.R @@ -491,6 +491,28 @@ arith_duration_and_posixt <- function(op, x, y, ...) { # ------------------------------------------------------------------------------ +# @export - .onLoad() +slider_plus.POSIXct.clock_duration <- function(x, y) { + vec_arith("+", x, y) +} + +# @export - .onLoad() +slider_plus.POSIXlt.clock_duration <- function(x, y) { + vec_arith("+", x, y) +} + +# @export - .onLoad() +slider_minus.POSIXct.clock_duration <- function(x, y) { + vec_arith("-", x, y) +} + +# @export - .onLoad() +slider_minus.POSIXlt.clock_duration <- function(x, y) { + vec_arith("-", x, y) +} + +# ------------------------------------------------------------------------------ + #' Arithmetic: date-time #' #' @description diff --git a/R/zzz.R b/R/zzz.R index b08b6ff2..245b4a5c 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -20,6 +20,14 @@ vctrs::s3_register("pillar::pillar_shaft", "clock_calendar", pillar_shaft.clock_calendar) vctrs::s3_register("pillar::pillar_shaft", "clock_time_point", pillar_shaft.clock_time_point) vctrs::s3_register("pillar::pillar_shaft", "clock_zoned_time", pillar_shaft.clock_zoned_time) + + vctrs::s3_register("slider::slider_plus", "Date.clock_duration", slider_plus.Date.clock_duration) + vctrs::s3_register("slider::slider_plus", "POSIXct.clock_duration", slider_plus.POSIXct.clock_duration) + vctrs::s3_register("slider::slider_plus", "POSIXlt.clock_duration", slider_plus.POSIXlt.clock_duration) + + vctrs::s3_register("slider::slider_minus", "Date.clock_duration", slider_minus.Date.clock_duration) + vctrs::s3_register("slider::slider_minus", "POSIXct.clock_duration", slider_minus.POSIXct.clock_duration) + vctrs::s3_register("slider::slider_minus", "POSIXlt.clock_duration", slider_minus.POSIXlt.clock_duration) } # nocov end diff --git a/tests/testthat/_snaps/date.md b/tests/testthat/_snaps/date.md index 99ee13b8..43ce2755 100644 --- a/tests/testthat/_snaps/date.md +++ b/tests/testthat/_snaps/date.md @@ -287,3 +287,12 @@ > * is not permitted +# `slide_index()` will error on calendrical arithmetic and invalid dates + + Code + slider::slide_index(x, i, identity, .after = after) + Condition + Error in `stop_clock()`: + ! Invalid date found at location 2. + i Resolve invalid date issues by specifying the `invalid` argument. + diff --git a/tests/testthat/_snaps/posixt.md b/tests/testthat/_snaps/posixt.md index 1a87f4f8..6f8a4b64 100644 --- a/tests/testthat/_snaps/posixt.md +++ b/tests/testthat/_snaps/posixt.md @@ -408,3 +408,39 @@ > * > is not permitted +# `slide_index()` will error on naive-time based arithmetic and ambiguous times + + Code + slider::slide_index(x, i, identity, .after = after) + Condition + Error in `stop_clock()`: + ! Ambiguous time due to daylight saving time at location 1. + i Resolve ambiguous time issues by specifying the `ambiguous` argument. + +# `slide_index()` will error on naive-time based arithmetic and nonexistent times + + Code + slider::slide_index(x, i, identity, .after = after) + Condition + Error in `stop_clock()`: + ! Nonexistent time due to daylight saving time at location 1. + i Resolve nonexistent time issues by specifying the `nonexistent` argument. + +# `slide_index()` will error on calendrical arithmetic and ambiguous times + + Code + slider::slide_index(x, i, identity, .after = after) + Condition + Error in `stop_clock()`: + ! Ambiguous time due to daylight saving time at location 1. + i Resolve ambiguous time issues by specifying the `ambiguous` argument. + +# `slide_index()` will error on calendrical arithmetic and nonexistent times + + Code + slider::slide_index(x, i, identity, .after = after) + Condition + Error in `stop_clock()`: + ! Nonexistent time due to daylight saving time at location 1. + i Resolve nonexistent time issues by specifying the `nonexistent` argument. + diff --git a/tests/testthat/test-date.R b/tests/testthat/test-date.R index eecc5ee8..ccb171bc 100644 --- a/tests/testthat/test-date.R +++ b/tests/testthat/test-date.R @@ -608,3 +608,75 @@ test_that(" op ", { expect_snapshot_error(vec_arith("+", duration_hours(1), new_date(0))) expect_snapshot_error(vec_arith("*", duration_years(1), new_date(0))) }) + +# ------------------------------------------------------------------------------ +# slider_plus() / slider_minus() + +test_that("`slider_plus()` method is registered", { + skip_if_not_installed("slider", minimum_version = "0.3.0") + + x <- date_build(2019, 1, 1:2) + + y <- duration_days(2) + expect_identical( + slider::slider_plus(x, y), + date_build(2019, 1, 3:4) + ) + + y <- duration_years(1) + expect_identical( + slider::slider_plus(x, y), + date_build(2020, 1, 1:2) + ) +}) + +test_that("`slider_minus()` method is registered", { + skip_if_not_installed("slider", minimum_version = "0.3.0") + + x <- date_build(2019, 1, 1:2) + + y <- duration_days(2) + expect_identical( + slider::slider_minus(x, y), + date_build(2018, 12, 30:31) + ) + + y <- duration_years(1) + expect_identical( + slider::slider_minus(x, y), + date_build(2018, 1, 1:2) + ) +}) + +test_that("`slide_index()` works with dates and durations", { + skip_if_not_installed("slider", minimum_version = "0.3.0") + + i <- date_build(2019, 1, 1:4) + x <- seq_along(i) + + before <- duration_days(1) + after <- duration_days(2) + + expect_identical( + slider::slide_index(x, i, identity, .before = before, .after = after), + list( + 1:3, + 1:4, + 2:4, + 3:4 + ) + ) +}) + +test_that("`slide_index()` will error on calendrical arithmetic and invalid dates", { + skip_if_not_installed("slider", minimum_version = "0.3.0") + + i <- date_build(2019, 1, 28:31) + x <- seq_along(i) + + after <- duration_months(1) + + expect_snapshot(error = TRUE, { + slider::slide_index(x, i, identity, .after = after) + }) +}) diff --git a/tests/testthat/test-posixt.R b/tests/testthat/test-posixt.R index 2b7750e0..067ed9ee 100644 --- a/tests/testthat/test-posixt.R +++ b/tests/testthat/test-posixt.R @@ -997,3 +997,206 @@ test_that(" op ", { expect_snapshot_error(vec_arith("*", duration_years(1), new_datetime(0, zone))) expect_snapshot_error(vec_arith("*", duration_years(1), new_posixlt(0, zone))) }) + +# ------------------------------------------------------------------------------ +# slider_plus() / slider_minus() + +test_that("`slider_plus()` method is registered", { + skip_if_not_installed("slider", minimum_version = "0.3.0") + + zone <- "America/New_York" + + x <- date_time_build(2019, 1, 1, 3:4, 30, zone = zone) + + y <- duration_hours(3) + expect_identical( + slider::slider_plus(x, y), + date_time_build(2019, 1, 1, 6:7, 30, zone = zone) + ) + expect_identical( + slider::slider_plus(as.POSIXlt(x), y), + date_time_build(2019, 1, 1, 6:7, 30, zone = zone) + ) + + y <- duration_days(2) + expect_identical( + slider::slider_plus(x, y), + date_time_build(2019, 1, 3, 3:4, 30, zone = zone) + ) + expect_identical( + slider::slider_plus(as.POSIXlt(x), y), + date_time_build(2019, 1, 3, 3:4, 30, zone = zone) + ) +}) + +test_that("`slider_minus()` method is registered", { + skip_if_not_installed("slider", minimum_version = "0.3.0") + + zone <- "America/New_York" + + x <- date_time_build(2019, 1, 1, 3:4, 30, zone = zone) + + y <- duration_hours(3) + expect_identical( + slider::slider_minus(x, y), + date_time_build(2019, 1, 1, 0:1, 30, zone = zone) + ) + expect_identical( + slider::slider_minus(as.POSIXlt(x), y), + date_time_build(2019, 1, 1, 0:1, 30, zone = zone) + ) + + y <- duration_days(2) + expect_identical( + slider::slider_minus(x, y), + date_time_build(2018, 12, 30, 3:4, 30, zone = zone) + ) + expect_identical( + slider::slider_minus(as.POSIXlt(x), y), + date_time_build(2018, 12, 30, 3:4, 30, zone = zone) + ) +}) + +test_that("`slide_index()` works with date-times and durations", { + skip_if_not_installed("slider", minimum_version = "0.3.0") + + zone <- "America/New_York" + + i <- date_time_build(2019, 1, 1, 1:6, zone = zone) + x <- seq_along(i) + + before <- duration_hours(2) + after <- duration_hours(1) + + expect <- list( + 1:2, + 1:3, + 1:4, + 2:5, + 3:6, + 4:6 + ) + + expect_identical( + slider::slide_index(x, i, identity, .before = before, .after = after), + expect + ) + expect_identical( + slider::slide_index(x, as.POSIXlt(i), identity, .before = before, .after = after), + expect + ) +}) + +test_that("`slide_index()` with date-times and sys-time based arithmetic is sensible around ambiguous times", { + skip_if_not_installed("slider", minimum_version = "0.3.0") + + zone <- "America/New_York" + + hour <- c(0, 1, 1, 2, 3) + ambiguous <- c("error", "earliest", "latest", "error", "error") + + i <- date_time_build(1970, 10, 25, hour, zone = zone, ambiguous = ambiguous) + x <- seq_along(i) + + # Sys-time based arithmetic + before <- duration_hours(2) + + expect_identical( + slider::slide_index(x, i, identity, .before = before), + list( + 1L, + 1:2, + 1:3, + 2:4, + 3:5 + ) + ) +}) + +test_that("`slide_index()` with date-times and sys-time based arithmetic is sensible around nonexistent times", { + skip_if_not_installed("slider", minimum_version = "0.3.0") + + zone <- "America/New_York" + + i <- date_time_build(1970, 4, 26, 1, 59, 59, zone = zone) + i <- add_seconds(i, 0:4) + x <- seq_along(i) + + # Sys-time based arithmetic + before <- duration_seconds(2) + + expect_identical( + slider::slide_index(x, i, identity, .before = before), + list( + 1L, + 1:2, + 1:3, + 2:4, + 3:5 + ) + ) +}) + +test_that("`slide_index()` will error on naive-time based arithmetic and ambiguous times", { + skip_if_not_installed("slider", minimum_version = "0.3.0") + + zone <- "America/New_York" + + i <- date_time_build(1970, 10, 24, 1, zone = zone) + x <- seq_along(i) + + # Naive-time based arithmetic + after <- duration_days(1) + + expect_snapshot(error = TRUE, { + slider::slide_index(x, i, identity, .after = after) + }) +}) + +test_that("`slide_index()` will error on naive-time based arithmetic and nonexistent times", { + skip_if_not_installed("slider", minimum_version = "0.3.0") + + zone <- "America/New_York" + + i <- date_time_build(1970, 4, 25, 2, 30, zone = zone) + x <- seq_along(i) + + # Naive-time based arithmetic + after <- duration_days(1) + + expect_snapshot(error = TRUE, { + slider::slide_index(x, i, identity, .after = after) + }) +}) + +test_that("`slide_index()` will error on calendrical arithmetic and ambiguous times", { + skip_if_not_installed("slider", minimum_version = "0.3.0") + + zone <- "America/New_York" + + i <- date_time_build(1970, 9, 25, 1, zone = zone) + x <- seq_along(i) + + # Calendrical based arithmetic + after <- duration_months(1) + + expect_snapshot(error = TRUE, { + slider::slide_index(x, i, identity, .after = after) + }) +}) + +test_that("`slide_index()` will error on calendrical arithmetic and nonexistent times", { + skip_if_not_installed("slider", minimum_version = "0.3.0") + + zone <- "America/New_York" + + i <- date_time_build(1970, 3, 26, 2, 30, zone = zone) + x <- seq_along(i) + + # Calendrical based arithmetic + after <- duration_months(1) + + expect_snapshot(error = TRUE, { + slider::slide_index(x, i, identity, .after = after) + }) +})