tests/testthat/test-kappa.R

In magnusdv/ribd: Pedigree-based Relatedness Coefficients

test_that("kappaIBD() deals sensibly with inbred individuals", {
  x = nuclearPed(1)
  founderInbreeding(x, 1:2) = 1
  # action = 0
  expect_identical(kappaIBD(x, 1:2, inbredAction = 0), rep(NA_real_, 3))

  # action = 1
  expect_identical(kappaIBD(x, 1:2, inbredAction = 1), rep(NA_real_, 3))
  expect_message(kappaIBD(x, 1:2, inbredAction = 1), "inbred")

  # action = 2
  expect_error(kappaIBD(x, 1:2, inbredAction = 2), "Kappa coefficients are only")

})

test_that("kappa allows for rounding errors in the detection of inbreeding", {
  x = nuclearPed(2)
  f1 = 0.1
  f2 = 0.2

  # Exact kappa for sibs
  f00 = (1-f1)*(1-f2)
  f10 = f1*(1-f2)
  f01 = (1-f1)*f2
  f11 = f1*f2
  kappa_exact = c(f00*0.25, f00*0.5+f10*0.5+f01*0.5, f00*0.25+f10*0.5+f01*0.5+f11)

  # Computed
  founderInbreeding(x, 1:2) = c(f1, f2)
  kappa_ribd = kappaIBD(x, ids = 3:4)

  # Results are not identical (due to rounding), but should be *equal*
  expect_equal(kappa_ribd, kappa_exact)
})


test_that("kappaIBD simplifies output when input is a single pair", {
  x = nuclearPed(1)
  expect_length(kappaIBD(x, 1:2), 3)
  expect_length(kappaIBD(x, 1:3), 5)

  y = list(x, singleton(4))
  expect_length(kappaIBD(y, 3:4), 3)
  expect_length(kappaIBD(y, 2:4), 5)
})