tests/testthat/test-essentials-cran.R

In hbsaems: Hierarchical Bayes Small Area Estimation Model using 'Stan'

# Essential tests for CRAN submission
# These tests are lightweight and focus on basic functionality

# Test data creation - simple and fast
create_test_data <- function(n = 20) {
  set.seed(123)
  data.frame(
    y = rnorm(n),
    x1 = rnorm(n),
    x2 = rnorm(n),
    group = factor(rep(1:4, length.out = n)),
    sre = factor(rep(1:4, length.out = n))
  )
}

create_binomial_data <- function(n = 20) {
  set.seed(123)
  data.frame(
    y = rbinom(n, size = 10, prob = 0.5),
    n = rep(10, n),
    x1 = rnorm(n),
    x2 = rnorm(n),
    group = factor(rep(1:4, length.out = n))
  )
}

create_beta_data <- function(n = 20) {
  set.seed(123)
  data.frame(
    y = rbeta(n, 2, 3),
    x1 = rnorm(n),
    x2 = rnorm(n),
    group = factor(rep(1:4, length.out = n))
  )
}

# Test 1: Basic hbm function
test_that("hbm basic functionality", {
  data <- create_test_data()
  
  # Test basic formula validation
  expect_error(hbm(123, data = data))
  expect_error(hbm(brms::bf(y ~ x1 + x2 + x4), data = data))
  expect_error(hbm(brms::bf(z ~ x1 + x2), data = data))
  
  # Test prior validation
  expect_error(hbm(brms::bf(y ~ x1 + x2), data = data, prior = "invalid_prior"))
  expect_error(hbm(brms::bf(y ~ x1 + x2), data = data, prior = 123))
})

# Test 2: hbm_binlogitnorm basic functionality
test_that("hbm_binlogitnorm basic functionality", {
  data <- create_binomial_data()
  
  # Test variable existence
  expect_error(hbm_binlogitnorm(response = "z_dir", trials = "n", 
                                predictors = c("x1", "x2"), data = data))
  expect_error(hbm_binlogitnorm(response = "y", trials = "n", 
                                predictors = c("x1", "x2", "x4"), data = data))
  expect_error(hbm_binlogitnorm(response = "y", trials = "m_i", 
                                predictors = c("x1", "x2"), data = data))
  
  # Test response validation
  data_wrong1 <- data
  data_wrong1$y[1] <- -1
  expect_error(hbm_binlogitnorm(response = "y", trials = "n", 
                                predictors = c("x1", "x2"), data = data_wrong1))
  
  data_wrong2 <- data
  data_wrong2$y[1] <- 101
  data_wrong2$n[1] <- 100
  expect_error(hbm_binlogitnorm(response = "y", trials = "n", 
                                predictors = c("x1", "x2"), data = data_wrong2))
  
  # Test prior validation
  expect_error(hbm_binlogitnorm(response = "y", trials = "n", 
                                predictors = c("x1", "x2"), data = data, 
                                prior = "invalid"))
})

# Test 3: hbm_betalogitnorm basic functionality
test_that("hbm_betalogitnorm basic functionality", {
  data <- create_beta_data()
  
  # Test variable existence
  expect_error(hbm_betalogitnorm(response = "invalid", 
                                 predictors = c("x1", "x2"), data = data))
  expect_error(hbm_betalogitnorm(response = "y", 
                                 predictors = c("invalid1", "invalid2"), data = data))
  
  # Test response validation
  data_wrong1 <- data
  data_wrong1$y[1] <- 2
  expect_error(hbm_betalogitnorm(response = "y", 
                                 predictors = c("x1", "x2"), data = data_wrong1))
  
  # Test prior validation
  expect_error(hbm_betalogitnorm(response = "y", 
                                 predictors = c("x1", "x2"), data = data, 
                                 prior = "invalid"))
})

# Test 4: hbm_lnln basic functionality
test_that("hbm_lnln basic functionality", {
  data <- create_test_data()
  data$y_obs <- exp(data$y)  # Make positive for log-normal
  
  # Test variable existence
  expect_error(hbm_lnln(response = "invalid_var", 
                        predictors = c("x1", "x2"), data = data))
  expect_error(hbm_lnln(response = "y_obs", 
                        predictors = c("invalid", "x2"), data = data))
  
  # Test response validation
  data_invalid1 <- data
  data_invalid1$y_obs[1] <- -1
  expect_error(hbm_lnln(response = "y_obs", 
                        predictors = c("x1", "x2"), data = data_invalid1))
  
  data_invalid2 <- data
  data_invalid2$y_obs[1] <- 0
  expect_error(hbm_lnln(response = "y_obs", 
                        predictors = c("x1", "x2"), data = data_invalid2))
  
  # Test prior validation
  expect_error(hbm_lnln(response = "y_obs", 
                        predictors = c("x1", "x2"), data = data, 
                        prior = "invalid_prior"))
})

# Test 5: Utility functions basic functionality
test_that("hbcc basic functionality", {
  # Test with invalid model input
  expect_error(hbcc(model = "not_a_model"))
  expect_error(hbcc(model = NULL))
})

test_that("hbmc basic functionality", {
  # Test with empty model list
  expect_error(hbmc(model = list()))
  
  # Test with non-model input
  expect_error(hbmc(model = list("not_a_model")))
})

test_that("hbsae basic functionality", {
  # Test with invalid model input
  expect_error(hbsae("invalid"))
})

test_that("hbpc basic functionality", {
  # Create dummy data for testing
  sample_data <- create_test_data()
  
  # Test with non-brms/hbmfit model
  expect_error(hbpc(model = lm(y ~ x1, data = sample_data), 
                    data = sample_data, response_var = "y"))
})

test_that("update_hbm basic functionality", {
  # Test with wrong model type
  fit_wrong <- "wrong"
  expect_error(update_hbm(fit_wrong, iter = 1000))
})

test_that("run_sae_app basic functionality", {
  # Check that the function is available in the package
  expect_true("run_sae_app" %in% ls("package:hbsaems"))
})

# Test 6: Missing data handling validation
test_that("Missing data parameter validation", {
  data <- create_test_data()
  data_miss <- data
  data_miss$y[1] <- NA
  data_miss$x1[2] <- NA
  
  # Test error when handle_missing not specified with missing data
  expect_error(hbm(brms::bf(y ~ x1 + x2), data = data_miss))
  
  # For binomial data
  data_binom <- create_binomial_data()
  data_binom_miss <- data_binom
  data_binom_miss$y[1] <- NA
  data_binom_miss$x1[2] <- NA
  
  expect_error(hbm_binlogitnorm(response = "y", trials = "n", 
                                predictors = c("x1", "x2"), 
                                data = data_binom_miss, 
                                handle_missing = "deleted"))
})

# Test 7: Spatial effects parameter validation
test_that("Spatial effects parameter validation", {
  data <- create_test_data()
  
  # Test invalid spatial effect type
  expect_error(hbm_binlogitnorm(response = "y", trials = "n", 
                                predictors = c("x1", "x2"), 
                                sre = "sre", sre_type = "invalid", 
                                data = create_binomial_data()))
  
  expect_error(hbm_betalogitnorm(response = "y", 
                                 predictors = c("x1", "x2"), 
                                 sre = "sre", sre_type = "invalid", 
                                 data = create_beta_data()))
  
  expect_error(hbm_lnln(response = "y_obs", 
                        predictors = c("x1", "x2"), 
                        sre = "sre", sre_type = "invalid", 
                        data = create_test_data()))
})

# Test 8: Basic adjacency matrix validation
test_that("Adjacency matrix basic validation", {
  data <- create_binomial_data()
  
  # Non-symmetric matrix
  adjacency_matrix_wrong <- matrix(c(0, 1, 1, 1, 0, 0), nrow = 2, byrow = TRUE)
  expect_error(hbm_binlogitnorm(response = "y", trials = "n", 
                                predictors = c("x1", "x2"), 
                                group = "group", sre = "group", 
                                sre_type = "car", car_type = "icar",
                                M = adjacency_matrix_wrong, data = data))
})

# Test 9: Basic data type validation
test_that("Basic data type validation", {
  # Test with non-data.frame input
  expect_error(hbm(brms::bf(y ~ x1), data = "not_a_dataframe"))
  expect_error(hbm_binlogitnorm(response = "y", trials = "n", 
                                predictors = c("x1"), data = "not_a_dataframe"))
  expect_error(hbm_betalogitnorm(response = "y", 
                                 predictors = c("x1"), data = "not_a_dataframe"))
  expect_error(hbm_lnln(response = "y", 
                        predictors = c("x1"), data = "not_a_dataframe"))
})

# Test 10: Edge cases for trials validation (binomial)
test_that("Trials validation edge cases", {
  data <- create_binomial_data()
  
  # Test with negative trials
  data_wrong3 <- data
  data_wrong3$n[1] <- -1
  data_wrong3$y[1] <- 0
  expect_error(hbm_binlogitnorm(response = "y", trials = "n", 
                                predictors = c("x1", "x2"), data = data_wrong3))
  
  # Test with NA in trials
  data_wrong_na <- data
  data_wrong_na$n[1] <- NA
  expect_error(hbm_binlogitnorm(response = "y", trials = "n", 
                                predictors = c("x1", "x2"), data = data_wrong_na))
})