tests/testthat/test-founder-inbreeding.R

In magnusdv/pedtools: Creating and Working with Pedigrees and Marker Data

test_that("setting/getting founder inbreeding works properly", {
  x = addSon(nuclearPed(1), 3, id="boy", verbose=F)

  expect_equal(founderInbreeding(x), c(0, 0, 0))
  expect_equal(founderInbreeding(x, named=T), c('1'=0, '2'=0, '4'=0))

  founderInbreeding(x, '4') = 1
  expect_equal(founderInbreeding(x, 4), 1)

  founderInbreeding(x) = c('1' = 0.5)
  expect_equal(founderInbreeding(x, named=T), c('1'=0.5, '2'=0, '4'=1))
  expect_equal(founderInbreeding(x, c(4,1)), c(1, 0.5))
})

test_that("setFounderInbreeding works on lists", {

  fi = function(a, ids = NULL)
    founderInbreeding(a, ids, named = T)

  x = list(nuclearPed(1), singleton(4))
  y1 = setFounderInbreeding(x, value = 1)
  expect_equal(fi(y1), c("1" = 1, "2" = 1, "4" = 1))

  y2 = setFounderInbreeding(x, value = c("2" = 1))
  expect_equal(fi(y2), c("1" = 0, "2" = 1, "4" = 0))

  y3 = setFounderInbreeding(x, ids = 2, value = 1)
  expect_equal(fi(y3), c("1" = 0, "2" = 1, "4" = 0))

  expect_equal(fi(y3, ids = c(4,2)), c("4" = 0, "2" = 1))
})

test_that("founder inbreeding is preserved under modifications", {
  x = nuclearPed(1)
  founderInbreeding(x, "1") = 1

  x1 = relabel(x, old=1, new="a")
  expect_equal(founderInbreeding(x1, "a"), 1)

  x2 = reorderPed(x, 3:1)
  expect_equal(founderInbreeding(x2, 1), 1)

  x3 = restorePed(as.matrix(x))
  expect_equal(founderInbreeding(x3, 1), 1)

  x4 = addSon(x, 1, verbose=F)
  expect_equal(founderInbreeding(x4, 1), 1)

  x5 = addParents(x, 2, verbose=F)
  expect_equal(founderInbreeding(x5, 1), 1)

  x6 = swapSex(x, 1, verbose=F)
  expect_equal(founderInbreeding(x5, 1), 1)
})

test_that("founder inbreeding is removed by removeIndividuals()", {
  x = addSon(nuclearPed(1), 3, verbose=F)
  founderInbreeding(x, 4) = 1
  expect_silent(y <- removeIndividuals(x, 4, verbose=F))
  expect_equal(founderInbreeding(y), c(0,0))
})

test_that("setting/getting founder inbreeding catches errors", {
  x = addSon(nuclearPed(1), 3, id="boy", verbose=F)

  expect_error(founderInbreeding("boy"), "Input is not a `ped` object")
  expect_error(founderInbreeding(x, 5), "Unknown ID label")
  expect_error(founderInbreeding(x, "boy"), "Pedigree member is not a founder")

  expect_error({founderInbreeding(x, 5) = 0}, "Unknown ID label")
  expect_error({founderInbreeding(x, labels(x)) = 0}, "Pedigree member is not a founder: 3, boy")
  expect_error({founderInbreeding(x, 1) = c(0,1)}, "Replacement vector must have length")
  expect_error({founderInbreeding(x, c(1,1,2)) = c(0,0,0)}, "Duplicated ID label")
  expect_error({founderInbreeding(x, 1) = "a"}, "Inbreeding coefficients must be numeric")
  expect_error({founderInbreeding(x, 1:2) = c(-1,2)},
               "Inbreeding coefficients must be in the interval")

  founderInbreeding(x, 1) = 1
  expect_message(addParents(x, 1, verbose=F), "Warning: Autosomal founder inbreeding lost.")

})