tests/testthat/test_convertDate.R

In nprcgenekeepr: Genetic Tools for Colony Management

#' Copyright(c) 2017-2024 R. Mark Sharp
#' This file is part of nprcgenekeepr
context("convertDate")
library(lubridate)
set_seed(10L)
someBirthDates <- paste0(
  sample(seq(0L, 15L, by = 3L), 10L, replace = TRUE) + 2000L,
  "-", sample(1L:12L, 10L, replace = TRUE), "-",
  sample(1L:28L, 10L, replace = TRUE)
)
someBadBirthDates <- paste0(
  sample(1L:12L, 10L, replace = TRUE), "-",
  sample(1L:28L, 10L, replace = TRUE), "-",
  sample(seq(0L, 15L, by = 3L), 10L, replace = TRUE) + 2000L
)
someDeathDates <- sample(someBirthDates, length(someBirthDates),
  replace = FALSE
)
someDepartureDates <- sample(someBirthDates, length(someBirthDates),
  replace = FALSE
)
ped1 <- data.frame(
  birth = someBadBirthDates, death = someDeathDates,
  departure = someDepartureDates
)
someDates <- ymd(someBirthDates)
ped2 <- data.frame(
  birth = someDates, death = someDeathDates,
  departure = someDepartureDates
)
ped3 <- data.frame(
  birth = someBirthDates, death = someDeathDates,
  departure = someDepartureDates
)
someNADeathDates <- someDeathDates
someNADeathDates[c(1L, 3L, 5L)] <- ""
someNABirthDates <- someDates
someNABirthDates[c(2L, 4L, 6L)] <- NA
ped4 <- data.frame(
  birth = someNABirthDates, death = someNADeathDates,
  departure = someDepartureDates
)

test_that("convertDate identifies bad dates", {
  expect_error(convertDate(ped1))
})
test_that("convertDate with error flag returns error list", {
  expect_equal(
    convertDate(ped1, reportErrors = TRUE),
    c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10")
  )
})
test_that("convertDate likes good dates", {
  expect_true(all(is.Date(convertDate(ped2)$birth)))
  expect_true(all(is.Date(convertDate(ped3)$birth)))
})
test_that("convertDate with error flag returns NULL with good dates", {
  expect_true(all(is.null(convertDate(ped2, reportErrors = TRUE))))
  expect_true(all(is.null(convertDate(ped3, reportErrors = TRUE))))
})
test_that(paste0(
  "convertDate handles NA and empty character string values ",
  "correctly"
), {
  expect_null(convertDate(ped4, reportErrors = TRUE))
})
test_that("convertDate ignores added records", {
  ped5 <- cbind(ped4,
    recordStatus = c(rep("added", 10L)),
    stringsAsFactors = FALSE
  )
  expect_identical(nrow(convertDate(ped5)), 10L)
  expect_true(all(convertDate(ped5)$recordStatus == "added"))
})
test_that("convertDate fails when date column class is real", {
  ped5 <- ped3
  ped5$birth <- rnorm(10L, 10L, 100L)
  expect_error(convertDate(ped5))
})

ped <- nprcgenekeepr::pedInvalidDates
rowsWithBadDates <- convertDate(ped, reportErrors = TRUE)
test_that("classifies dates <= 1000 CE as errors", {
  expect_true(any(3L %in% rowsWithBadDates))
})
pedWithNAs <- ped
pedWithNAs[, "birth"] <- as.Date(pedWithNAs[, "birth"], origin = "1970-01-01")

pedWithNAs <- convertDate(pedWithNAs, reportErrors = FALSE)
test_that("classifies dates <= 1000 CE as errors", {
  expect_true(all(is.na(pedWithNAs[3L:4L, "birth"])))
})