tests/testthat/test-get_Z.R

In jsocolar/flocker: Flexible Occupancy Estimation with Stan

test_that("get_Z gives valid returns", {
  Z_single <- get_Z(example_flocker_model_single)
  expect_true(all(Z_single >= 0))
  expect_true(all(Z_single <= 1))
  expect_true(any(Z_single == 1))
  
  Z_single_C <- get_Z(example_flocker_model_single_C)
  expect_true(all(Z_single_C >= 0))
  expect_true(all(Z_single_C <= 1))
  expect_true(any(Z_single_C == 1))
  
  Z_augmented <- get_Z(example_flocker_model_aug)
  expect_true(all(Z_augmented >= 0))
  expect_true(all(Z_augmented <= 1))
  expect_true(any(Z_augmented == 1))
  
  Z_multi_colex_ex <- get_Z(example_flocker_model_multi_colex_ex)
  expect_true(all(Z_multi_colex_ex >= 0, na.rm = T))
  expect_true(all(Z_multi_colex_ex <= 1, na.rm = T))
  expect_true(any(Z_multi_colex_ex == 1, na.rm = T))
  
  Z_multi_colex_eq <- get_Z(example_flocker_model_multi_colex_eq)
  expect_true(all(Z_multi_colex_eq >= 0, na.rm = T))
  expect_true(all(Z_multi_colex_eq <= 1, na.rm = T))
  expect_true(any(Z_multi_colex_eq == 1, na.rm = T))
  
  Z_multi_auto_ex <- get_Z(example_flocker_model_multi_auto_ex)
  expect_true(all(Z_multi_auto_ex >= 0, na.rm = T))
  expect_true(all(Z_multi_auto_ex <= 1, na.rm = T))
  expect_true(any(Z_multi_auto_ex == 1, na.rm = T))
  
  Z_multi_auto_eq <- get_Z(example_flocker_model_multi_auto_eq)
  expect_true(all(Z_multi_auto_eq >= 0, na.rm = T))
  expect_true(all(Z_multi_auto_eq <= 1, na.rm = T))
  expect_true(any(Z_multi_auto_eq == 1, na.rm = T))
  
  
  
  Z_single_nohist <- get_Z(example_flocker_model_single, history_condition = FALSE)
  expect_true(all(Z_single_nohist >= 0))
  expect_true(all(Z_single_nohist <= 1))
  expect_true(sum(Z_single == 1) > sum(Z_single_nohist == 1))
  
  Z_single_C_nohist <- get_Z(example_flocker_model_single_C, history_condition = FALSE)
  expect_true(all(Z_single_C_nohist >= 0))
  expect_true(all(Z_single_C_nohist <= 1))
  expect_true(sum(Z_single_C == 1) > sum(Z_single_C_nohist == 1))
  
  Z_augmented_nohist <- get_Z(example_flocker_model_aug, history_condition = FALSE)
  expect_true(all(Z_augmented_nohist >= 0))
  expect_true(all(Z_augmented_nohist <= 1))
  expect_true(sum(Z_augmented == 1) > sum(Z_augmented_nohist == 1))
  
  Z_multi_colex_ex_nohist <- get_Z(example_flocker_model_multi_colex_ex, history_condition = FALSE)
  expect_true(all(Z_multi_colex_ex_nohist >= 0, na.rm = T))
  expect_true(all(Z_multi_colex_ex_nohist <= 1, na.rm = T))
  expect_true(sum(Z_multi_colex_ex == 1, na.rm = TRUE) > sum(Z_multi_colex_ex_nohist == 1, na.rm = TRUE))
  
  Z_multi_colex_eq_nohist <- get_Z(example_flocker_model_multi_colex_eq, history_condition = FALSE)
  expect_true(all(Z_multi_colex_eq_nohist >= 0, na.rm = T))
  expect_true(all(Z_multi_colex_eq_nohist <= 1, na.rm = T))
  expect_true(sum(Z_multi_colex_eq == 1, na.rm = TRUE) > sum(Z_multi_colex_eq_nohist == 1, na.rm = TRUE))
  
  Z_multi_auto_ex_nohist <- get_Z(example_flocker_model_multi_auto_ex, history_condition = FALSE)
  expect_true(all(Z_multi_auto_ex_nohist >= 0, na.rm = T))
  expect_true(all(Z_multi_auto_ex_nohist <= 1, na.rm = T))
  expect_true(sum(Z_multi_auto_ex == 1, na.rm = TRUE) > sum(Z_multi_auto_ex_nohist == 1, na.rm = TRUE))
  
  Z_multi_auto_eq_nohist <- get_Z(example_flocker_model_multi_auto_eq, history_condition = FALSE)
  expect_true(all(Z_multi_auto_eq_nohist >= 0, na.rm = T))
  expect_true(all(Z_multi_auto_eq_nohist <= 1, na.rm = T))
  expect_true(sum(Z_multi_auto_eq == 1, na.rm = TRUE) > sum(Z_multi_auto_eq_nohist == 1, na.rm = TRUE))
  
})


test_that("get_Z with sampling gives valid returns", {
  Z_single <- get_Z(example_flocker_model_single, sample = TRUE)
  expect_true(all(Z_single %in% c(0, 1, NA)))
  
  Z_single_C <- get_Z(example_flocker_model_single_C, sample = TRUE)
  expect_true(all(Z_single_C %in% c(0, 1, NA)))
  
  Z_augmented <- get_Z(example_flocker_model_aug, sample = TRUE)
  expect_true(all(Z_augmented %in% c(0, 1, NA)))
  
  Z_multi_colex_ex <- get_Z(example_flocker_model_multi_colex_ex, sample = TRUE)
  expect_true(all(Z_multi_colex_ex %in% c(0, 1, NA)))
  
  Z_multi_colex_eq <- get_Z(example_flocker_model_multi_colex_eq, sample = TRUE)
  expect_true(all(Z_multi_colex_eq %in% c(0, 1, NA)))
  
  Z_multi_auto_ex <- get_Z(example_flocker_model_multi_auto_ex, sample = TRUE)
  expect_true(all(Z_multi_auto_ex %in% c(0, 1, NA)))
  
  Z_multi_auto_eq <- get_Z(example_flocker_model_multi_auto_eq, sample = TRUE)
  expect_true(all(Z_multi_auto_eq %in% c(0, 1, NA)))

})

test_that("new_data works as expected", {
  fd1 <- simulate_flocker_data(n_sp = 5)
  mfd1 <- make_flocker_data(fd1$obs, fd1$unit_covs, fd1$event_covs)
  expect_silent(get_Z(example_flocker_model_single, new_data = mfd1))
  expect_silent(get_Z(example_flocker_model_single, history_condition = FALSE, new_data = fd1$unit_covs))
  expect_error(get_Z(example_flocker_model_single, history_condition = TRUE, new_data = fd1$unit_covs))
})


test_that("incorrect types cause an error", {
  expect_error(forward_sim("init", c(0.5, 0.5), c(0.5, 0.5)))
  expect_error(forward_sim(0.5, "colo", c(0.5, 0.5)))
  expect_error(forward_sim(0.5, c(0.5, 0.5), "ex"))
})

test_that("negative probabilities cause an error", {
  expect_silent(forward_sim(.4, c(.5, .5), c(.5, .5)))
  expect_error(forward_sim(.4, c(.5, NA), c(.5, .5)))
  expect_error(forward_sim(-0.1, c(0.5, .5), c(0.5, .5)))
  expect_error(forward_sim(0.5, c(.5, -0.5), c(.5, 0.5)))
  expect_error(forward_sim(0.5, c(NA, 0.5), c(NA, -0.5)))
})

test_that("correct inputs produce correct outputs", {
  # Simple case with no NA values and no sampling
  expect_equal(forward_sim(0.5, c(0.5, 0.5), c(0.5, 0.5)), c(0.5, 0.5))
  # Simple case with sampling, the result is stochastic, so we can't test exact values, just types and lengths
  result <- forward_sim(0.5, c(0.5, 0.5), c(0.5, 0.5), sample = TRUE)
  expect_type(result, "integer")
  expect_length(result, 2)
})

test_that("edge cases are handled", {
  # Case with all NA values should return NA
  expect_error(forward_sim(NA, c(NA, NA), c(NA, NA)))
  # Case with empty vectors
  expect_error(forward_sim(0.5, numeric(0), numeric(0)))
})

# Test for forward_backward_algorithm function
test_that("forward_backward_algorithm returns correct results", {
  el0 <- c(0.1, 0.2, 0.3)
  el1 <- c(0.9, 0.8, 0.7)
  init <- 0.5
  colo <- c(0.6, 0.7, 0.8)
  ex <- c(0.4, 0.3, 0.2)
  result <- forward_backward_algorithm(el0, el1, init, colo, ex)
  expect_type(result, "double")
  expect_length(result, length(el0))
})

# Test for forward_backward_sampling function
test_that("forward_backward_sampling returns correct results", {
  el0 <- c(0.1, 0.2, 0.3)
  el1 <- c(0.9, 0.8, 0.7)
  init <- 0.5
  colo <- c(0.6, 0.7, 0.8)
  ex <- c(0.4, 0.3, 0.2)
  result <- forward_backward_sampling(el0, el1, init, colo, ex)
  expect_type(result, "double")
  expect_length(result, length(el0))
})

# Test for forward_algorithm function
test_that("forward_algorithm returns correct results", {
  el0 <- c(0.1, 0.2, 0.3)
  el1 <- c(0.9, 0.8, 0.7)
  init <- 0.5
  colo <- c(0.6, 0.7, 0.8)
  ex <- c(0.4, 0.3, 0.2)
  result <- forward_algorithm(el0, el1, init, colo, ex)
  expect_type(result, "double")
  expect_equal(dim(result), c(length(el0), 2))
})

# Test for backward_algorithm function
test_that("backward_algorithm returns correct results", {
  el0 <- c(0.1, 0.2, 0.3)
  el1 <- c(0.9, 0.8, 0.7)
  colo <- c(0.6, 0.7, 0.8)
  ex <- c(0.4, 0.3, 0.2)
  result <- backward_algorithm(el0, el1, colo, ex)
  expect_type(result, "double")
  expect_equal(dim(result), c(length(el0), 2))
})