tests/testthat/test-tidyped-alignment.R

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

library(testthat)
library(data.table)

# Load package functions if not available
# if (!exists("tidyped")) {
#   devtools::load_all()
# }

test_that("Mate Alignment: Push Down Logic (pmax)", {
  # Case 1: Founder (F) mates with Descendant (D) at Gen 3.
  # A -> B -> D
  # F -> D (F is valid parent of D? No, F and D are mates? No wait)
  # Correction: Mate alignment is about optimizing shared children.
  # If A and B are parents of C.
  # A is Gen 1 (Founder).
  # B is Gen 3 (Child of ...).
  # C is Gen 4.
  # Old Logic (pmin): Pull B up to Gen 1. 
  #   -> If B has parents at Gen 2, B(1) < Parents(2) -> ERROR.
  # New Logic (pmax): Push A down to Gen 3.
  #   -> A(3), B(3), C(4). OK.
  
  ped <- data.table(
    Ind  = c("G1", "G2", "G3", "F_Mate", "Kind"),
    Sire = c(NA,   "G1", "G2", NA,       "G3"),     # G1 -> G2 -> G3. F_Mate x G3 -> Kind
    Dam  = c(NA,   NA,   NA,   NA,       "F_Mate")
  )
  
  # Expected generations (bottom-up or top-down, let's use bottom)
  # Bottom-up tends to push things deep.
  # Initial calculation:
  # G1 (Gen 1 or similar distance from bottom)
  # Kind is leaf.
  
  # Let's inspect generations directly.
  # G1 (Gen 1)
  # G2 (Gen 2)
  # G3 (Gen 3)
  # F_Mate (Gen 1 initially if treated as founder)
  # Kind (Gen 4)
  
  res <- tidyped(ped, genmethod = "bottom")
  setkey(res, Ind)
  
  # Check Baseline Generations
  expect_gt(res["G3", Gen], res["G2", Gen])
  expect_gt(res["G2", Gen], res["G1", Gen])
  
  # Check Mate Alignment
  # F_Mate should be aligned with G3
  expect_equal(res["F_Mate", Gen], res["G3", Gen], 
               info = "Founder Mate should be pushed down to Spouse's generation")
  
  # Check Topology
  # Kind must be > Parents
  expect_gt(res["Kind", Gen], res["F_Mate", Gen])
  expect_gt(res["Kind", Gen], res["G3", Gen])
})


test_that("Mate Alignment: Topological Constraint (Block Push)", {
  # Case 2: Founder (F) mates with G3 (Deep).
  # But F ALREADY has a child C at Gen 2.
  # If we push F to Gen 3 (to match G3), F(3) > C(2). VIOLATION.
  # Logic should block the push. F stays at 1.
  
  ped <- data.table(
    Ind  = c("G1", "G2", "G3", "F", "C", "Kind"),
    Sire = c(NA,   "G1", "G2", NA,  NA,  "G3"),
    Dam  = c(NA,   NA,   NA,   NA,  "F", "F") 
  )
  # Relationships:
  # G1 -> G2 -> G3
  # F -> C (F is parent of C)
  # G3 x F -> Kind (F is parent of Kind)
  
  # Initial Gen estimate:
  # G1: 1
  # G2: 2
  # G3: 3
  # F: 1 (Founder)
  # C: 2 (Child of F)
  # Kind: 4 (Child of G3(3) and F(1/3?))
  
  # Conflict:
  # Mate Alignment wants F and G3 to be same Gen.
  # G3 is Gen 3.
  # F ideal is Gen 3.
  # But F has child C at Gen 2.
  # F cannot be >= C. F must be < C.
  # F max valid Gen is 1 (if C is 2).
  # Result: F stays at 1. G3 stays at 3.
  
  res <- tidyped(ped, genmethod = "top")
  setkey(res, Ind)
  
  # F should NOT be pushed to 3
  expect_lt(res["F", Gen], res["C", Gen])
  expect_equal(res["F", Gen], 1, info = "F constrained to Gen 1 by child C")
  expect_equal(res["G3", Gen], 3, info = "G3 remains at Gen 3")
  
  # Mates are misaligned
  expect_true(res["F", Gen] != res["G3", Gen], info = "Mates remain misaligned due to constraints")
})

test_that("Reproduce Bug with Parents X, U, V", {
  # The small_ped bug.
  # X (Child) was Gen 1. U,V (Parents) were Gen 4.
  # Fixed logic should ensure X > U, V.
  
  # Load real simplified data if possible, or mock it closely.
  # The bug was triggered by X mating with a founder or similar.
  # Mock:
  # U(4) x V(4) -> X(5)
  # X(5) x N(1) -> Offspring
  # Old Bug: N(1) pulls X to 1.
  # New Fix: X(5) pushes N to 5.
  
  ped <- data.table(
    Ind = c("U", "V", "X", "N", "O"),
    Sire = c(NA, NA, "U", "X", "X"), # U->X, X->O
    Dam = c(NA, NA, "V", "N", "N"),  # V->X, N->O
    GenInit = c(4, 4, 5, 1, 6) # Simulated initial state or structural implication
  )
  # We provide structure, tidyped calculates Gen.
  # We need depth for U,V to be 4.
  # Chain: G1->G2->G3->U
  
  ped_chain <- data.table(
    Ind = c("A","B","C","U", "V", "X", "N", "O"),
    Sire = c(NA,"A","B","C", NA,  "U", NA,  "X"),
    Dam =  c(NA,NA,NA, NA,  NA,  "V", NA,  "N")
  )
  # A(1)->B(2)->C(3)->U(4).
  # V(1/4?) - lets assume V is deep or aligned.
  # X(5) from U(4).
  # N(1).
  # O(6) from X(5)xN(1).
  
  res <- tidyped(ped_chain, genmethod = "bottom")
  setkey(res, Ind)
  
  # Check X vs U
  expect_gt(res["X", Gen], res["U", Gen])
  
  # Check Mate Alignment (X and N)
  # X is 5 (approx). N should be pushed to 5.
  expect_equal(res["N", Gen], res["X", Gen], info = "Founder N aligned to Mate X")
})