tests/testthat/test-transmissionRates.R

In multigroup.vaccine: Analyze Outbreak Models of Multi-Group Populations with Vaccination

test_that("transmission rate calibration works", {
  R0 <- 15
  meaninf <- 7
  popsize <- c(100, 200, 300)
  incontact <- c(0.3, 0.4, 0.45)
  relcontact <- c(1, 1.1, 1.4)
  relsusc <- c(1, 1.2, 1.1)

  f <- (1 - incontact) * relcontact * popsize
  contactmatrix <- (diag(incontact) + outer((1 - incontact), f / sum(f)))
  reltransm <- relcontact * relsusc * contactmatrix
  betaij <- transmissionRates(R0, meaninf, reltransm)

  expect_equal(eigen(betaij)$values[1] * meaninf, R0)

  beta11 <- relcontact[1] * relsusc[1] *
    (incontact[1] + (1 - incontact[1])^2 * relcontact[1] * popsize[1] / sum((1 - incontact) * relcontact * popsize))

  beta22 <- relcontact[2] * relsusc[2] *
    (incontact[2] + (1 - incontact[2])^2 * relcontact[2] * popsize[2] / sum((1 - incontact) * relcontact * popsize))

  beta33 <- relcontact[3] * relsusc[3] *
    (incontact[3] + (1 - incontact[3])^2 * relcontact[3] * popsize[3] / sum((1 - incontact) * relcontact * popsize))

  beta12 <- relcontact[1] * relsusc[1] * (1 - incontact[1]) * (1 - incontact[2]) * relcontact[2] *
    popsize[2] / sum((1 - incontact) * relcontact * popsize)

  beta13 <- relcontact[1] * relsusc[1] * (1 - incontact[1]) * (1 - incontact[3]) * relcontact[3] *
    popsize[3] / sum((1 - incontact) * relcontact * popsize)

  beta21 <- relcontact[2] * relsusc[2] * (1 - incontact[2]) * (1 - incontact[1]) * relcontact[1] *
    popsize[1] / sum((1 - incontact) * relcontact * popsize)

  beta23 <- relcontact[2] * relsusc[2] * (1 - incontact[2]) * (1 - incontact[3]) * relcontact[3] *
    popsize[3] / sum((1 - incontact) * relcontact * popsize)

  beta31 <- relcontact[3] * relsusc[3] * (1 - incontact[3]) * (1 - incontact[1]) * relcontact[1] *
    popsize[1] / sum((1 - incontact) * relcontact * popsize)

  beta32 <- relcontact[3] * relsusc[3] * (1 - incontact[3]) * (1 - incontact[2]) * relcontact[2] *
    popsize[2] / sum((1 - incontact) * relcontact * popsize)

  betamat <- matrix(c(beta11, beta21, beta31, beta12, beta22, beta32, beta13, beta23, beta33), 3, 3)

  betachk <- betamat * R0 / meaninf / eigen(betamat)$values[1]
  expect_equal(max(abs(betaij - betachk)), 0, tolerance = sqrt(.Machine$double.eps))
})

test_that("transmissionRates returns correct dimensions", {
  R0 <- 2.5
  meaninf <- 7
  reltransm <- matrix(c(1, 0.5, 0.5, 1), 2, 2)
  
  result <- transmissionRates(R0, meaninf, reltransm)
  
  expect_true(is.matrix(result))
  expect_equal(dim(result), dim(reltransm))
})

test_that("transmissionRates preserves R0", {
  R0 <- 2.5
  meaninf <- 7
  reltransm <- matrix(c(1, 0.3, 0.5, 1.2), 2, 2)
  
  result <- transmissionRates(R0, meaninf, reltransm)
  
  # Check that dominant eigenvalue * meaninf equals R0
  computed_R0 <- eigen(result)$values[1] * meaninf
  expect_equal(computed_R0, R0)
})

test_that("transmissionRates handles symmetric matrix", {
  R0 <- 3
  meaninf <- 6
  reltransm <- matrix(c(1, 0.5, 0.5, 1), 2, 2)  # Symmetric
  
  result <- transmissionRates(R0, meaninf, reltransm)
  
  # Result should also be symmetric
  expect_equal(result[1, 2], result[2, 1])
})

test_that("transmissionRates handles asymmetric matrix", {
  R0 <- 2.8
  meaninf <- 7
  reltransm <- matrix(c(1, 0.3, 0.7, 1.5), 2, 2)  # Asymmetric
  
  result <- transmissionRates(R0, meaninf, reltransm)
  
  # Should still preserve R0
  computed_R0 <- eigen(result)$values[1] * meaninf
  expect_equal(computed_R0, R0)
})

test_that("transmissionRates handles high R0", {
  R0 <- 15
  meaninf <- 7
  reltransm <- matrix(c(1, 0.5, 0.5, 1), 2, 2)
  
  result <- transmissionRates(R0, meaninf, reltransm)
  
  expect_true(all(is.finite(result)))
  computed_R0 <- eigen(result)$values[1] * meaninf
  expect_equal(computed_R0, R0)
})

test_that("transmissionRates handles low R0", {
  R0 <- 0.5
  meaninf <- 7
  reltransm <- matrix(c(1, 0.5, 0.5, 1), 2, 2)
  
  result <- transmissionRates(R0, meaninf, reltransm)
  
  expect_true(all(result >= 0))
  computed_R0 <- eigen(result)$values[1] * meaninf
  expect_equal(computed_R0, R0)
})

test_that("transmissionRates handles fractional values", {
  R0 <- 2.73
  meaninf <- 6.5
  reltransm <- matrix(c(1.2, 0.45, 0.67, 1.35), 2, 2)
  
  result <- transmissionRates(R0, meaninf, reltransm)
  
  expect_true(all(is.finite(result)))
  computed_R0 <- eigen(result)$values[1] * meaninf
  expect_equal(computed_R0, R0, tolerance = 1e-10)
})