Removed lubridate dependency entirely by creating the is_date functio…

…n and adjusting calc_age.

Fixed an error in calc_age due to the approximation approach it took. Would lead to odd results over time due to leap years and dividing by 365.25. Now looks directly at years, months, days and compared.

Specifically uses importFrom for dependencies now across other functions for clarity.

NAMESPACE

@@ -12,11 +12,12 @@ export(classify_pairs)
 export(convert_csv_to_pqt)
 export(generate_pairs)
 export(get_time_stamp)
+export(is_date)
 export(round_nearest)
 export(round_number)
-import(RecordLinkage)
+importFrom(RecordLinkage,RLBigDataLinkage)
+importFrom(RecordLinkage,epiWeights)
 importFrom(arrow,write_parquet)
 importFrom(janitor,clean_names)
 importFrom(readr,col_character)
-importFrom(readr,cols)
 importFrom(vroom,vroom)

R/calc_age.R

@@ -16,16 +16,22 @@
 calc_age <- function (birth_date, to_date = Sys.Date(), freq = years,
                       set_negative_na = FALSE, warn = FALSE) {
 
-  if (!is.Date(birth_date)) stop ("birth_date must be a date")
-  if (!is.Date(to_date)) stop ("to_date must be a date")
+  if (!is_date(birth_date)) stop ("birth_date must be a date")
+  if (!is_date(to_date)) stop ("to_date must be a date")
 
   if (length(to_date) != length(birth_date) & length(to_date) != 1) {
 
     stop ("to_date must be length 1 or same length as birth date")
 
   }
 
-  ages <- trunc((birth_date %--% to_date) / freq(1))
+  posixlt_to_date <- as.POSIXlt(to_date)
+  posixlt_birth_date <- as.POSIXlt(birth_date)
+
+  ages <- posixlt_to_date$year - posixlt_birth_date$year -
+          ((posixlt_to_date$mon < posixlt_birth_date$mon) |
+           ((posixlt_to_date$mon == posixlt_birth_date$mon) &
+            (posixlt_to_date$mday < posixlt_birth_date$mday)))
 
   bad_birth_dates <- birth_date[birth_date > to_date]
 

R/convert_csv_to_pqt.R

@@ -15,7 +15,6 @@
 #' @importFrom vroom vroom
 #' @importFrom arrow write_parquet
 #' @importFrom janitor clean_names
-#' @importFrom readr cols
 #' @importFrom readr col_character
 #'
 #' @examples

R/is_date.R

@@ -0,0 +1,15 @@
+
+#' Is Date
+#'
+#' Determine if an object is a date
+#'
+#' @param x object to test, probably a vector.
+#'
+#' @return TRUE or FALSE
+#' @export
+
+is_date <- function (x) {
+
+  class(x) == "Date"
+
+}

R/record-linkage.R

@@ -19,7 +19,7 @@
 #' df2 <- data.frame(name = c("Jon", "Janet"), age = c(26, 31))
 #' pairs <- generate_pairs(df1, df2, excluded_cols = c("age"))
 #'
-#' @import RecordLinkage
+#' @importFrom RecordLinkage RLBigDataLinkage epiWeights
 #' @export
 
 generate_pairs <- function (df1, df2, exclude = numeric(0), blockfld = list()) {
@@ -56,7 +56,6 @@ generate_pairs <- function (df1, df2, exclude = numeric(0), blockfld = list()) {
 #' # Example usage
 #' classified_pairs <- classify_pairs(pairs, lower_threshold = 0.6, upper_threshold = 0.85)
 #'
-#' @import RecordLinkage
 #' @export
 
 classify_pairs <- function(pairs, lower_threshold = 0.6,

tests/testthat/test-calc_age.R

@@ -0,0 +1,54 @@
+
+test_that("calc_age works", {
+
+  # Ages work
+
+  expect_equal(calc_age(birth_date = as.Date("2022-07-01"),
+                        to_date = as.Date("2023-03-01")),
+               0)
+
+  expect_equal(calc_age(birth_date = as.Date("2013-03-01"),
+                        to_date = as.Date("2023-03-01")),
+               10)
+
+  expect_equal(calc_age(birth_date = as.Date("2013-03-02"),
+                        to_date = as.Date("2023-03-01")),
+               9)
+
+  # An unusual case that would be wrong if we took an approximation approach
+  # and was wrong in an old version of the function
+
+  expect_equal(calc_age(as.Date("2000-03-01"), as.Date("2021-02-28")), 20)
+
+  # Multiple ages work
+
+  birth_dates <- as.Date(c("2022-07-01", "2013-03-01", "2013-03-02"))
+  to_dates <- as.Date(c("2023-03-01", "2022-03-01", "2021-01-01"))
+
+  expect_equal(calc_age(birth_dates, to_dates), c(0, 9, 7))
+  expect_equal(calc_age(birth_dates, as.Date("2023-03-01")), c(0, 10, 9))
+
+  # Bad input types fail
+
+  expect_error(calc_age(birth_date = data.frame(as.Date("2013-03-02")),
+                        to_date = as.Date("2023-03-01")))
+
+  expect_error(calc_age(birth_date = as.Date("2013-03-02"),
+                        to_date = data.frame(as.Date("2023-03-01"))))
+
+  # if to_date not length 1 or length = length birth date then gives errors
+
+  expect_error(calc_age(birth_dates, to_dates[-3]))
+
+  # to_date < birth_date gives warnings and returns NA
+
+  birth_dates[1] <- as.Date("2024-01-01")
+  expect_warning(calc_age(birth_dates, to_dates, warn = TRUE))
+
+  expect_equal(
+    calc_age(birth_dates, to_dates, set_negative_na = TRUE), c(NA, 9, 7)
+  )
+
+
+
+})