tests/testthat/test_summary.nprcgenekeeprErr.R

In nprcgenekeepr: Genetic Tools for Colony Management

#' Copyright(c) 2017-2024 R. Mark Sharp
# This file is part of nprcgenekeepr
context("summary.nprcgenekeeprErr")
library(testthat)
library(stringi)

pedOne <- nprcgenekeepr::pedOne
test_that("summary.nprcgenekeeprErr provides expected classes of output", {
  expect_type(summary(qcStudbook(pedOne, reportErrors = TRUE))$txt,
    "character"
  )
  expect_s3_class(summary(qcStudbook(pedOne, reportErrors = TRUE))$sp,
    "data.frame"
  )
})
test_that("summary.nprcgenekeeprErr provides expected output", {
  expect_length(summary(qcStudbook(pedOne,
                                             reportErrors = TRUE))$txt, 1L)
  expect_identical(nrow(summary(qcStudbook(pedOne,
                                           reportErrors = TRUE))$sp), 3L)
  expect_identical(stri_count_regex(
    summary(qcStudbook(pedOne, reportChanges = TRUE, reportErrors = TRUE))$txt,
    "\\n"
  ), 9L)
  pedTwo <- pedOne
  pedTwo$sex <- NULL
  expect_true(stri_detect_regex(
    summary(qcStudbook(pedTwo, reportChanges = TRUE, reportErrors = TRUE))$txt,
    pattern =
      "sex.\\n The required columns are: id, sire, dam, sex, and birth"
  ))
  pedTwo <- pedOne
  pedTwo$birth_date <- "badDate"
  expect_true(stri_detect_regex(
    summary(qcStudbook(pedTwo, reportChanges = TRUE, reportErrors = TRUE))$txt,
    pattern = stri_c(
      "There are 8 rows having an invalid date. ",
      "The first five records having bad dates are ",
      "on rows 1, 2, 3, 4, and 5."
    )
  ))
})
test_that(
  "summary.nprcgenekeeprErr identifies individual bad dates in date columns",
  {
    birth <- format(pedOne$birth_date, format = "%Y-%m-%d")
    birth[5L] <- "04-02-2015"
    birth[6L] <- "03-17-2009"
    pedEight <- pedOne
    pedEight$birth_date <- NULL
    pedEight$birth <- birth
    ped8 <- qcStudbook(pedEight, minParentAge = NULL, reportErrors = TRUE)
    summary(ped8)
    expect_true(stri_detect_fixed(
      summary(ped8)$txt,
      "rows having an invalid date are: 5 and 6"
    ))
  }
)
test_that("summary.nprcgenekeeprErr identifies bad database connection", {
  birth <- format(pedOne$birth_date, format = "%Y-%m-%d")
  birth[5L] <- "04-02-2015"
  birth[6L] <- "03-17-2009"
  pedEight <- pedOne
  pedEight$birth_date <- NULL
  pedEight$birth <- birth
  ped8 <- qcStudbook(pedEight, minParentAge = NULL, reportErrors = TRUE)
  ped8$failedDatabaseConnection <-
    "Database connection failed: configuration or permissions are invalid."
  summary(ped8)
  expect_true(stri_detect_fixed(
    summary(ped8)$txt,
    "Database connection failed"
  ))
})