Support is.nan(), is.finite(), and is.infinite() (#243)

* Add `is.nan()`, `is.finite()`, and `is.infinite()` for clock-rcrds

* Add `is.nan()`, `is.finite()`, and `is.infinite()` for weekday

* NEWS bullet

Author: DavisVaughan

NAMESPACE

@@ -498,6 +498,8 @@ S3method(vec_cast,clock_year_month_day.clock_year_month_day)
 S3method(vec_cast,clock_year_month_weekday.clock_year_month_weekday)
 S3method(vec_cast,clock_year_quarter_day.clock_year_quarter_day)
 S3method(vec_cast,clock_zoned_time.clock_zoned_time)
+S3method(vec_math,clock_rcrd)
+S3method(vec_math,clock_weekday)
 S3method(vec_proxy,clock_duration)
 S3method(vec_proxy,clock_iso_year_week_day)
 S3method(vec_proxy,clock_time_point)

NEWS.md

@@ -8,6 +8,9 @@
 
 * New `invalid_remove()` for removing invalid dates. This is just a wrapper
   around `x[!invalid_detect(x)]`, but works nicely with the pipe (#229).
+  
+* All clock types now support `is.nan()`, `is.finite()`, and `is.infinite()`
+  (#235).
 
 # clock 0.3.1
 

R/rcrd.R

@@ -37,3 +37,28 @@ names.clock_rcrd <- function(x) {
 
   vec_slice(x, i)
 }
+
+# ------------------------------------------------------------------------------
+
+#' @export
+vec_math.clock_rcrd <- function(.fn, .x, ...) {
+  switch(
+    .fn,
+    is.nan = clock_rcrd_is_nan(.x),
+    is.finite = clock_rcrd_is_finite(.x),
+    is.infinite = clock_rcrd_is_infinite(.x),
+    NextMethod()
+  )
+}
+
+clock_rcrd_is_nan <- function(x) {
+  vec_rep(FALSE, vec_size(x))
+}
+
+clock_rcrd_is_finite <- function(x) {
+  !vec_equal_na(x)
+}
+
+clock_rcrd_is_infinite <- function(x) {
+  vec_rep(FALSE, vec_size(x))
+}

R/weekday.R

@@ -489,6 +489,31 @@ add_days.clock_weekday <- function(x, n, ...) {
 
 # ------------------------------------------------------------------------------
 
+#' @export
+vec_math.clock_weekday <- function(.fn, .x, ...) {
+  switch(
+    .fn,
+    is.nan = weekday_is_nan(.x),
+    is.finite = weekday_is_finite(.x),
+    is.infinite = weekday_is_infinite(.x),
+    NextMethod()
+  )
+}
+
+weekday_is_nan <- function(x) {
+  vec_rep(FALSE, vec_size(x))
+}
+
+weekday_is_finite <- function(x) {
+  !vec_equal_na(x)
+}
+
+weekday_is_infinite <- function(x) {
+  vec_rep(FALSE, vec_size(x))
+}
+
+# ------------------------------------------------------------------------------
+
 validate_encoding <- function(encoding) {
   if (!is_string(encoding, string = c("western", "iso"))) {
     abort("`encoding` must be one of \"western\" or \"iso\".")

tests/testthat/test-duration.R

@@ -279,3 +279,21 @@ test_that("precision: can get the precision", {
 test_that("precision: can only be called on durations", {
   expect_snapshot_error(duration_precision(sys_days(0)))
 })
+
+# ------------------------------------------------------------------------------
+# vec_math()
+
+test_that("is.nan() works", {
+  x <- duration_years(c(1, NA))
+  expect_identical(is.nan(x), c(FALSE, FALSE))
+})
+
+test_that("is.finite() works", {
+  x <- duration_years(c(1, NA))
+  expect_identical(is.finite(x), c(TRUE, FALSE))
+})
+
+test_that("is.infinite() works", {
+  x <- duration_years(c(1, NA))
+  expect_identical(is.infinite(x), c(FALSE, FALSE))
+})

tests/testthat/test-gregorian-year-day.R

@@ -335,3 +335,21 @@ test_that("throws known classed error", {
   expect_snapshot_error(invalid_resolve(year_day(2019, 366)))
   expect_error(invalid_resolve(year_day(2019, 366)), class = "clock_error_invalid_date")
 })
+
+# ------------------------------------------------------------------------------
+# vec_math()
+
+test_that("is.nan() works", {
+  x <- year_day(c(2019, NA))
+  expect_identical(is.nan(x), c(FALSE, FALSE))
+})
+
+test_that("is.finite() works", {
+  x <- year_day(c(2019, NA))
+  expect_identical(is.finite(x), c(TRUE, FALSE))
+})
+
+test_that("is.infinite() works", {
+  x <- year_day(c(2019, NA))
+  expect_identical(is.infinite(x), c(FALSE, FALSE))
+})

tests/testthat/test-gregorian-year-month-day.R

@@ -566,3 +566,21 @@ test_that("throws known classed error", {
   expect_snapshot_error(invalid_resolve(year_month_day(2019, 2, 31)))
   expect_error(invalid_resolve(year_month_day(2019, 2, 31)), class = "clock_error_invalid_date")
 })
+
+# ------------------------------------------------------------------------------
+# vec_math()
+
+test_that("is.nan() works", {
+  x <- year_month_day(c(2019, NA))
+  expect_identical(is.nan(x), c(FALSE, FALSE))
+})
+
+test_that("is.finite() works", {
+  x <- year_month_day(c(2019, NA))
+  expect_identical(is.finite(x), c(TRUE, FALSE))
+})
+
+test_that("is.infinite() works", {
+  x <- year_month_day(c(2019, NA))
+  expect_identical(is.infinite(x), c(FALSE, FALSE))
+})

tests/testthat/test-gregorian-year-month-weekday.R

@@ -247,3 +247,21 @@ test_that("strict mode can be activated", {
   local_options(clock.strict = TRUE)
   expect_snapshot_error(invalid_resolve(year_month_weekday(2019, 1, 1, 1)))
 })
+
+# ------------------------------------------------------------------------------
+# vec_math()
+
+test_that("is.nan() works", {
+  x <- year_month_weekday(c(2019, NA))
+  expect_identical(is.nan(x), c(FALSE, FALSE))
+})
+
+test_that("is.finite() works", {
+  x <- year_month_weekday(c(2019, NA))
+  expect_identical(is.finite(x), c(TRUE, FALSE))
+})
+
+test_that("is.infinite() works", {
+  x <- year_month_weekday(c(2019, NA))
+  expect_identical(is.infinite(x), c(FALSE, FALSE))
+})

tests/testthat/test-iso-year-week-day.R

@@ -223,3 +223,21 @@ test_that("strict mode can be activated", {
   local_options(clock.strict = TRUE)
   expect_snapshot_error(invalid_resolve(iso_year_week_day(2019, 1)))
 })
+
+# ------------------------------------------------------------------------------
+# vec_math()
+
+test_that("is.nan() works", {
+  x <- iso_year_week_day(c(2019, NA))
+  expect_identical(is.nan(x), c(FALSE, FALSE))
+})
+
+test_that("is.finite() works", {
+  x <- iso_year_week_day(c(2019, NA))
+  expect_identical(is.finite(x), c(TRUE, FALSE))
+})
+
+test_that("is.infinite() works", {
+  x <- iso_year_week_day(c(2019, NA))
+  expect_identical(is.infinite(x), c(FALSE, FALSE))
+})

tests/testthat/test-naive-time.R

@@ -584,3 +584,21 @@ test_that("ptype is correct", {
     expect_identical(vec_ptype(x), expect)
   }
 })
+
+# ------------------------------------------------------------------------------
+# vec_math()
+
+test_that("is.nan() works", {
+  x <- naive_days(c(2019, NA))
+  expect_identical(is.nan(x), c(FALSE, FALSE))
+})
+
+test_that("is.finite() works", {
+  x <- naive_days(c(2019, NA))
+  expect_identical(is.finite(x), c(TRUE, FALSE))
+})
+
+test_that("is.infinite() works", {
+  x <- naive_days(c(2019, NA))
+  expect_identical(is.infinite(x), c(FALSE, FALSE))
+})