tests/testthat/test-likelihood.R

In skgallagher/TBornotTB: Analyze Tuberculosis Patients in Maryland

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


  cluster_summary <- data.frame(freq = c(3, 2, 1),
                                n = c(1, 1, 2),
                                n_pos = c(1, 0, 1))

  n <- cluster_summary$n
  n_pos <- cluster_summary$n_pos
  n_vec <- rep(n, each = n_trials)
  n_pos_vec <- rep(n_pos, each = n_trials)
  par <- c("beta_1" = 1, "beta_0" = 0)
  one_init <- TRUE



  ## Sample trees of n people with n_pos
  sampled_trees <- simulate_many_cond_bp(K = length(n_vec),
                                         n_vec = n_vec, n_pos_vec = n_pos_vec,
                                         part_list = part_list,
                                         g_weight_list = g_weight_list,
                                         one_init = one_init)

  out <- loglike_cluster_summary(par = par,
                                 cluster_summary = cluster_summary,
                                 sampled_trees = sampled_trees,
                                 return_neg = FALSE,
                                 n_trials = n_trials)
  expect_equal(length(out), 1)



})

test_that("loglike_all_clusts", {

  part_list <- generate_part_list(n = 10)
  g_weight_list <- get_weight_list(part_list)
  n_trials <- 10

  n <- c(2, 1, 3)
  n_pos <- c(1, 1, 0)
  n_vec <- rep(n, each = n_trials)
  n_pos_vec <- rep(n_pos, each = n_trials)
  par <- c("beta_1" = 1, "beta_0" = 0)
  one_init <- FALSE



  ## Sample trees of n people with n_pos
  sampled_trees <- simulate_many_cond_bp(K = length(n_vec),
                                         n_vec = n_vec, n_pos_vec = n_pos_vec,
                                         part_list = part_list,
                                         g_weight_list = g_weight_list,
                                         one_init = one_init)

  out <- loglike_all_clusts(par = par,
                            n_vec = n,
                            n_pos_vec = n_pos,
                            sampled_trees = sampled_trees,
                            return_neg = FALSE)

  expect_equal(length(out), 1)


  ###
  out1 <- loglike_all_clusts(par = par,
                             n_vec = c(1),
                             n_pos_vec = c(1),
                             sampled_trees = sampled_trees,
                             return_neg = FALSE)
  out2 <- loglike_all_clusts(par = par,
                            n_vec = c(1, 1, 1),
                            n_pos_vec = c(1, 1, 1),
                            sampled_trees = sampled_trees,
                            return_neg = FALSE)
  expect_equal(out1 * 3, out2)

  ## optimmmm
  out <- optim(par = c("beta_0" = -1, "beta_1" = 0), fn = loglike_all_clusts,
               sampled_trees = sampled_trees,
               return_neg = TRUE,
               n_vec = n,
               n_pos_vec = n_pos)


})


test_that("like_sampled_cond", {

  part_list <- generate_part_list(n = 10)
  g_weight_list <- get_weight_list(part_list)
  n_trials <- 100

  n_pos <- 1
  n <- 1
  n_vec <- rep(n, n_trials)

  n_pos_vec <- rep(n_pos, n_trials)


  ## Sample trees of n people with n_pos
  sampled_trees <- simulate_many_cond_bp(K = n_trials,
                                    n_vec = n_vec, n_pos_vec = n_pos_vec,
                                    part_list = part_list,
                                    g_weight_list = g_weight_list,
                                    one_init = one_init)


  par <- c("beta_1" = 1, "beta_0" = 0)


  out <- like_sampled_cond(par = par,
                           sampled_trees = sampled_trees,
                           n = n,
                           n_pos = n_pos)

  p <- 1 / (1 + exp(-1))
  exp_like <- (1-p) * n_trials
  expect_equal(exp_like, out)
  #########################################################

  ## timing
  ##
  n_trials <- 100
  part_list <- generate_part_list(n = 10)
  g_weight_list <- get_weight_list(part_list)
  n_vec <- rep(n, n_trials)
  n_pos_vec <- rep(n_pos, n_trials)
  par <- c("beta_1" = 1, "beta_0" = 0)
  n_pos <- 1
  n <- 1
  n <- 5
  n_pos <- 3
  ## Sample trees of n people with n_pos
  t <- proc.time()[3]
  sampled_trees <- simulate_many_cond_bp(K = n_trials,
                                         n_vec = n_vec, n_pos_vec = n_pos_vec,
                                         part_list = part_list,
                                         g_weight_list = g_weight_list,
                                         one_init = one_init)

  out <- like_sampled_cond(par = par,
                           sampled_trees = sampled_trees,
                           n = n,
                           n_pos = n_pos)
  proc.time()[3] - t



})

test_that("cluster_like_smear", {

  cluster_df <- data.frame(n_inf = c(1, 1, 0),
                           smear = c(1, 1, -1))
  par <- c("beta_1" = 1, "beta_0" = 0)
  p1 <- 1 / (1 + exp(-1))
  p2 <- 1/2

  exp_like <- p1^2 * (1-p1)^2 * (1-p2)
  out <- cluster_like_smear(par = par, cluster_df = cluster_df,
                            n = 3, n_pos = 2)
  expect_equal(out, exp_like)
})