tests/testthat/test-edge-cases.R

In bayesqm: Bayesian Q Methodology: Probabilistic Factor Analysis

test_that("run_bayes rejects K_max < 1 before any sampling", {
  Y <- matrix(sample(-2:2, 50, replace = TRUE), nrow = 10, ncol = 5)
  expect_error(run_bayes(Y, K_max = 0),  "positive integer")
  expect_error(run_bayes(Y, K_max = -1), "positive integer")
})

test_that("compute_divergence works when K = 2 and J is small", {
  set.seed(1L)
  F_draws <- array(rnorm(100 * 3 * 2), c(100, 3, 2))
  out <- compute_divergence(F_draws, delta = 1.0)
  expect_length(out$pi_D, 3)
  expect_true(all(out$pi_D >= 0 & out$pi_D <= 1))
})

test_that("compute_divergence returns NA probabilities when delta is NULL", {
  set.seed(1L)
  F_draws <- array(rnorm(50 * 5 * 2), c(50, 5, 2))
  dimnames(F_draws) <- list(NULL, paste0("S", 1:5), c("f1", "f2"))
  out <- compute_divergence(F_draws)
  expect_length(out$pi_D, 5)
  expect_true(all(is.na(out$pi_D)))
  expect_true(all(is.na(out$pi_C)))
})

test_that("compute_dominant_prob rows sum to 1 across factors", {
  set.seed(1L)
  L <- array(rnorm(200 * 4 * 3), c(200, 4, 3))
  p <- compute_dominant_prob(L)
  expect_true(all(abs(rowSums(p) - 1) < 1e-8))
})

test_that("full posterior-summary pipeline works with K = 1", {
  fit <- make_fake_fit(N = 5, J = 9, K = 1, T = 120)
  loads <- compute_loadings(fit$Lambda_draws)
  zs    <- compute_zscores(fit$F_draws)
  thr   <- compute_threshold_prob(fit$Lambda_draws, threshold = 0.3)
  dom   <- compute_dominant_prob(fit$Lambda_draws)

  expect_equal(nrow(loads), 5)
  expect_equal(nrow(zs),    9)
  expect_equal(dim(thr),    c(5, 1))
  expect_equal(dim(dom),    c(5, 1))
  expect_true(all(dom == 1))  # only one factor to be dominant on
})

test_that("classify_membership returns tiers in the expected order of levels", {
  set.seed(1L)
  # Construct loadings where participant 1 loads strongly on factor 1,
  # participant 2 loads weakly on every factor.
  L <- array(rnorm(300 * 3 * 2), c(300, 3, 2))
  L[, 1, 1] <- L[, 1, 1] + 6    # very strong -> "Strong"
  L[, 2, 1] <- L[, 2, 1] + 0.3  # weak lead
  cls <- classify_membership(L)
  expect_true(all(levels(cls$tier) == c("Strong", "Moderate", "Weak")))
  expect_equal(as.character(cls$tier[1]), "Strong")
})

test_that("compute_posterior_scalars strips NA before summarising", {
  draws <- list(nu = c(rnorm(50, 20, 2), NA, NA),
                sigma = rnorm(52, 1, 0.1),
                all_na = rep(NA_real_, 52))
  out <- compute_posterior_scalars(draws, prob = 0.9)
  # all_na vector should be dropped (zero non-NA entries)
  expect_equal(sort(out$parameter), c("nu", "sigma"))
})

test_that("qsort_data infers distribution from column 1 when NULL", {
  grid <- c(-2, -1, 0, 1, 2)
  Y <- cbind(c(grid, grid), sample(c(grid, grid)))
  obj <- qsort_data(Y)
  expect_equal(obj$distribution, c(2L, 2L, 2L, 2L, 2L))
})

test_that("validate_qsort flags distribution mismatches with a warning message", {
  Y <- matrix(c(-2, -1, 0, 1, 2,
                -2, -2, 0, 0, 2), ncol = 2)  # column 2 not forced
  obj <- suppressMessages(suppressWarnings(
    qsort_data(Y, distribution = c(1, 1, 1, 1, 1), validate = FALSE)))
  v <- validate_qsort(obj)
  expect_true(length(v$warnings) > 0 || length(v$issues) > 0)
})

test_that("update.bayesqm_fit reuses stored data through a bare Y binding", {
  fit <- make_fake_fit(N = 4, J = 8, K = 2)
  # evaluate=FALSE returns the call; Y must be a bare symbol, not inline data.
  cl <- update(fit, K = 3, evaluate = FALSE)
  expect_equal(as.character(cl$Y), "Y")
  expect_true(is.null(dim(cl$Y)))
})