tests/testthat/test-as-tidyped.R

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

# test-as-tidyped.R
# Tests for as_tidyped(), ensure_tidyped(), and S3 class recovery

test_that("as_tidyped restores class after rbind", {
  tp <- tidyped(simple_ped)
  tp2 <- rbind(tp[1:5], tp[6:10])

  expect_false(inherits(tp2, "tidyped"))
  expect_true(inherits(tp2, "data.table"))

  tp3 <- as_tidyped(tp2)
  expect_s3_class(tp3, "tidyped")
  expect_s3_class(tp3, "data.table")
})

test_that("as_tidyped restores class from plain data.frame", {
  tp <- tidyped(simple_ped)
  tp_df <- as.data.frame(tp)
  tp_sub <- tp_df[tp_df$Gen > 1, ]

  expect_false(inherits(tp_sub, "tidyped"))
  expect_false(inherits(tp_sub, "data.table"))

  tp_restored <- as_tidyped(tp_sub)
  expect_s3_class(tp_restored, "tidyped")
  expect_s3_class(tp_restored, "data.table")
})

test_that("as_tidyped rebuilds IndNum after rbind with overlapping indices", {

  tp <- tidyped(simple_ped)
  # rbind two slices that have overlapping IndNum values
  tp2 <- rbind(tp[1:5], tp[6:10])
  tp3 <- as_tidyped(tp2)

  # IndNum must be sequential 1:nrow

  expect_equal(tp3$IndNum, seq_len(nrow(tp3)))

  # SireNum/DamNum must reference valid IndNum or be 0
  valid_range <- c(0L, tp3$IndNum)
  expect_true(all(tp3$SireNum %in% valid_range))
  expect_true(all(tp3$DamNum %in% valid_range))
})

test_that("as_tidyped rebuilds IndNum from data.frame subset", {
  tp <- tidyped(simple_ped)
  tp_df <- as.data.frame(tp)
  tp_sub <- tp_df[tp_df$Gen > 1, ]
  tp_restored <- as_tidyped(tp_sub)

  expect_equal(tp_restored$IndNum, seq_len(nrow(tp_restored)))
  expect_true(all(tp_restored$SireNum >= 0L))
  expect_true(all(tp_restored$DamNum >= 0L))

  # SireNum should correctly map to Ind in restored object
  for (i in seq_len(nrow(tp_restored))) {
    if (tp_restored$SireNum[i] > 0L) {
      expect_equal(
        tp_restored$Ind[tp_restored$SireNum[i]],
        tp_restored$Sire[i]
      )
    }
    if (tp_restored$DamNum[i] > 0L) {
      expect_equal(
        tp_restored$Ind[tp_restored$DamNum[i]],
        tp_restored$Dam[i]
      )
    }
  }
})

test_that("as_tidyped is a no-op on valid tidyped", {
  tp <- tidyped(simple_ped)
  tp2 <- as_tidyped(tp)

  expect_identical(tp, tp2)
})

test_that("as_tidyped errors on missing core columns", {
  df <- data.frame(Ind = c("A", "B"), Sire = c(NA, "A"))

  expect_error(as_tidyped(df), "Missing columns")
})

test_that("as_tidyped errors on non-data.frame input", {
  expect_error(as_tidyped(1:10), "not a data.frame")
  expect_error(as_tidyped("abc"), "not a data.frame")
})

test_that("ensure_tidyped auto-recovers with message", {
  tp <- tidyped(simple_ped)
  tp2 <- rbind(tp[1:5], tp[6:10])

  expect_message(
    tp3 <- ensure_tidyped(tp2),
    "Restoring automatically"
  )
  expect_s3_class(tp3, "tidyped")
  expect_equal(tp3$IndNum, seq_len(nrow(tp3)))
})

test_that("ensure_tidyped is silent on valid tidyped", {
  tp <- tidyped(simple_ped)
  expect_silent(tp2 <- ensure_tidyped(tp))
  expect_identical(tp, tp2)
})

test_that("ensure_tidyped errors on non-data.frame", {
  expect_error(ensure_tidyped(1:10), "tidyped object")
})

test_that("ensure_tidyped errors on missing core columns", {
  df <- data.frame(Ind = c("A", "B"), Sire = c(NA, "A"))
  expect_error(ensure_tidyped(df), "tidyped object")
})

test_that("analysis functions work after class loss via rbind", {
  tp <- tidyped(simple_ped)
  tp2 <- rbind(tp[1:10], tp[11:20])

  # pedstats should auto-recover and work
  expect_message(
    stats <- pedstats(tp2),
    "Restoring automatically"
  )
  expect_s3_class(stats, "pedstats")
  expect_true(is_tidyped(tp2))

  # pedecg should then work on the already-restored object
  expect_silent(ecg <- pedecg(tp2))
  expect_true(is.data.table(ecg))
  expect_true("ECG" %in% names(ecg))
})

test_that("splitped works after class loss", {
  tp <- tidyped(small_ped)
  tp2 <- data.table::as.data.table(tp)
  class(tp2) <- c("data.table", "data.frame")  # strip tidyped class

  expect_message(
    result <- splitped(tp2),
    "Restoring automatically"
  )
  expect_s3_class(result, "splitped")
})

test_that("inbreed works after class loss", {
  tp <- tidyped(simple_ped)
  tp2 <- data.table::as.data.table(tp)
  class(tp2) <- c("data.table", "data.frame")  # strip tidyped class

  expect_message(
    result <- inbreed(tp2),
    "Restoring automatically"
  )
  expect_s3_class(result, "tidyped")
  expect_true("f" %in% names(result))
})