tests/testthat/test-simulate-conditional-bp.R

test_that("summarize_cond_trees", {
  part_list <- generate_part_list(n = 10)
  g_weight_list <- get_weight_list(part_list)
  ii <- 1

    K <- 3
    n_vec <- sample(1:10, size = 3, replace = TRUE)
    n_pos_vec <- c(sample(0:n_vec[1], size = 1),
                   sample(0:n_vec[2], size = 1),
                   sample(0:n_vec[3], size = 1))
    out <- simulate_many_cond_bp(K, n_vec = n_vec,
                                 n_pos_vec = n_pos_vec,
                                 part_list = part_list,
                                 g_weight_list = g_weight_list,
                                 one_init = FALSE)

    sum_trees <- summarize_cond_trees(out)
    expect_equal(nrow(sum_trees), K)
})



test_that("draw_part_from_list", {
  part_list <- generate_part_list(n = 10)
  g_weight_list <- get_weight_list(part_list)

  out <- draw_part_from_list(n = 2, part_list = part_list,
                             g_weight_list = g_weight_list,
                             one_init = FALSE)
  expect_equal(ncol(out),1)

  out <- draw_part_from_list(n = 4, part_list = part_list,
                             g_weight_list = g_weight_list,
                             one_init = FALSE)
  expect_equal(ncol(out),1)

})


test_that("simulate_many_cond_bp", {
  part_list <- generate_part_list(n = 10)
  g_weight_list <- get_weight_list(part_list)
  for(ii in 1:100){

    K <- 3
    n_vec <- sample(1:10, size = 3, replace = TRUE)
    n_pos_vec <- c(sample(0:n_vec[1], size = 1),
               sample(0:n_vec[2], size = 1),
               sample(0:n_vec[3], size = 1))
    out <- simulate_many_cond_bp(K, n_vec = n_vec,
                                 n_pos_vec = n_pos_vec,
                                 part_list = part_list,
                                 g_weight_list = g_weight_list,
                                 one_init = FALSE)
    expect_equal(nrow(out), sum(n_vec))
  }
})




test_that("draw_n_gen", {
  n <- 5
  out <- draw_n_gen(n = n, lambda = 0)
  expect_equal(out, 1)

  n <- 5
  out <- draw_n_gen(n = n, lambda = 100)
  expect_equal(out, n)
})


test_that("draw_part",{

  n <- 1
  g <- 1

  out <- draw_part(n = n, g = g)
  expect_equal(ncol(out), 1)
  ########
  n <- 4
  g <- 2
  out <- draw_part(n, g)
  expect_equal(nrow(out), g)
  expect_equal(sum(out), n)
  ###
  n <- 2
  g <- 1
  out <- draw_part(n = n, g= g)
  expect_equal(ncol(out), 1)


})


test_that("part_to_cluster", {
  n <- 4
  g <- 2
  k <- 1
  parts <- partitions::restrictedparts(n = n, m = g, include.zero = FALSE)
  part <- parts[, 1, drop = FALSE]

  cluster <- part_to_cluster(k, part)
  expect_equal(nrow(cluster), n)
  expect_equal(length(unique(cluster$id)), length(cluster$id))
  expect_equal(length(unique(cluster$gen)), g)
  expect_equal(sum(is.na(cluster$infector_id)), sum(cluster$gen == 1))
  ############
  n <- 8
  g <- 4
  k <- 12
  parts <- partitions::restrictedparts(n = n, m = g, include.zero = FALSE)
  part <- parts[, 4, drop = FALSE]

  cluster <- part_to_cluster(k, part)
  expect_equal(nrow(cluster), n)
  expect_equal(length(unique(cluster$id)), length(cluster$id))
  expect_equal(length(unique(cluster$gen)), g)
  expect_equal(sum(is.na(cluster$infector_id)), sum(cluster$gen == 1))
})

test_that("assign_infector", {
  gen_vec <- c(1, 1, 1,
               2, 2,
               3, 3,
               4)
  parts <- partitions::restrictedparts(n = length(gen_vec),
                                      m = max(gen_vec), include.zero = FALSE)
  part <- parts[, 4, drop = FALSE] #corresponds to gen_vec
  out <- assign_infector(gen_vec, part, k = 1)
  expect_equal(sum(is.na(out)), 3)



})


test_that("count_infections", {

  df <- data.frame(id = c("A", "B", "C"),
                   infector_id = c(NA, "A", "A"))
  out <- count_infections(df)
  expect_equal(out, c(2, 0, 0))
  #####
  df <- data.frame(id = c("C1-G1-N1", "C1-G1-N2", "C1-G2-N1"),
                   infector_id = c(NA, NA, "C1-G1-N2"))
  out <- count_infections(df)
  expect_equal(out, c(0, 1, 0))
  #####
  df <- data.frame(id = c("B", "A", "C"),
                   infector_id = c(NA, "B", NA))
  out <- count_infections(df)
  expect_equal(out, c(1, 0, 0))
})


test_that("assign_smear", {
  n <- 4
  n_pos <- 2
  out <- assign_smear(n, n_pos)
  expect_equal(sum(out == 1), n_pos)
  ##
  n <- 4
  n_pos <- 4
  out <- assign_smear(n, n_pos)
  expect_equal(sum(out == 1), n_pos)
  ##

  n <- 4
  n_pos <- 0
  out <- assign_smear(n, n_pos)
  expect_equal(sum(out == 1), n_pos)
  ##


})


test_that("simulate_cond_bp", {
  k <- 1
  n <- 1
  n_pos <- 1
  part_list <- generate_part_list(n = 10)
  g_weight_list <- get_weight_list(part_list)

  out <- simulate_cond_bp(k, n, n_pos,
                          part_list = part_list,
                          g_weight_list = g_weight_list)
  expect_equal(nrow(out), n)
  #######
  k <- 4
  n <- 7
  n_pos <- 4
  out <- simulate_cond_bp(k, n, n_pos,
                          part_list = part_list,
                          g_weight_list = g_weight_list)
  expect_equal(nrow(out), n)
  expect_equal(sum(out$smear == 1), n_pos)
  #########


})
skgallagher/TBornotTB documentation built on April 21, 2020, 1:19 p.m.