tests/testthat/test-tidyped-workflows.R

In visPedigree: Tidying, Analysis, and Fast Visualization of Animal and Plant Pedigrees

library(testthat)
library(data.table)

test_that("[.tidyped degrades incomplete row subsets with warning", {
  ped <- data.table(
    Ind = c("A", "B", "C", "D"),
    Sire = c(NA, NA, "A", "C"),
    Dam = c(NA, NA, "B", "B"),
    Year = c(2000, 2000, 2005, 2006)
  )

  tp <- tidyped(ped)

  expect_warning(
    sub_dt <- tp[Year > 2005],
    "Subsetting removed parent records"
  )

  expect_identical(class(sub_dt), c("data.table", "data.frame"))
  expect_false(is_tidyped(sub_dt))
})

test_that("[.tidyped preserves complete pedigree subsets and rebuilds indices", {
  ped <- data.table(
    Ind = c("A", "B", "C", "D", "E", "F"),
    Sire = c(NA, NA, "A", NA, NA, "D"),
    Dam = c(NA, NA, "B", NA, NA, "E")
  )

  tp <- tidyped(ped)
  sub_tp <- tp[Ind %in% c("A", "B", "C")]

  expect_true(is_tidyped(sub_tp))
  expect_identical(sub_tp$IndNum, 1:3)
  expect_equal(sub_tp[Ind == "C", SireNum], sub_tp[Ind == "A", IndNum])
  expect_equal(sub_tp[Ind == "C", DamNum], sub_tp[Ind == "B", IndNum])
})

test_that(":= keeps tidyped class and metadata", {
  tp <- tidyped(simple_ped)

  tp[, phenotype := seq_len(.N)]

  expect_true(is_tidyped(tp))
  expect_true("phenotype" %in% names(tp))
  expect_identical(pedmeta(tp)$genmethod, "top")
})

test_that("tidyped fast path matches full tracing result", {
  tp_master <- tidyped(simple_ped)

  res_raw <- tidyped(simple_ped, cand = "J5X804", trace = "up", tracegen = 2)
  res_fast <- tidyped(tp_master, cand = "J5X804", trace = "up", tracegen = 2)

  expect_true(is_tidyped(res_fast))
  expect_true(has_candidates(res_fast))
  expect_equal(as.list(res_fast), as.list(res_raw))
  expect_equal(pedmeta(res_fast), pedmeta(res_raw))
})

test_that("fast path: cand works on tidyped created with addnum=FALSE (regression)", {
  # Regression: fast-path previously used IndNum which is absent when addnum=FALSE,
  # causing "None of the specified candidates were found" even for valid IDs.
  tp_no <- tidyped(simple_ped, addnum = FALSE, addgen = FALSE)
  expect_false("IndNum" %in% names(tp_no))

  # Must not error and must find the candidate
  res <- tidyped(tp_no, cand = "J5X804", trace = "up")
  expect_true(is_tidyped(res))
  expect_true(has_candidates(res))
  expect_true("J5X804" %in% res$Ind)
  expect_true(any(res$Cand))

  # addnum=FALSE: output must not contain integer index columns
  res_no <- tidyped(tp_no, cand = "J5X804", addnum = FALSE, addgen = FALSE)
  expect_false("IndNum"  %in% names(res_no))
  expect_false("SireNum" %in% names(res_no))
  expect_false("DamNum"  %in% names(res_no))

  # addnum=TRUE: output must contain integer index columns
  res_yes <- tidyped(tp_no, cand = "J5X804", addnum = TRUE)
  expect_true("IndNum"  %in% names(res_yes))
  expect_true("SireNum" %in% names(res_yes))
  expect_true("DamNum"  %in% names(res_yes))

  # Results must match a full-path trace from the raw pedigree
  res_ref <- tidyped(simple_ped, cand = "J5X804", trace = "up")
  expect_equal(sort(res_yes$Ind), sort(res_ref$Ind))
})

test_that("state accessors report tidyped contents correctly", {
  tp <- tidyped(simple_ped)
  tp_f <- inbreed(tp)
  tp_c <- tidyped(tp, cand = "J5X804", trace = "up")

  expect_true(is_tidyped(tp))
  expect_false(has_inbreeding(tp))
  expect_true(has_inbreeding(tp_f))
  expect_false(has_candidates(tp))
  expect_true(has_candidates(tp_c))
})

test_that("splitped returns objects while pedsubpop returns summary table", {
  ped <- data.table(
    Ind = c("A", "B", "C", "D", "E", "F", "G"),
    Sire = c(NA, NA, "A", "A", NA, NA, "E"),
    Dam = c(NA, NA, "B", "B", NA, NA, "F")
  )

  tp <- tidyped(ped)
  splits <- splitped(tp)
  stats <- pedsubpop(tp)

  expect_s3_class(splits, "splitped")
  expect_true(all(vapply(splits, is_tidyped, logical(1))))
  expect_s3_class(stats, "data.table")
  expect_false("subpop" %in% names(stats))
  expect_true(all(c("Group", "N", "N_Sire", "N_Dam", "N_Founder") %in% names(stats)))
})

test_that("completeness-sensitive analyses error on truncated subsets", {
  tp <- tidyped(simple_ped)

  expect_warning(
    tp_sub <- tp[Gen > 2],
    "Subsetting removed parent records"
  )

  expect_false(is_tidyped(tp_sub))

  expect_error(
    inbreed(tp_sub),
    "structurally complete pedigree"
  )

  expect_error(
    pedecg(tp_sub),
    "structurally complete pedigree"
  )

  expect_error(
    pedmat(tp_sub, method = "f"),
    "structurally complete pedigree"
  )
})