tests/testthat/test-utils.R

In jsocolar/flocker: Flexible Occupancy Estimation with Stan

test_that("log_inv_logit handles scalar input", {
  expect_equal(log_inv_logit(0), log(0.5))
  expect_equal(log_inv_logit(10), log(1 / (1 + exp(-10))))
})

test_that("log_inv_logit handles vector input", {
  input <- c(-3, 0, 3)
  expected_output <- log(1 / (1 + exp(-input)))
  expect_equal(log_inv_logit(input), expected_output)
})

test_that("log_inv_logit handles extreme values", {
  expect_equal(log_inv_logit(100), log(1 / (1 + exp(-100))))
  expect_equal(log_inv_logit(-100), log(1 / (1 + exp(100))))
  expect_false(identical(log_inv_logit(100), log(1 / (1 + exp(-100)))))
  expect_true(is.finite(log_inv_logit(-10000)))
})

test_that("log_inv_logit throws error for non-numeric input", {
  expect_error(log_inv_logit("abc"), "x must be numeric")
  expect_error(log_inv_logit(TRUE), "x must be numeric")
})


test_that("log1m_inv_logit returns correct output", {
  r <- rnorm(100)
  expect_identical(log_inv_logit(r), log1m_inv_logit(-r))
})

test_that("array utils work properly", {
  testmat <- matrix(c(NA, 1:3), nrow = 2)
  testdf <- as.data.frame(testmat)
  testarray <- array(1:8, dim = c(2,2,2))
  
  # expand_matrix
  expect_error(expand_matrix(1:4))
  expect_identical(expand_matrix(testmat), c(NA, 1:3))
  expect_identical(expand_matrix(testdf), c(NA, 1:3))
  
  # expand_array_3D
  expect_error(expand_array_3D(testarray[,,1]))
  expect_equal(expand_array_3D(testarray), matrix(c(1,2,5,6,3,4,7,8), ncol = 2))
  
  # nslice
  expect_error(nslice(testmat))
  expect_equal(nslice(testarray), 2)
  
  # stack_matrix
  expect_error(stack_matrix(testarray, 2))
  expect_equal(stack_matrix(testmat, 2), matrix(c(NA, 1, NA, 1, 2, 3, 2, 3), ncol = 2))
  expect_equivalent(as.matrix(stack_matrix(testdf, 2)), matrix(c(NA, 1, NA, 1, 2, 3, 2, 3), ncol = 2))
  
  # new_matrix
  m <- matrix(1:4, nrow = 2, ncol = 2)
  new_m <- new_matrix(m)
  expect_true(is.matrix(new_m))
  expect_equal(dim(new_m), dim(m))
  expect_true(all(is.na(new_m)))
  
  data_vector <- c(5, 6, 7, 8)
  new_m <- new_matrix(m, data = data_vector)
  expect_equal(new_m, matrix(data_vector, nrow = 2, ncol = 2))
  
  new_m <- new_matrix(m, data = data_vector, byrow = TRUE)
  expect_equal(new_m, matrix(data_vector, nrow = 2, ncol = 2, byrow = TRUE))
  
  m <- matrix(1:9, nrow = 3, ncol = 3)
  data_vector <- 1:2 # insufficient length
  expect_warning(new_m <- new_matrix(m, data = data_vector))
  expected_matrix <- matrix(rep(data_vector, length.out = 9), nrow = 3, ncol = 3)
  expect_equal(new_m, expected_matrix)
  
  m <- matrix(1:4, nrow = 2, ncol = 2)
  data_vector <- 1:5 # excess length
  expect_warning(new_matrix(m, data = data_vector))
  
  data_vector <- c("a", "b", "c", "d")
  new_m <- new_matrix(m, data = data_vector)
  expect_equal(new_m, matrix(data_vector, nrow = 2, ncol = 2))
  
  m <- matrix(numeric(0), nrow = 0, ncol = 0)
  new_m <- new_matrix(m)
  expect_equal(dim(new_m), c(0, 0))

  expect_error(new_matrix(10))
  expect_error(new_matrix(NULL))
  expect_error(new_matrix(NA))
  
  m <- matrix(1:4, nrow = 2, ncol = 2, dimnames = list(c("r1", "r2"), c("c1", "c2")))
  new_m <- new_matrix(m)
  expect_false(identical(dimnames(new_m), dimnames(m)))
  expect_true(is.null(dimnames(new_m)))
  
  # new array
  m <- array(1:8, dim = c(2, 2, 2))
  new_a <- new_array(m)
  expect_true(is.array(new_a))
  expect_equal(dim(new_a), dim(m))
  expect_true(all(is.na(new_a)))
  
  data_vector <- c(9, 10, 11, 12, 13, 14, 15, 16)
  new_a <- new_array(m, data = data_vector)
  expect_equal(new_a, array(data_vector, dim = c(2, 2, 2)))
  
  m <- array(1:27, dim = c(3, 3, 3))
  data_vector <- 1:5 # insufficient length
  new_a <- new_array(m, data = data_vector)
  expected_array <- array(rep(data_vector, length.out = 27), dim = c(3, 3, 3))
  expect_equal(new_a, expected_array)
  
  non_array_input <- 10
  expect_error(new_array(non_array_input))
  
  expect_error(new_array(NULL))
  expect_error(new_array(NA))
})

test_that("bookkeeping works properly", {
  # flocker_col_names
  expect_true(all(grepl("^ff_", flocker_col_names(3, 4))))
  expect_equal(7, length(flocker_col_names(3, 4)) - length(flocker_col_names()))
  
  # flocker_reserved
  expect_true(all(grepl(flocker_reserved()[1], flocker_col_names())))
  expect_true(all(grepl(flocker_reserved()[2], paste0(".", c(".", "foo", 1:2)))))
  
  # flocker_model_types
  expect_true(all(grepl("^single|^augmented|^multi", flocker_model_types())))
  
  # flocker_data_input_types
  expect_true(
    all(
      grepl(
        paste0("^", 
               paste(flocker_data_input_types(), collapse = "|^")
               ),
        flocker_model_types()
        )
      )
    )
  for(i in seq_along(flocker_data_input_types())){
    expect_false(
      all(
        grepl(
          paste0("^", 
                 paste(flocker_data_input_types()[-i], collapse = "|^")
          ),
          flocker_model_types()
        )
      )
    )
  }
  
  # flocker_data_output_types
  expect_true(all(grepl("^single|^augmented|^multi", flocker_data_output_types())))
})

test_that("fdtl function returns expected dataframe", {
  # Call the fdtl function
  result <- fdtl()
  
  # Check if the result is a dataframe
  expect_is(result, "data.frame")
  
  # Check if the result has the correct column names
  expect_named(result, c("model_type", "data_output_type", "data_input_type"))
  
  # Check if the result has the correct number of rows (assuming 10 model types)
  expect_equal(nrow(result), 7)
  
  # Check if the result has the correct number of columns
  expect_equal(ncol(result), 3)
  
  # Check if the model_type column contains the expected values
  expect_identical(result$model_type, flocker_model_types())
  
  # Check if the data_output_type and data_input_type columns contain the expected values
  expected_data_input_types <- c(
    "single", "single", "augmented", "multi", "multi", "multi", "multi"
  )
  
  expected_data_output_types <- c(
    "single", "single_C", "augmented", "multi", "multi", "multi", "multi"
  )
  
  
  expect_identical(result$data_output_type, expected_data_output_types)
  expect_identical(result$data_input_type, expected_data_input_types)
})

test_that("is_flocker_fit works", {
  expect_true(is_flocker_fit(example_flocker_model_single))
  expect_false(is_flocker_fit("foo"))
  expect_false(is_flocker_fit(NULL))
  expect_false(is_flocker_fit(list(f = example_flocker_model_single)))
})

test_that("type_flocker_fit function returns expected string", {
  expect_identical(type_flocker_fit(example_flocker_model_single), "single")
  
  # Create a dummy flocker_fit object
  dummy_flocker_fit <- structure(
    list(),
    class = "flocker_fit",
    data_type = "multi",
    multiseason = "colex",
    multi_init = "equilibrium"
  )
  
  # Call the type_flocker_fit function
  result <- type_flocker_fit(dummy_flocker_fit)
  
  # Check if the result is a character string
  expect_is(result, "character")
  
  # Check if the result has the correct value
  expected_value <- "multi_colex_eq"
  expect_identical(result, expected_value)
  
  # Check if the function throws an error for non-flocker_fit objects
  non_flocker_fit <- list()
  expect_error(type_flocker_fit(non_flocker_fit), "x must be a flocker_fit object")
  
  # Check if the function throws an error for objects with missing or altered attributes
  corrupted_flocker_fit <- structure(
    list(),
    class = "flocker_fit",
    data_type = "MT1"
  )
  expect_error(type_flocker_fit(corrupted_flocker_fit), "the attributes of the flocker_fit object have been altered or corrupted")
})


test_that("get_positions works properly", {
  
  # single-season rep-varying
  sd <- simulate_flocker_data()
  fd <- make_flocker_data(
    sd$obs, sd$unit_covs, sd$event_covs, 
    type = "single")
  ps <- get_positions(fd)
  expect_true(
    all.equal(
      new_array(sd$event_covs$ec1, fd$data$ec1[ps]),
      sd$event_covs$ec1,
      check.attributes = FALSE
    )
  )
  ps2 <- get_positions(fd, unit_level = TRUE)
  expect_true(
    all.equal(
      fd$data$uc1[ps2],
      sd$unit_covs$uc1,
      check.attributes = FALSE
    )
  )
  
  # single-season rep-varying with missingness
  sd <- simulate_flocker_data(ragged_rep = TRUE)
  fd <- make_flocker_data(
    sd$obs, sd$unit_covs, sd$event_covs, 
    type = "single")
  ps <- get_positions(fd)
  expect_true(
    all.equal(
      new_array(sd$event_covs$ec1, fd$data$ec1[ps]),
      sd$event_covs$ec1,
      check.attributes = FALSE
    )
  )
  ps2 <- get_positions(fd, unit_level = TRUE)
  expect_true(
    all.equal(
      fd$data$uc1[ps2],
      sd$unit_covs$uc1,
      check.attributes = FALSE
    )
  )
  
  # single_season rep-constant
  sd <- simulate_flocker_data(rep_constant = TRUE)
  fd <- make_flocker_data(
    sd$obs, sd$unit_covs, 
    type = "single")
  ps <- get_positions(fd)
  expect_true(
    all.equal(
      fd$data$uc1[ps[,1]],
      sd$unit_covs$uc1,
      check.attributes = FALSE
    )
  )
  ps2 <- get_positions(fd, unit_level = TRUE)
  expect_true(
    all.equal(
      fd$data$uc1[ps2],
      sd$unit_covs$uc1,
      check.attributes = FALSE
    )
  )
  
  # single-season rep-constant with missingness
  sd <- simulate_flocker_data(rep_constant = TRUE, ragged_rep = TRUE)
  fd <- make_flocker_data(
    sd$obs, sd$unit_covs, 
    type = "single")
  ps <- get_positions(fd)
  expect_true(
    all.equal(
      fd$data$uc1[ps[,1]],
      sd$unit_covs$uc1,
      check.attributes = FALSE
    )
  )
  ps2 <- get_positions(fd, unit_level = TRUE)
  expect_true(
    all.equal(
      fd$data$uc1[ps2],
      sd$unit_covs$uc1,
      check.attributes = FALSE
    )
  )
  
  # augmented
  sd <- simulate_flocker_data(augmented = TRUE)
  fd <- make_flocker_data(
    sd$obs, sd$unit_covs, sd$event_covs, 
    type = "augmented", n_aug = 1)
  ps <- get_positions(fd)
  expect_true(
    all.equal(
      new_array(sd$event_covs$ec1, fd$data$ec1[ps]),
      sd$event_covs$ec1,
      check.attributes = FALSE
    )
  )
  ps2 <- get_positions(fd, unit_level = TRUE)
  expect_true(
    all.equal(
      fd$data$ec1[ps2],
      rep(sd$event_covs$ec1[,1], dim(sd$obs)[3]+1),
      check.attributes = FALSE
    )
  )
  
  # augmented with missingness
  sd <- simulate_flocker_data(augmented = TRUE, ragged_rep = TRUE)
  fd <- make_flocker_data(
    sd$obs, sd$unit_covs, sd$event_covs, 
    type = "augmented", n_aug = 1)
  ps <- get_positions(fd)
  expect_true(
    all.equal(
      new_array(sd$event_covs$ec1, fd$data$ec1[ps]),
      sd$event_covs$ec1,
      check.attributes = FALSE
    )
  )
  ps2 <- get_positions(fd, unit_level = TRUE)
  expect_true(
    all.equal(
      fd$data$ec1[ps2],
      rep(sd$event_covs$ec1[,1], dim(sd$obs)[3]+1),
      check.attributes = FALSE
    )
  )
  
  
  # multiseason
  sd <- simulate_flocker_data(
    n_pt = 10,
    n_sp = 1,
    n_season = 8,
    multiseason = "colex", 
    multi_init = "explicit"
  )
  fd <- make_flocker_data(
    sd$obs, sd$unit_covs, sd$event_covs, 
    type = "multi")
  ps <- get_positions(fd)
  expect_true(
    all.equal(
      new_array(sd$event_covs$ec1, fd$data$ec1[ps]),
      sd$event_covs$ec1,
      check.attributes = FALSE
    )
  )
  ps2 <- get_positions(fd, unit_level = TRUE)
  unit_covs_all <- sd$unit_covs[[1]]$uc1
  for(i in 2:8){
    unit_covs_all <- c(unit_covs_all, sd$unit_covs[[i]]$uc1)
  }
  expect_true(
    all.equal(
      fd$data$uc1[ps2],
      unit_covs_all,
      check.attributes = FALSE
    )
  )  
  
  
  # multiseason with missingness
  sd <- simulate_flocker_data(
    n_pt = 10,
    n_sp = 1,
    n_season = 8,
    multiseason = "colex", 
    multi_init = "explicit",
    ragged_rep = TRUE,
    missing_seasons = TRUE
  )
  suppressWarnings({
    fd <- make_flocker_data(
      sd$obs, sd$unit_covs, sd$event_covs, 
      type = "multi")
  })
  ps <- get_positions(fd)
  expect_true(
    all.equal(
      new_array(sd$event_covs$ec1, fd$data$ec1[ps]),
      sd$event_covs$ec1,
      check.attributes = FALSE
    )
  )
  ps2 <- get_positions(fd, unit_level = TRUE)
  # can't use unit covs here because they aren't NA in all relevant locations
  temp <- new_array(sd$obs[,1,], fd$data$ff_y[ps2])
  temp[temp == -99] <- NA
  expect_true(
    all.equal(
      temp,
      sd$obs[,1,],
      check.attributes = FALSE
    )
  )
  
  # multiseason with missingness for the whole first season
  sd <- simulate_flocker_data(
    n_pt = 10,
    n_sp = 1,
    n_season = 8,
    multiseason = "colex", 
    multi_init = "explicit",
    ragged_rep = TRUE,
    missing_seasons = TRUE
  )
  sd$obs[,,1] <- NA
  
  suppressWarnings({
    fd <- make_flocker_data(
      sd$obs, sd$unit_covs, sd$event_covs, 
      type = "multi")
  })

  ps <- get_positions(fd)
  expect_true(
    all.equal(
      new_array(sd$obs, fd$data$ff_y[ps]),
      sd$obs,
      check.attributes = FALSE
    )
  )
  ps2 <- get_positions(fd, unit_level = TRUE)
  # can't use unit covs here because they aren't NA in all relevant locations
  temp <- new_array(sd$obs[,1,], fd$data$ff_y[ps2])
  temp[temp == -99] <- NA
  expect_true(
    all.equal(
      temp,
      sd$obs[,1,],
      check.attributes = FALSE
    )
  )
})


test_that("emission_likelihood function returns expected output", {
  # Test cases for state 0
  obs1 <- matrix(c(0, 0, 0, 0, NA), nrow = 1)
  det1 <- matrix(c(0.3, 0.4, 0.5, 0.6, 0.7), nrow = 1)
  expected_output1 <- 1
  
  obs2 <- rbind(obs1, c(0, 1, 0, 1, 1))
  det2 <- rbind(det1, c(0.3, 0.4, 0.5, 0.6, 0.7))
  expected_output2 <- c(1,0)
  
  # Test cases for state 1
  obs3 <- matrix(c(1, 1, 0, 1, NA), nrow = 1)
  det3 <- matrix(c(0.3, 0.4, 0.5, 0.6, 0.7), nrow = 1)
  expected_output3 <- 0.3 * 0.4 * (1 - 0.5) * 0.6
  
  obs4 <- matrix(c(0, 0, 1, 1, 0), nrow = 1)
  det4 <- matrix(c(0.3, 0.4, 0.5, 0.6, 0.7), nrow = 1)
  expected_output4 <- (1 - 0.3) * (1 - 0.4) * 0.5 * 0.6 * (1 - 0.7)
  
  # Test the function with the test cases
  result1 <- emission_likelihood(0, obs1, det1)
  expect_identical(result1, expected_output1)
  
  result2 <- emission_likelihood(0, obs2, det2)
  expect_identical(result2, expected_output2)
  
  result3 <- emission_likelihood(1, obs3, det3)
  expect_identical(result3, expected_output3)
  
  result4 <- emission_likelihood(1, obs4, det4)
  expect_equal(result4, expected_output4)
  
  # Test the function with invalid inputs
  obs_invalid1 <- matrix(c(0, 1, -1, 1, 0), nrow = 1)
  obs_invalid2 <- matrix(c(0, 1, 2, 1, 0), nrow = 1)
  det_invalid1 <- matrix(c(0.5, 0.5, -0.5, 0.5, 0.5), nrow = 1)
  det_invalid2 <- matrix(c(0.5, 0.5, 1.5, 0.5, 0.5), nrow = 1)
  det_invalid3 <- matrix(c(NA, .5, .5, .5, .5), nrow = 1)
  
  expect_error(emission_likelihood(0, obs_invalid1, det1), "all\\(obs")
  expect_error(emission_likelihood(0, obs_invalid2, det1), "all\\(obs")
  expect_error(emission_likelihood(0, obs1, det_invalid1), "all\\(det")
  expect_error(emission_likelihood(0, obs1, det_invalid2), "all\\(det")
  expect_error(emission_likelihood(0, obs1, det_invalid3))
  expect_error(emission_likelihood(1, obs1, det_invalid3))
})


test_that("Z_from_emission returns correct values for valid inputs", {
  el0 <- c(0.1, 0.2, 0.3)
  el1 <- c(0.7, 0.8, 0.9)
  psi_unconditional <- c(0.4, 0.5, 0.6)
  expected_output <- psi_unconditional * el1 / 
    (psi_unconditional * el1 + (1 - psi_unconditional) * el0)
  expect_equal(Z_from_emission(el0, el1, psi_unconditional), expected_output)
})

test_that("Z_from_emission handles zeros and ones correctly", {
  el0 <- c(1, 0, 0)
  el1 <- c(0, 1, 1)
  psi_unconditional <- c(0, 1, 0.5)
  expected_output <- c(0, 1, 1) # When el0 is 0 and el1 is 1, the output should be 1
  expect_equal(Z_from_emission(el0, el1, psi_unconditional), expected_output)
})

test_that("Z_from_emission raises error with vectors of different lengths", {
  el0 <- c(0.1, 0.2)
  el1 <- c(0.7, 0.8, 0.9)
  psi_unconditional <- c(0.4, 0.5)
  expect_error(Z_from_emission(el0, el1, psi_unconditional))
})

test_that("Z_from_emission raises error with NA values in inputs", {
  el0 <- c(0.1, NA, 0.3)
  el1 <- c(0.7, 0.8, 0.9)
  psi_unconditional <- c(0.4, 0.5, 0.6)
  expect_error(Z_from_emission(el0, el1, psi_unconditional))
})

test_that("Z_from_emission raises error with negative values in inputs", {
  el0 <- c(0.1, -0.2, 0.3)
  el1 <- c(0.7, 0.8, 0.9)
  psi_unconditional <- c(0.4, 0.5, 0.6)
  expect_error(Z_from_emission(el0, el1, psi_unconditional))
})

test_that("Z_from_emission raises error with values greater than one in inputs", {
  el0 <- c(0.1, 0.2, 0.3)
  el1 <- c(1.1, 0.8, 0.9) # 1.1 is greater than 1
  psi_unconditional <- c(0.4, 0.5, 2.0) # 2.0 is greater than 1
  expect_error(Z_from_emission(el0, el1, psi_unconditional))
})

test_that("Z_from_emission handles equal emission likelihoods correctly", {
  el0 <- c(0.5, 0.5, 0.5)
  el1 <- c(0.5, 0.5, 0.5)
  psi_unconditional <- c(0.4, 0.5, 0.6)
  expected_output <- psi_unconditional / (psi_unconditional + (1 - psi_unconditional)) # Simplified formula for equal el0 and el1
  expect_equal(Z_from_emission(el0, el1, psi_unconditional), expected_output)
})

test_that("Z_from_emission handles scalar inputs correctly", {
  el0 <- 0.2
  el1 <- 0.8
  psi_unconditional <- 0.5
  expected_output <- 0.5 * 0.8 / (0.5 * 0.8 + (1 - 0.5) * 0.2)
  expect_equal(Z_from_emission(el0, el1, psi_unconditional), expected_output)
})

sd <- simulate_flocker_data()
fd_single <- make_flocker_data(sd$obs, sd$unit_covs, sd$event_covs)
fd_single_C <- make_flocker_data(sd$obs, sd$unit_covs)

sd <- simulate_flocker_data(augmented = TRUE)
fd_augmented <- make_flocker_data(sd$obs, sd$unit_covs, sd$event_covs, type = "augmented", n_aug = 10)

sd <- simulate_flocker_data(n_season = 3, multiseason = "colex", multi_init = "explicit")
fd_multi <- make_flocker_data(sd$obs, sd$unit_covs, sd$event_covs, type = "multi")

test_that("validate_flock_params works as expected", {
  f_occ <- ~ uc1
  f_det <- ~ uc1 + ec1
  f_col <- NULL
  f_ex <- NULL
  f_auto <- NULL
  flocker_data <- fd_single
  multiseason <- NULL
  multi_init <- NULL
  augmented <- FALSE
  threads <- NULL
  
  expect_silent(validate_flock_params(f_occ, f_det, flocker_data, multiseason, 
                                      f_col, f_ex, multi_init, f_auto, augmented, threads))
  
  
  f_occ <- ~ uc1 + ec1
  expect_error(validate_flock_params(f_occ, f_det, flocker_data, multiseason, 
                                      f_col, f_ex, multi_init, f_auto, augmented, threads))
  
  f_occ <- y ~ uc1
  expect_error(validate_flock_params(f_occ, f_det, flocker_data, multiseason, 
                                      f_col, f_ex, multi_init, f_auto, augmented, threads))
  
  flocker_data <- fd_single_C
  f_occ <- ~ uc1
  f_det <- ~ uc1
  
  expect_silent(validate_flock_params(f_occ, f_det, flocker_data, multiseason, 
                                     f_col, f_ex, multi_init, f_auto, augmented, threads))
  
  
  flocker_data <- fd_augmented
  f_det <- ~ uc1 + ec1
  augmented <- TRUE
  
  expect_silent(validate_flock_params(f_occ, f_det, flocker_data, multiseason, 
                                      f_col, f_ex, multi_init, f_auto, augmented, threads))
  
  
  flocker_data <- fd_multi
  expect_error(validate_flock_params(f_occ, f_det, flocker_data, multiseason, 
                                      f_col, f_ex, multi_init, f_auto, augmented, threads))
  augmented <- FALSE
  expect_error(validate_flock_params(f_occ, f_det, flocker_data, multiseason, 
                                     f_col, f_ex, multi_init, f_auto, augmented, threads))
  multiseason <- "colex"
  multi_init <- "explicit"
  expect_error(validate_flock_params(f_occ, f_det, flocker_data, multiseason, 
                                     f_col, f_ex, multi_init, f_auto, augmented, threads))
  f_col <- ~ uc1
  expect_error(validate_flock_params(f_occ, f_det, flocker_data, multiseason, 
                                     f_col, f_ex, multi_init, f_auto, augmented, threads))
  f_ex <- ~ uc1
  
  expect_silent(validate_flock_params(f_occ, f_det, flocker_data, multiseason, 
                                      f_col, f_ex, multi_init, f_auto, augmented, threads))
  
  multiseason <- "autologistic"
  multi_init <- "equilibrium"
  
  expect_error(validate_flock_params(f_occ, f_det, flocker_data, multiseason, 
                                     f_col, f_ex, multi_init, f_auto, augmented, threads))
  f_auto <- ~ uc1
  expect_error(validate_flock_params(f_occ, f_det, flocker_data, multiseason, 
                                     f_col, f_ex, multi_init, f_auto, augmented, threads))
  f_auto <- NULL
  f_occ <- NULL
  f_ex <- NULL
  expect_error(validate_flock_params(f_occ, f_det, flocker_data, multiseason, 
                                     f_col, f_ex, multi_init, f_auto, augmented, threads))
  f_auto <- ~ uc1
  expect_silent(validate_flock_params(f_occ, f_det, flocker_data, multiseason, 
                                     f_col, f_ex, multi_init, f_auto, augmented, threads))
})

test_that("formula_error works", {
  result <- formula_error("x")
  expect_is(result, "character")
  expect_identical(result, "Formula error: x formula has incorrect syntax.")
})

test_that("is_formula and is_flocker_formula work", {
  expect_true(is_formula(stats::formula(a ~ b)))
  expect_true(is_formula(stats::formula(~ b)))
  expect_true(is_formula(stats::formula(~1)))
  expect_true(is_formula(stats::formula(~ a ~ b)))
  
  expect_false(is_formula(1))
  expect_false(is_formula(list(stats::formula(~1), stats::formula(a ~ b))))
  
  expect_false(is_flocker_formula(stats::formula(a ~ b)))
  expect_false(is_flocker_formula(stats::formula(~ a ~ b)))
  expect_true(is_flocker_formula(stats::formula(~ b)))
  expect_true(is_flocker_formula(stats::formula(~ b + (1 || c))))
})

test_that("is_flocker_data works", {
  sfd <- simulate_flocker_data()
  expect_false(is_flocker_data(sfd))
  
  expect_true(
    make_flocker_data(sfd$obs, sfd$unit_covs) |>
      is_flocker_data()
  )
})  


test_that("is_named_list returns TRUE for a named list with unique names", {
  named_list <- list(a = 1, b = 2, c = 3)
  expect_true(is_named_list(named_list))
})

test_that("is_named_list returns FALSE for an unnamed list", {
  unnamed_list <- list(1, 2, 3)
  expect_false(is_named_list(unnamed_list))
})

test_that("is_named_list returns FALSE for a partially named list", {
  partially_named_list <- list(a = 1, 2, c = 3)
  expect_false(is_named_list(partially_named_list))
})

test_that("is_named_list returns FALSE for a named list with duplicate names", {
  duplicate_named_list <- list(a = 1, b = 2, a = 3)
  expect_false(is_named_list(duplicate_named_list))
})

test_that("is_named_list returns FALSE for an empty list", {
  empty_list <- list()
  expect_false(is_named_list(empty_list))
})

test_that("is_named_list returns FALSE for a non-list object", {
  non_list_object <- 42
  expect_false(is_named_list(non_list_object))
})

test_that("is_one_logical returns TRUE for a single logical value (TRUE)", {
  single_logical_true <- TRUE
  expect_true(is_one_logical(single_logical_true))
})

test_that("is_one_logical returns TRUE for a single logical value (FALSE)", {
  single_logical_false <- FALSE
  expect_true(is_one_logical(single_logical_false))
})

test_that("is_one_logical returns FALSE for a numeric value", {
  numeric_value <- 42
  expect_false(is_one_logical(numeric_value))
})

test_that("is_one_logical returns FALSE for a character value", {
  character_value <- "test"
  expect_false(is_one_logical(character_value))
})

test_that("is_one_logical returns FALSE for a vector of logical values", {
  logical_vector <- c(TRUE, FALSE)
  expect_false(is_one_logical(logical_vector))
})

test_that("is_one_logical returns FALSE for a NULL value", {
  null_value <- NULL
  expect_false(is_one_logical(null_value))
})

test_that("is_one_pos_int returns TRUE for a single positive integer greater than m", {
  single_positive_int <- 5
  m <- 3
  expect_true(is_one_pos_int(single_positive_int, m))
})

test_that("is_one_pos_int returns FALSE for a single positive integer equal to m", {
  single_positive_int <- 5
  m <- 5
  expect_false(is_one_pos_int(single_positive_int, m))
})

test_that("is_one_pos_int returns FALSE for a single positive integer less than m", {
  single_positive_int <- 3
  m <- 5
  expect_false(is_one_pos_int(single_positive_int, m))
})

test_that("is_one_pos_int returns FALSE for a single negative integer", {
  negative_int <- -5
  m <- 0
  expect_false(is_one_pos_int(negative_int, m))
})

test_that("is_one_pos_int returns FALSE for a single non-integer numeric value", {
  non_integer_numeric <- 2.5
  m <- 0
  expect_false(is_one_pos_int(non_integer_numeric, m))
})

test_that("is_one_pos_int returns FALSE for a character value", {
  character_value <- "test"
  m <- 0
  expect_false(is_one_pos_int(character_value, m))
})

test_that("is_one_pos_int returns FALSE for a vector of integers", {
  integer_vector <- c(2, 5, 8)
  m <- 0
  expect_false(is_one_pos_int(integer_vector, m))
})

test_that("is_one_pos_int returns FALSE for a NULL value", {
  null_value <- NULL
  m <- 0
  expect_false(is_one_pos_int(null_value, m))
})

test_that("shared_elements returns correct shared elements for two non-empty vectors", {
  vec1 <- c(1, 2, 3, 4, 5, 6)
  vec2 <- c(4, 5, 6, 7, 8, 9)
  expected_output <- c(4, 5, 6)
  expect_equal(shared_elements(vec1, vec2), expected_output)
})

test_that("shared_elements returns an empty vector when there are no shared elements", {
  vec1 <- c(1, 2, 3)
  vec2 <- c(4, 5, 6)
  expected_output <- integer(0)
  expect_equal(shared_elements(vec1, vec2), expected_output)
})

test_that("shared_elements handles vectors with duplicate elements correctly", {
  vec1 <- c(1, 1, 2, 2, 3, 3)
  vec2 <- c(2, 2, 3, 3, 4, 4)
  expected_output <- c(2, 3)
  expect_equal(shared_elements(vec1, vec2), expected_output)
})

test_that("shared_elements returns an empty vector when both input vectors are empty", {
  vec1 <- integer(0)
  vec2 <- integer(0)
  expected_output <- integer(0)
  expect_equal(shared_elements(vec1, vec2), expected_output)
})

test_that("shared_elements returns an empty vector when one input vector is empty", {
  vec1 <- c(1, 2, 3)
  vec2 <- integer(0)
  expected_output <- integer(0)
  expect_equal(shared_elements(vec1, vec2), expected_output)
})

test_that("shared_elements works with character vectors", {
  vec1 <- c("apple", "banana", "cherry")
  vec2 <- c("banana", "cherry", "date")
  expected_output <- c("banana", "cherry")
  expect_equal(shared_elements(vec1, vec2), expected_output)
})

test_that("shared_elements works with mixed-type vectors", {
  vec1 <- c(1, "apple", 2, "banana")
  vec2 <- c("banana", 2, "date", 3)
  expected_output <- c(2, "banana")
  expect_equal(shared_elements(vec1, vec2), expected_output)
})

test_that("max_position_not_na works correctly", {
  # Test with no NAs and no -99 values
  expect_equal(max_position_not_na(c(1, 2, 3, 4, 5)), 5)
  
  # Test with NAs only
  expect_equal(max_position_not_na(c(NA, NA, NA)), 0)
  
  # Test with -99 values treated as NAs
  expect_equal(max_position_not_na(c(1, 2, -99, 4, 5), treat_m99_NA = TRUE), 5)
  expect_equal(max_position_not_na(c(1, 2, -99, 4, -99), treat_m99_NA = TRUE), 4)
  
  # Test with NAs and -99 values at the end of the vector
  expect_equal(max_position_not_na(c(1, 2, 3, NA, -99), treat_m99_NA = TRUE), 3)
  expect_equal(max_position_not_na(c(1, 2, 3, NA, -99), treat_m99_NA = FALSE), 5)
  
  # Test with NAs and -99 values at the beginning of the vector
  expect_equal(max_position_not_na(c(NA, -99, 1, 2, 3), treat_m99_NA = TRUE), 5)
  expect_equal(max_position_not_na(c(NA, -99, 1, 2, 3), treat_m99_NA = FALSE), 5)
  
  # Test with non-numeric vector
  expect_equal(max_position_not_na(c("A", "B", "C", "D", "E")), 5)
  expect_equal(max_position_not_na(c("A", "B", "C", "D", "NA")), 5)
  expect_equal(max_position_not_na(c("A", "B", "C", "D", "-99"), treat_m99_NA = TRUE), 4)
})


test_that("remove_rownames works correctly", {
  # Test with a matrix
  m1 <- matrix(1:9, nrow = 3, ncol = 3, dimnames = list(c("r1", "r2", "r3"), c("c1", "c2", "c3")))
  m1_expected <- matrix(1:9, nrow = 3, ncol = 3, dimnames = list(c(), c("c1", "c2", "c3")))
  expect_equal(remove_rownames(m1), m1_expected)
  
  # Test with a data.frame
  df1 <- data.frame(a = 1:3, b = 4:6, row.names = c("r1", "r2", "r3"))
  df1_expected <- data.frame(a = 1:3, b = 4:6)
  expect_equal(remove_rownames(df1), df1_expected)
  
  # Test with a tibble
  if (requireNamespace("tibble", quietly = TRUE)) {
    tb1 <- tibble::tibble(a = 1:3, b = 4:6)
    suppressWarnings(rownames(tb1) <- c("r1", "r2", "r3"))
    tb1_expected <- tibble::tibble(a = 1:3, b = 4:6)
    expect_equal(remove_rownames(tb1), tb1_expected)
  }
})

test_that("rbinom2 works correctly", {
  r1 <- withr::with_seed(seed = 1, code = stats::rbinom(10, rep(c(1,2), 5), runif(10)))
  r2 <- withr::with_seed(seed = 1, code = rbinom2(10, rep(c(1,2), 5), runif(10)))
  expect_identical(r2, r1)
  r3 <- withr::with_seed(seed = 1, code = rbinom2(11, c(rep(c(1,2), 5), 1), c(runif(10), NA)))
  expect_identical(r3[1:10], r1)
  expect_true(is.na(r3[11]))
})