Handle recycling and add tests for missingness in get_age() (#34)

* Handle recycling and add tests for missingness

* typo

* lint implicit integers

* even more whitespace

NEWS.md

@@ -3,6 +3,7 @@
  * `get_age()` gives the right age in some cases, e.g. 7 1/366 years for someone born Dec. 22, 2024 as of Dec. 23, 2031 (#23). Accuracy is now confirmed for a full grid of >2 million possible birthday, age combinations.
  * `get_age()` implementation is improved for about 2x speed-up. This was in service of making the implementation friendlier for static translation to other execution engines (in particular {arrow}, #18). Thanks @TPDeramus for the request and @jonkeane for consulting on acero particulars.
  * `get_age()` doesn't require its input to be `Date` as long as `as.Date()` succeeds, for convenience in quick examples like `get_age('2003-02-04', '2008-12-30')`.
+ * `get_age()` supports recycling of one length-1 input and handles missing values in either argument.
 
 ### v0.2.2
 

R/utils.R

@@ -165,6 +165,20 @@ stale_package_check = function(con) {
 
 # Accurately calculate fractional age, quickly
 get_age <- function(birthdays, ref_dates) {
+  if (length(birthdays) != length(ref_dates)) {
+    if (length(birthdays) == 1L) {
+      birthdays = rep(birthdays, length(ref_dates))
+    } else if (length(ref_dates) == 1L) {
+      ref_dates = rep(ref_dates, length(birthdays))
+    } else {
+      stop(sprintf(
+        "'birthdays' and 'ref_dates' must have equal length or one be a scalar, but got respective lengths %d and %d",
+        length(birthdays), length(ref_dates)
+      ))
+    }
+  }
+  if (!length(birthdays)) return(numeric())
+
   if (!inherits(birthdays, "Date")) birthdays = as.Date(birthdays)
   if (!inherits(ref_dates, "Date")) ref_dates = as.Date(ref_dates)
 

tests/testthat/test-utils.R

@@ -91,7 +91,8 @@ test_that('get_age works', {
     "2007-03-18", "2007-03-19", "2007-03-20",
     "1968-02-29", "1968-02-29", "1968-02-29",
     "2024-12-22", "2025-03-01", "2026-03-01",
-    "2027-03-01", NA_character_,
+    "2027-03-01",
+    NA_character_, Sys.Date(), NA_character_,
     NULL
   ))
   given_date = as.Date(c(
@@ -101,7 +102,8 @@ test_that('get_age works', {
     "2008-03-19", "2008-03-19", "2008-03-19",
     "2015-02-28", "2015-03-01", "2015-03-02",
     "2031-12-23", "2028-12-22", "2029-03-02",
-    "2030-03-02", Sys.Date(),
+    "2030-03-02",
+    Sys.Date(), NA_character_, NA_character_,
     NULL
   ))
   expect_identical(
@@ -130,7 +132,8 @@ test_that('get_age works', {
       3.0 + 296.0/365.0, # 365 days until 2029-03-01, not 366 (#26)
       3.0 + 1.0/365.0, # 365 days until 2030-03-01, not 366 (#28)
       3.0 + 1.0/365.0, # 365 days until 2031-03-02, not 366 (#30)
-      NA_real_,
+
+      NA_real_, NA_real_, NA_real_,
       NULL
     )
   )
@@ -150,6 +153,12 @@ test_that('get_age works', {
   expect_identical(get_age(as.POSIXct(bday), as.POSIXct(tday)), get_age(bday, tday))
   expect_identical(get_age(as.POSIXct(bday), tday), get_age(bday, tday))
   expect_identical(get_age(bday, as.POSIXct(tday)), get_age(bday, tday))
+
+  # Input validation: lengths & recycling
+  expect_identical(get_age(c('2023-01-01', '2024-01-01'), '2025-01-01'), c(2.0, 1.0))
+  expect_identical(get_age('2023-01-01', c('2024-01-01', '2025-01-01')), c(1.0, 2.0))
+  expect_identical(get_age(numeric(), numeric()), numeric())
+  expect_error(get_age(numeric(3L), numeric(4L)), "must have equal length")
 })
 
 test_that('create_quantiles works', {