From 4ff50dcbd1e34b43581e8aaa774758620d79b28c Mon Sep 17 00:00:00 2001 From: DavisVaughan Date: Thu, 10 Nov 2022 10:25:57 -0500 Subject: [PATCH 1/3] Lazily register `slider_plus()` and `slider_minus()` methods --- DESCRIPTION | 3 + R/date.R | 12 ++ R/posixt.R | 22 ++++ R/zzz.R | 8 ++ tests/testthat/_snaps/date.md | 9 ++ tests/testthat/_snaps/posixt.md | 36 ++++++ tests/testthat/test-date.R | 72 +++++++++++ tests/testthat/test-posixt.R | 203 ++++++++++++++++++++++++++++++++ 8 files changed, 365 insertions(+) diff --git a/DESCRIPTION b/DESCRIPTION index dd766565..93c2ab2d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -29,6 +29,7 @@ Suggests: magrittr, pillar, rmarkdown, + slider (>= 0.2.2.9000), testthat (>= 3.0.0), withr LinkingTo: @@ -44,3 +45,5 @@ Encoding: UTF-8 LazyData: true Roxygen: list(markdown = TRUE) RoxygenNote: 7.2.3 +Remotes: + DavisVaughan/slider#184 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..1626419e 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.2.2.9000") + + 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.2.2.9000") + + 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.2.2.9000") + + 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.2.2.9000") + + 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..4d7c1087 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.2.2.9000") + + 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.2.2.9000") + + 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.2.2.9000") + + 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.2.2.9000") + + 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.2.2.9000") + + 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.2.2.9000") + + 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.2.2.9000") + + 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.2.2.9000") + + 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.2.2.9000") + + 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) + }) +}) From ba88e4e5af5b115fd84f1c8073a236cae7073130 Mon Sep 17 00:00:00 2001 From: DavisVaughan Date: Thu, 10 Nov 2022 10:26:59 -0500 Subject: [PATCH 2/3] NEWS bullet --- NEWS.md | 3 +++ 1 file changed, 3 insertions(+) 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. From e5c04fd275374f9fda74eec3ad95fe3664ad1b7d Mon Sep 17 00:00:00 2001 From: DavisVaughan Date: Thu, 13 Apr 2023 11:23:41 -0400 Subject: [PATCH 3/3] Bump to CRAN slider --- DESCRIPTION | 4 +--- tests/testthat/test-date.R | 8 ++++---- tests/testthat/test-posixt.R | 18 +++++++++--------- 3 files changed, 14 insertions(+), 16 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 93c2ab2d..50a5b7d1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -29,7 +29,7 @@ Suggests: magrittr, pillar, rmarkdown, - slider (>= 0.2.2.9000), + slider (>= 0.3.0), testthat (>= 3.0.0), withr LinkingTo: @@ -45,5 +45,3 @@ Encoding: UTF-8 LazyData: true Roxygen: list(markdown = TRUE) RoxygenNote: 7.2.3 -Remotes: - DavisVaughan/slider#184 diff --git a/tests/testthat/test-date.R b/tests/testthat/test-date.R index 1626419e..ccb171bc 100644 --- a/tests/testthat/test-date.R +++ b/tests/testthat/test-date.R @@ -613,7 +613,7 @@ test_that(" op ", { # slider_plus() / slider_minus() test_that("`slider_plus()` method is registered", { - skip_if_not_installed("slider", minimum_version = "0.2.2.9000") + skip_if_not_installed("slider", minimum_version = "0.3.0") x <- date_build(2019, 1, 1:2) @@ -631,7 +631,7 @@ test_that("`slider_plus()` method is registered", { }) test_that("`slider_minus()` method is registered", { - skip_if_not_installed("slider", minimum_version = "0.2.2.9000") + skip_if_not_installed("slider", minimum_version = "0.3.0") x <- date_build(2019, 1, 1:2) @@ -649,7 +649,7 @@ test_that("`slider_minus()` method is registered", { }) test_that("`slide_index()` works with dates and durations", { - skip_if_not_installed("slider", minimum_version = "0.2.2.9000") + skip_if_not_installed("slider", minimum_version = "0.3.0") i <- date_build(2019, 1, 1:4) x <- seq_along(i) @@ -669,7 +669,7 @@ test_that("`slide_index()` works with dates and durations", { }) test_that("`slide_index()` will error on calendrical arithmetic and invalid dates", { - skip_if_not_installed("slider", minimum_version = "0.2.2.9000") + skip_if_not_installed("slider", minimum_version = "0.3.0") i <- date_build(2019, 1, 28:31) x <- seq_along(i) diff --git a/tests/testthat/test-posixt.R b/tests/testthat/test-posixt.R index 4d7c1087..067ed9ee 100644 --- a/tests/testthat/test-posixt.R +++ b/tests/testthat/test-posixt.R @@ -1002,7 +1002,7 @@ test_that(" op ", { # slider_plus() / slider_minus() test_that("`slider_plus()` method is registered", { - skip_if_not_installed("slider", minimum_version = "0.2.2.9000") + skip_if_not_installed("slider", minimum_version = "0.3.0") zone <- "America/New_York" @@ -1030,7 +1030,7 @@ test_that("`slider_plus()` method is registered", { }) test_that("`slider_minus()` method is registered", { - skip_if_not_installed("slider", minimum_version = "0.2.2.9000") + skip_if_not_installed("slider", minimum_version = "0.3.0") zone <- "America/New_York" @@ -1058,7 +1058,7 @@ test_that("`slider_minus()` method is registered", { }) test_that("`slide_index()` works with date-times and durations", { - skip_if_not_installed("slider", minimum_version = "0.2.2.9000") + skip_if_not_installed("slider", minimum_version = "0.3.0") zone <- "America/New_York" @@ -1088,7 +1088,7 @@ test_that("`slide_index()` works with date-times and durations", { }) 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.2.2.9000") + skip_if_not_installed("slider", minimum_version = "0.3.0") zone <- "America/New_York" @@ -1114,7 +1114,7 @@ test_that("`slide_index()` with date-times and sys-time based arithmetic is sens }) 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.2.2.9000") + skip_if_not_installed("slider", minimum_version = "0.3.0") zone <- "America/New_York" @@ -1138,7 +1138,7 @@ test_that("`slide_index()` with date-times and sys-time based arithmetic is sens }) test_that("`slide_index()` will error on naive-time based arithmetic and ambiguous times", { - skip_if_not_installed("slider", minimum_version = "0.2.2.9000") + skip_if_not_installed("slider", minimum_version = "0.3.0") zone <- "America/New_York" @@ -1154,7 +1154,7 @@ test_that("`slide_index()` will error on naive-time based arithmetic and ambiguo }) test_that("`slide_index()` will error on naive-time based arithmetic and nonexistent times", { - skip_if_not_installed("slider", minimum_version = "0.2.2.9000") + skip_if_not_installed("slider", minimum_version = "0.3.0") zone <- "America/New_York" @@ -1170,7 +1170,7 @@ test_that("`slide_index()` will error on naive-time based arithmetic and nonexis }) test_that("`slide_index()` will error on calendrical arithmetic and ambiguous times", { - skip_if_not_installed("slider", minimum_version = "0.2.2.9000") + skip_if_not_installed("slider", minimum_version = "0.3.0") zone <- "America/New_York" @@ -1186,7 +1186,7 @@ test_that("`slide_index()` will error on calendrical arithmetic and ambiguous ti }) test_that("`slide_index()` will error on calendrical arithmetic and nonexistent times", { - skip_if_not_installed("slider", minimum_version = "0.2.2.9000") + skip_if_not_installed("slider", minimum_version = "0.3.0") zone <- "America/New_York"