tests/testthat/test-sample-trees-fast.R

In skgallagher/TBornotTB: Analyze Tuberculosis Patients in Maryland

test_that("get_in0x0", {
  df <- data.frame(id = c("1-1",
                          "2-1","2-2", "2-3",
                          "3-1", "3-2"),
                   inf_id = c(NA,
                              "1-1", "1-1", "1-1",
                              "2-3", "2-1"),
                   smear = c(0, 
                             1, 0, 0,
                             1, 1),
                   gen = c(1,
                           2, 2, 2,
                           3, 3),
                   stringsAsFactors = FALSE)
  out <- get_in0x0(df, summarize_generator = TRUE)
  expect_equal(out, c(1,4,3, 0))
  out <- get_in0x0(df, summarize_generator = FALSE)
  expect_equal(out, c(1,4))
  ######
  df <- data.frame(id = c("1-1",
                          "2-1","2-2", "2-3",
                          "3-1", "3-2"),
                   inf_id = c(NA,
                              "1-1", "1-1", "1-1",
                              "2-3", "2-1"),
                   smear = c(1,
                             0, 1, 0,
                             1, 1),
                   gen = c(1,
                           2, 2, 2,
                           3, 3),
                   stringsAsFactors = FALSE)
  out <- get_in0x0(df, summarize_generator = TRUE)
  expect_equal(out, c(3,2, 3, 1))
   out <- get_in0x0(df, summarize_generator = FALSE)
  expect_equal(out, c(3,2))
  ######
  df <- data.frame(id = c("1-1",
                          "2-1","2-2", "2-3",
                          "3-1", "3-2"),
                   inf_id = c(NA,
                              "1-1", "1-1", "1-1",
                              "2-3", "2-1"),
                   smear = c(1,
                             0, 1, 1,
                             1, 1),
                   gen = c(1,
                           2, 2, 2,
                           3, 3),
                   stringsAsFactors = FALSE)
  out <- get_in0x0(df, summarize_generator = TRUE)
  expect_equal(out, c(4,1, 3, 1))
  out <- get_in0x0(df, summarize_generator = FALSE)
  expect_equal(out, c(4,1))
  ######
  df <- data.frame(id = c("1-1",
                          "2-1","2-2", "2-3",
                          "3-1", "3-2"),
                   inf_id = c(NA,
                              "1-1", "1-1", "1-1",
                              "2-3", "2-1"),
                   smear = c(0,
                             0, 1, 1,
                             1, 1),
                   gen = c(1,
                           2, 2, 2,
                           3, 3),
                   stringsAsFactors = FALSE)
  out <- get_in0x0(df, summarize_generator = TRUE)
  expect_equal(out, c(1, 4, 3, 0))
  out <- get_in0x0(df, summarize_generator = FALSE)
  expect_equal(out, c(1, 4))

})


test_that("sample_connections", {
  gen_sizes <- c(1)
  out <- sample_connections(gen_sizes)
  expect_true(is.na(out$inf_id))
  #############
  ######
  gen_sizes <- c(1, 2, 2)
  out <- sample_connections(gen_sizes)
  expect_equal(sum(is.na(out$inf_id)), 1)
  inf_id_g <- as.integer(substr(out$inf_id, 1, 1))
  expect_true(all(is.na(inf_id_g) | inf_id_g == (out$gen - 1)))
  ######
  gen_sizes <- c(1, 2, 1)
  out <- sample_connections(gen_sizes)
  expect_equal(sum(is.na(out$inf_id)), 1)
  inf_id_g <- as.integer(substr(out$inf_id, 1, 1))
  expect_true(all(is.na(inf_id_g) | inf_id_g == (out$gen - 1)))
})



test_that("sample_tree_perm", {

  gen_sizes <- c(1)
  x <- 1
  out <- sample_tree_perm(gen_sizes, x)
  expect_equal(ncol(out), 5)
  expect_equal(sum(out$smear), x)
  expect_equal(nrow(out), sum(gen_sizes))
  ##########
  gen_sizes <- c(1, 2, 4)
  x <- 4
  out <- sample_tree_perm(gen_sizes, x)
  expect_equal(ncol(out), 5)
  expect_equal(sum(out$smear), x)
  expect_equal(nrow(out), sum(gen_sizes))
})


test_that("sample_in0x0", {
  perm_mat <- matrix(c(1, 1, 1), nrow = 1)
  x <- 0
  out <- sample_in0x0(perm_mat, x,
                      summarize_generator = TRUE)
  expect_equal(out, matrix(c(rep(0,4),
                             rep(0,4),
                             rep(0,4)), ncol = 4))
  #####################
  perm_mat <- matrix(c(1, 2, 1,
                       1, 1, 2,
                       1, 2, 1), ncol = 3)
  x <- 4
  out <- sample_in0x0(perm_mat, x, 
                      summarize_generator = TRUE)
  expect_equal(out, matrix(c(3, 0, 2, 1,
                             3, 0, 1, 1,
                             3, 0, 2, 1), ncol = 4, byrow = TRUE))
  #####################
  perm_mat <- matrix(c(1, 2, 1), ncol = 1)
  x <- 4
  out <- sample_in0x0(perm_mat, x, 
                      summarize_generator = TRUE)
  expect_equal(out, matrix(c(3,0, 2, 1), ncol = 4))



})



test_that("sample_unique_perms", {
  g <- 1
  n <- 1
  B <- 2
  out <- sample_unique_perms(g, n, B)
  expect_equal(as.numeric(out), rep(1, B))
  ################
  g <- 2
  n <- 2
  B <- 2
  out <- sample_unique_perms(g, n, B)
  expect_equal(dim(out), c(g, B))
  expect_true(all(out[1,] == 1))
  expect_true(all(colSums(out) == n))
  ################
  g <- 2
  n <- 2
  B <- 2
  out <- sample_unique_perms(g, n, B)
  expect_equal(dim(out), c(g, B))
  expect_true(all(out[1,] == 1))
  expect_true(all(colSums(out) == n))
  ################
  g <- 4
  n <- 10
  B <- 100
  out <- sample_unique_perms(g, n, B)
  expect_equal(dim(out), c(g, B))
  expect_true(all(out[1,] == 1))
  expect_true(all(colSums(out) == n))
})



test_that("sample_uniform_trees_nx", {
  n <- 1
  x <- 1
  B <- 10
  out <- sample_uniform_trees_nx(n = n, x = x, B)
  expect_equal(dim(out), c(1, 7))
  #############
  n <- 1
  x <- 0
  B <- 10
  out <- sample_uniform_trees_nx(n = n, x = x, B)
  expect_equal(dim(out), c(1, 7))
  #############
  n <- 10
  x <- 10
  B <- 10
  out <- sample_uniform_trees_nx(n = n, x = x, B)
  expect_true(all(out$i_pos == (n-1)))
  #############
  n <- 10
  x <- 0
  B <- 10
  out <- sample_uniform_trees_nx(n = n, x = x, B,
                      summarize_generator = TRUE
                                 )
  expect_true(all(out$i_pos == 0))
  #######
  n <- 10
  x <- 3
  B <- 10
  out <- sample_uniform_trees_nx(n = n, x = x, B,
                      summarize_generator = TRUE)
  expect_equal(sum(out$freq), B)

})


test_that("sample_uniform_trees", {
  n_vec <- c(1,2)
  x_vec <- c(0, 1)
  B <- 10
  out <- sample_uniform_trees(n_vec = n_vec,
                              x_vec = x_vec,
                              B = B)
  expect_equal(sum(out$freq), B * length(n_vec))
  #####################################################

})