tests/testthat/test-tree-sampler-with-outside-gen.R

In skgallagher/TBornotTB: Analyze Tuberculosis Patients in Maryland

test_that("tree_sampler", {
  data <- data.frame(n = 1, n_pos = 1,
                     freq = 1)
  impute_generator <- FALSE
  prob_pos <- .5
  B <- 1
  out <- tree_sampler(data = data, 
                      B = B,
                      impute_generator = impute_generator,
                      prob_pos = prob_pos)
  expect_equal(nrow(out), 1)
  expect_equal(c(out$n, out$n_pos), c(out$obs_n, out$obs_n_pos))
  
  ##
  data <- data.frame(n = 1, n_pos = 1,
                     freq = 1)
  impute_generator <- TRUE
  prob_pos <- 0
  B <- 1
  out <- tree_sampler(data = data, 
                      B = B,
                      impute_generator = impute_generator,
                      prob_pos = prob_pos)
  expect_equal(nrow(out), 1)
  expect_equal(c(out$n, out$n_pos), c(out$obs_n +1, out$obs_n_pos))
  ##
  data <- data.frame(n = 1, n_pos = 1,
                     freq = 10)
  impute_generator <- TRUE
  prob_pos <- 0
  B <- 1
  out <- tree_sampler(data = data, 
                      B = B,
                      impute_generator = impute_generator,
                      prob_pos = prob_pos)
  expect_equal(nrow(out), 1)
  expect_equal(c(out$n, out$n_pos), c(out$obs_n +1, out$obs_n_pos))
  ##
  data <- data.frame(n = 1, n_pos = 1,
                     freq = 10)
  impute_generator <- TRUE
  prob_pos <- 0
  B <- 1
  out <- tree_sampler(data = data, 
                      B = B,
                      impute_generator = impute_generator,
                      prob_pos = prob_pos)
  expect_equal(nrow(out), 1)
  expect_equal(c(out$n, out$n_pos), c(out$obs_n +1, out$obs_n_pos))
  ##
  data <- data.frame(n = 10, n_pos = 3,
                     freq = 10)
  impute_generator <- FALSE
  prob_pos <- .5
  B <- 10
  out <- tree_sampler(data = data, 
                      B = B,
                      impute_generator = impute_generator,
                      prob_pos = prob_pos)
  expect_equal(sum(out$freq), 10)
  ##
  data <- data.frame(n = c(10, 5), n_pos = c(3, 1),
                     freq = c(10, 2))
  impute_generator <- FALSE
  prob_pos <- .5
  B <- 10
  out <- tree_sampler(data = data, 
                      B = B,
                      impute_generator = impute_generator,
                      prob_pos = prob_pos)
  out2 <- out %>% dplyr::group_by(obs_n, obs_n_pos) %>%
    dplyr::summarize(freq = sum(freq))
  expect_true(all(out2$freq == 10))
  ##
  data <- data.frame(n = c(10, 5), n_pos = c(3, 1),
                     freq = c(10, 2))
  impute_generator <- TRUE
  prob_pos <- .5
  B <- 10
  out <- tree_sampler(data = data, 
                      B = B,
                      impute_generator = impute_generator,
                      prob_pos = prob_pos)
  out2 <- out %>% dplyr::group_by(obs_n, obs_n_pos) %>%
    dplyr::summarize(freq = sum(freq))
  expect_true(all(out2$freq == 10))
  
})





test_that("tree_sampler_nx", {

  
  
  data <- data.frame(n = 1, x = 0, B =1)
  
  out <- tree_sampler_nx(data, n = data$n, 
                         x = data$x)
  expect_equal(nrow(out), 1)
  ###
  data <- data.frame(n = 1, x = 1, B =1)
  
  out <- tree_sampler_nx(data, n = data$n, 
                         x = data$x)
  expect_equal(nrow(out), 1)
  ###
  data <- data.frame(n = 1, x = 1, B =10)
  
  out <- tree_sampler_nx(data, n = data$n, 
                         x = data$x)
  expect_equal(nrow(out), 1)
  ###
  data <- data.frame(n = 10, x = 10, B = 10)
  
  out <- tree_sampler_nx(data, n = data$n, 
                         x = data$x)
  expect_equal(nrow(out), 1)
  ###
  data <- data.frame(n = 10, x = 0, B = 5)
  
  out <- tree_sampler_nx(data, n = data$n, 
                         x = data$x)
  expect_equal(nrow(out), 1)
  ###  ## Starting some non-trivial cases
  data <- data.frame(n = 10, x = 5, B = 10)
  
  out <- tree_sampler_nx(data, n = data$n, 
                         x = data$x)
  expect_equal(sum(out$freq), data$B[1])
  
  
  
})