tests/testthat/testDemography.R

context("Demography")

test_that("We can separate into risk groups", 
  {
      popv <- stratify_by_age(c(100, 200, 400, 800), c(1,3))
      expect_equivalent(popv, as.integer(c(100, 600, 800)))
      expect_identical(names(popv), c("[0,1)", "[1,3)", "[3,+)"))
  })


test_that("We can separate into risk groups", 
  {
      popv <- stratify_by_risk( 
                c(3000,2000,1000),
                matrix( c(0.4,0.4,0.3,0.1,0.1,0.1), ncol=3, byrow=T ) )
      expect_equivalent( popv,
            c( 1500, 1000, 600, 1200, 800, 300, 300, 200, 100 ) )

      popv <- stratify_by_age(c(100, 200, 400, 800), c(1,3))
      
      popv <- stratify_by_risk(popv,
                matrix( c(0.4,0.4,0.3,0.1,0.1,0.1), ncol=3, byrow=T ),
                labels = c("HR", "LR", "P"))
      expect_identical(names(popv)[1], "HR [0,1)")
      
      # Check for correct names
      par <- c(0.70)
      names(par) <- "I0"
      initial.infected <- rep(10^par, 3)
      popv <- stratify_by_risk(initial.infected, 
                              matrix( c(0.4,0.4,0.3,0.1,0.1,0.1), ncol=3, byrow=T ))
      expect_identical(names(popv)[1], "RG1 AG1")
  })

test_that("We can convert limits into levels (factor labels)", {
  expect_identical(age_group_levels(), c("[0,+)"))
  expect_identical(age_group_levels(c(1)), c("[0,1)", "[1,+)"))
  expect_identical(age_group_levels(c(15, 65)), c("[0,15)", "[15,65)", "[65,+)"))
})

test_that("We can convert levels into limits", {
  expect_identical(as.integer(c()), age_group_limits(c("[0,+)")))
  expect_identical(as.integer(c(1)), age_group_limits(c("[0,1)", "[1,+)")))
  expect_identical(as.integer(c(15, 65)), age_group_limits(c("[0,15)", "[15, 65)", "[65,+)")))
})

test_that("We can convert age to age group", {
  expect_equal(as.numeric(as_age_group( 6, c(1,5,10) )),3)
  expect_equal(as.numeric(as_age_group( 5, c(1,5,10) )),3)
  expect_equal(as.numeric(as_age_group( 4, c(1,5,10) )),2)
  expect_equal(as.numeric(as_age_group( 0, c(1,5,10) )),1)
  expect_equal(as.numeric(as_age_group( 10, c(1,5,10) )),4)
})

test_that("We can convert age vector to age group", {
  v <- as_age_group(c(4,5), c(1,5,10))
  expect_equal(as.numeric(v), c(2, 3))
  expect_is(v, "factor")
  expect_equal(levels(v), c("[0,1)", "[1,5)", "[5,10)", "[10,+)"))
  
  v <- as_age_group(c(4,11), c(1,5,10))
  expect_equal(as.numeric(v), c(2, 4))
  
  v <- as_age_group(11, c(1,5,10))
  expect_equal(as.numeric(v), 4)
})
 
test_that("We can map age groups", {
  mp <- age_group_mapping(c(5), c(5))
  expect_equal(nrow(mp), 2)
  mp <- age_group_mapping(c(1,5), c(5))
  expect_identical(as.numeric(mp$from), c(1, 2, 3))
  expect_identical(as.numeric(mp$to), c(1, 1, 2))
  expect_identical(mp$weight, c(1,1,1))
  
  mp <- age_group_mapping(c(1,5,8), c(5))
  expect_identical(as.numeric(mp$from), c(1, 2, 3, 4))
  expect_identical(as.numeric(mp$to), c(1, 1, 2, 2))
  expect_identical(mp$weight, c(1, 1, 1, 1))
  
  mp <- age_group_mapping(c(1,3,4), c(2), demography = c(100, 200, 400, 800, 1600))
  expect_identical(as.numeric(mp$from), c(1, 2, 2, 3, 4))
  expect_identical(as.numeric(mp$to), c(1, 1, 2, 2, 2))
  expect_identical(mp$weight, c(1, 200/600, 400/600, 1, 1))
  
  mp <- age_group_mapping(c(1,5), c(3), demography = c(100, 200, 400, 800, 1600, 3200))
  expect_identical(as.numeric(mp$from), c(1, 2, 2, 3))
  expect_identical(as.numeric(mp$to), c(1, 1, 2, 2))
  expect_identical(mp$weight, c(1, 600/(600+2400), 2400/(600+2400), 1))
  
  data(demography)
  mp <- age_group_mapping(c(65), c(65, 80), demography = demography)
  expect_equal(nrow(mp), 3)
  expect_equal(1, mp$weight[2] + mp$weight[3])
  mp1 <- age_group_mapping(c(65), c(65,75,80), demography = demography)
  expect_equal(1, sum(mp1$weight[2:4]))
  expect_equal(mp$weight[3], mp1$weight[4])
})

test_that("We can map risk groups", {
  mp <- risk_group_mapping(c("R1", "R2"))
  expect_identical(as.character(mp$from), c("R1", "R2"))
  expect_identical(as.character(mp$to), c("All", "All"))
  expect_identical(mp$weight, c(1,1))
  
  mp <- risk_group_mapping(c("R1", "R2"), "All")
  expect_identical(as.character(mp$from), c("R1", "R2"))
  expect_identical(as.character(mp$to), c("All", "All"))
  expect_identical(mp$weight, c(1,1))
   
  mp <- risk_group_mapping("All", c("R1", "R2"), c(0.5, 0.5))
  expect_identical(as.character(mp$from), c("All", "All"))
  expect_identical(as.character(mp$to), c("R1", "R2"))
  expect_identical(mp$weight, c(0.5,0.5))
  
  expect_warning(risk_group_mapping("All", c("R1", "R2")))
})
  
MJomaba/flu-evidence-synthesis documentation built on April 26, 2022, 11:12 p.m.