tests/testthat/test-selfing.R

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

# Tests for selfing support (Issue #10: plant breeding monoecious pedigrees)

test_that("selfing parameter validation", {
  skip_if_not_installed("visPedigree")
  
  ped <- data.frame(
    Ind = c("A", "B", "C"),
    Sire = c(NA, NA, "A"),
    Dam = c(NA, NA, "B")
  )
  
  # selfing must be logical

  expect_error(tidyped(ped, selfing = 1), "only is assigned using TRUE or FALSE")
  expect_error(tidyped(ped, selfing = "yes"), "only is assigned using TRUE or FALSE")
  
  # selfing = FALSE is default and works
  res <- tidyped(ped, selfing = FALSE)
  expect_s3_class(res, "tidyped")
})

test_that("selfing = TRUE allows same individual as both Sire and Dam", {
  skip_if_not_installed("visPedigree")
  
  # Simple selfing: A selfs to produce C
  ped <- data.frame(
    Ind = c("A", "B", "C"),
    Sire = c(NA, NA, "A"),
    Dam = c(NA, NA, "A"),  # A is both Sire and Dam
    stringsAsFactors = FALSE
  )
  
  # Should error without selfing
  expect_error(tidyped(ped), "Sex conflict detected")
  
  # Should succeed with selfing = TRUE
  expect_message(tidyped(ped, selfing = TRUE), "Selfing mode")
  res <- suppressMessages(tidyped(ped, selfing = TRUE))
  
  expect_s3_class(res, "tidyped")
  expect_equal(res[Ind == "A", Sex], "monoecious")
  expect_true(isTRUE(attr(res, "ped_meta")$selfing))
  expect_equal(attr(res, "ped_meta")$bisexual_parents, "A")
})

test_that("selfing with multiple monoecious individuals", {
  skip_if_not_installed("visPedigree")
  
  # Plant pedigree: P1 and P2 are both monoecious
  ped <- data.frame(
    Ind = c("P1", "P2", "C1", "C2", "C3"),
    Sire = c(NA, NA, "P1", "P2", "P1"),
    Dam = c(NA, NA, "P2", "P1", "P1"),  # P1 and P2 both appear as Sire and Dam
    stringsAsFactors = FALSE
  )
  
  res <- suppressMessages(tidyped(ped, selfing = TRUE))
  
  expect_equal(res[Ind == "P1", Sex], "monoecious")
  expect_equal(res[Ind == "P2", Sex], "monoecious")
  expect_equal(sort(attr(res, "ped_meta")$bisexual_parents), c("P1", "P2"))
})

test_that("selfing: non-monoecious individuals get normal sex inference", {
  skip_if_not_installed("visPedigree")
  
  # Mixed pedigree: P1 is monoecious, M1 is only a Sire, F1 is only a Dam
  ped <- data.frame(
    Ind = c("P1", "M1", "F1", "C1", "C2", "C3"),
    Sire = c(NA, NA, NA, "P1", "M1", "P1"),
    Dam = c(NA, NA, NA, "P1", "F1", "F1"),
    stringsAsFactors = FALSE
  )
  
  res <- suppressMessages(tidyped(ped, selfing = TRUE))
  
  expect_equal(res[Ind == "P1", Sex], "monoecious")
  expect_equal(res[Ind == "M1", Sex], "male")
  expect_equal(res[Ind == "F1", Sex], "female")
})

test_that("selfing: explicit sex annotation conflict for monoecious", {
  skip_if_not_installed("visPedigree")
  
  # A is both Sire and Dam but explicitly annotated as "male" -> should error
  ped <- data.frame(
    Ind = c("A", "B", "C"),
    Sire = c(NA, NA, "A"),
    Dam = c(NA, NA, "A"),
    Sex = c("male", NA, NA),
    stringsAsFactors = FALSE
  )
  
  expect_error(
    tidyped(ped, selfing = TRUE),
    "Sex annotation conflicts for monoecious"
  )
})

test_that("selfing: explicit monoecious annotation accepted", {
  skip_if_not_installed("visPedigree")
  
  # A is both Sire and Dam, explicitly annotated as "monoecious" -> should work
  ped <- data.frame(
    Ind = c("A", "B", "C"),
    Sire = c(NA, NA, "A"),
    Dam = c(NA, NA, "A"),
    Sex = c("monoecious", NA, NA),
    stringsAsFactors = FALSE
  )
  
  res <- suppressMessages(tidyped(ped, selfing = TRUE))
  expect_equal(res[Ind == "A", Sex], "monoecious")
})

test_that("selfing: summary statistics count monoecious correctly", {
  skip_if_not_installed("visPedigree")
  
  ped <- data.frame(
    Ind = c("P1", "P2", "M1", "C1", "C2"),
    Sire = c(NA, NA, NA, "P1", "M1"),
    Dam = c(NA, NA, NA, "P1", "P2"),
    stringsAsFactors = FALSE
  )
  
  res <- suppressMessages(tidyped(ped, selfing = TRUE))
  s <- summary(res)
  
  expect_equal(s$n_monoecious, 1)  # P1
  expect_equal(s$n_male, 1)        # M1
  expect_equal(s$n_female, 1)      # P2 (only Dam)
  
  # n_parents should deduplicate P1 (which is both sire and dam)
  # Sires: P1, M1 -> 2 unique sires
  # Dams: P1, P2 -> 2 unique dams
  # Parents (union): P1, M1, P2 -> 3 unique parents
  expect_equal(s$n_parents, 3)
})

test_that("selfing: true self-fertilization (Sire == Dam for offspring)", {
  skip_if_not_installed("visPedigree")
  
  # Self-fertilization: C1 has same Sire and Dam (A selfs)
  ped <- data.frame(
    Ind = c("A", "C1", "C2"),
    Sire = c(NA, "A", "A"),
    Dam = c(NA, "A", "A"),
    stringsAsFactors = FALSE
  )
  
  res <- suppressMessages(tidyped(ped, selfing = TRUE))
  
  expect_equal(res[Ind == "A", Sex], "monoecious")
  expect_equal(res[Ind == "C1", Sire], "A")
  expect_equal(res[Ind == "C1", Dam], "A")
  
  # Generation check: A is founder (Gen 1), C1/C2 are offspring (Gen 2)
  expect_equal(res[Ind == "A", Gen], 1L)
  expect_equal(res[Ind == "C1", Gen], 2L)
})

test_that("selfing: inbreeding coefficient computation works", {
  skip_if_not_installed("visPedigree")
  
  # Self-fertilization should produce inbred offspring (f = 0.5)
  ped <- data.frame(
    Ind = c("A", "C1"),
    Sire = c(NA, "A"),
    Dam = c(NA, "A"),
    stringsAsFactors = FALSE
  )
  
  res <- suppressMessages(tidyped(ped, selfing = TRUE, inbreed = TRUE))
  
  expect_equal(res[Ind == "A", f], 0, tolerance = 1e-10)
  expect_equal(res[Ind == "C1", f], 0.5, tolerance = 1e-10)
})

test_that("selfing: multi-generation plant pedigree", {
  skip_if_not_installed("visPedigree")
  
  # Simulate a realistic plant breeding scenario:
  # P1 x P2 -> F1
  # F1 selfs -> F2_1, F2_2
  # F2_1 selfs -> F3
  ped <- data.frame(
    Ind =  c("P1", "P2", "F1", "F2_1", "F2_2", "F3"),
    Sire = c(NA,   NA,   "P1", "F1",   "F1",   "F2_1"),
    Dam =  c(NA,   NA,   "P2", "F1",   "F1",   "F2_1"),
    stringsAsFactors = FALSE
  )
  
  res <- suppressMessages(tidyped(ped, selfing = TRUE, inbreed = TRUE))
  
  # F1 is monoecious (appears as both Sire and Dam)
  expect_equal(res[Ind == "F1", Sex], "monoecious")
  # F2_1 is monoecious (appears as both Sire and Dam for F3)
  expect_equal(res[Ind == "F2_1", Sex], "monoecious")
  # P1 is only sire -> male
  expect_equal(res[Ind == "P1", Sex], "male")
  # P2 is only dam -> female
  expect_equal(res[Ind == "P2", Sex], "female")
  
  # Generation structure
  expect_equal(res[Ind == "P1", Gen], 1L)
  expect_equal(res[Ind == "F1", Gen], 2L)
  expect_equal(res[Ind == "F2_1", Gen], 3L)
  expect_equal(res[Ind == "F3", Gen], 4L)
  
  # Inbreeding: F2_1 and F2_2 from selfing F1, f = 0.5
  expect_equal(res[Ind == "F2_1", f], 0.5, tolerance = 1e-10)
  # F3 from selfing F2_1 (which itself has f=0.5), f = 0.75
  expect_equal(res[Ind == "F3", f], 0.75, tolerance = 1e-10)
})

test_that("selfing: splitped propagates selfing attribute", {
  skip_if_not_installed("visPedigree")
  
  # Two disconnected groups, one with selfing
  ped <- data.frame(
    Ind =  c("A", "C1", "X", "Y", "Z"),
    Sire = c(NA,  "A",  NA,  "X", NA),
    Dam =  c(NA,  "A",  NA,  NA,  NA),
    stringsAsFactors = FALSE
  )
  
  res <- suppressMessages(tidyped(ped, selfing = TRUE))
  expect_true(isTRUE(attr(res, "ped_meta")$selfing))
  
  # splitped should propagate selfing
  groups <- splitped(res)
  
  # Each group should be a valid tidyped
  for (gp in groups) {
    expect_s3_class(gp, "tidyped")
  }
})

test_that("selfing: selfing hint in error message when selfing = FALSE", {
  skip_if_not_installed("visPedigree")
  
  ped <- data.frame(
    Ind = c("A", "C"),
    Sire = c(NA, "A"),
    Dam = c(NA, "A"),
    stringsAsFactors = FALSE
  )
  
  expect_error(
    tidyped(ped, selfing = FALSE),
    "selfing = TRUE"
  )
})