tests/testthat/test-computeRelatedness.R

In R-Computing-Lab/BGMisc: An R Package for Extended Behavior Genetics Analysis

# Test for calculateRelatedness and inferRelatedness functions
test_that("calculateRelatedness function for full siblings", {
  result <- calculateRelatedness(generations = 1, full = TRUE)
  expect_equal(result, 0.5)
})

test_that("calculateRelatedness function for half siblings", {
  result <- calculateRelatedness(generations = 1, full = FALSE)
  expect_equal(result, 0.25)
})

test_that("calculateRelatedness function with segregating genes", {
  result <- calculateRelatedness(generations = 1, segregating = FALSE)
  expect_equal(result, 0.995, tolerance = 1e-11)
})

test_that("calculateRelatedness function with empirical", {
  result <- calculateRelatedness(generations = 2, empirical = TRUE)
  expect_equal(result, 0.125, tolerance = 0)
})

test_that("calculateRelatedness function with empirical", {
  result <- calculateRelatedness(generations = 2, empirical = TRUE, maternal = TRUE)
  expect_equal(result, 0.125 + .000002426, tolerance = 1e-8)
})


test_that("inferRelatedness performs as expected", {
  result <- inferRelatedness(0, aceA = .9, aceC = 0, sharedC = 0)
  expect_equal(result, 0)
  expect_error(
    inferRelatedness(0, aceA = 2, aceC = 0, sharedC = 0),
    "aceA and aceC must be proportions between 0 and 1"
  )
})


# Test 1: Basic Functionality Test
test_that("calculateH returns correct heritability estimates", {
  expect_equal(calculateH(0.5, 0.25, 0.4, 0.2), 0.8)
  expect_equal(calculateH(0.5, 0.125, 0.5, 0.25), 2 / 3, tolerance = 1e-8)
})

# Test 2: unusual warning
test_that("provides warning for unusual H value", {
  r1 <- 0.25
  r2 <- 0.125
  obsR1 <- 0.3
  obsR2 <- 0.1
  expected <- 1.6
  expect_warning(expect_equal(calculateH(r1, r2, obsR1, obsR2), expected))
})


# Test 3: Vectorized Input Test
test_that("calculateH handles vectorized inputs correctly", {
  r1 <- c(0.5, 0.5)
  r2 <- c(0.25, 0.125)
  obsR1 <- c(0.4, 0.5)
  obsR2 <- c(0.2, 0.25)
  expected <- c(0.8, 2 / 3)
  expect_equal(calculateH(r1, r2, obsR1, obsR2), expected, tolerance = 1e-8)
})


# Test 4: Equal Relatedness Coefficients Test
test_that("calculateH stops for equal relatedness coefficients", {
  expect_error(
    calculateH(0.5, 0.5, 0.4, 0.2),
    "Relatedness coefficients r1 and r2 must not be equal for any pair."
  )
})

# Test 5: Negative and Positive Correlation Test
test_that("calculateH handles both negative and positive correlations", {
  # Test for negative correlations with expected warnings about negative heritability values
  expect_warning(
    expect_equal(calculateH(0.5, 0.25, -0.4, -0.2), -0.8),
    regexp = "Some calculated heritability values are negative"
  )
  # Test for a scenario leading to a positive heritability estimate

  expect_warning(
    expect_warning(
      expect_equal(calculateH(0.5, 0.25, 0.2, -0.1), 1.2),
      regexp = "The correlations should not have opposite signs."
    ),
    regexp = "Some calculated heritability values are greater than 1"
  )
})

# Test 6: illegal correlation values
test_that("calculateH stops for illegal coefficients", {
  expect_warning(
    calculateH(0.5, 0.25, 1.4, 1.4),
    "The observed correlations should be between -1 and 1"
  )
})