tests/testthat/test-static-p025-stability.R

In exdqlm: Extended Dynamic Quantile Linear Models

skip_on_cran()

# Regression coverage for the static p0 = 0.25 benchmark that previously
# produced non-finite LDVB warm starts and downstream MCMC warnings.

static_p025_benchmark <- function(n = 60L, seed = 20260409L) {
  set.seed(seed)
  x <- sort(stats::runif(n, -2, 2))
  X <- cbind(1, x)
  mu <- 0 + 0.5 * x
  sigma <- 1.2 + 0.35 * x
  y <- mu + sigma * stats::rnorm(n)
  list(y = y, X = X)
}

test_that("positive truncated-normal helper stays valid in the extreme left tail", {
  moms <- exdqlm:::.exdqlm_pos_truncnorm_moments(
    mu = c(-10, -100, -1000, -1e10),
    tau2 = c(1, 1e-2, 1e-3, 0.625)
  )

  expect_true(all(is.finite(moms$mean)))
  expect_true(all(is.finite(moms$second)))
  expect_true(all(moms$mean > 0))
  expect_true(all(moms$second >= moms$mean^2))
})

test_that("static LDVB p0=0.25 benchmark converges with finite state", {
  dat <- static_p025_benchmark()

  expect_warning(
    fit <- exdqlm::exalStaticLDVB(
      y = dat$y,
      X = dat$X,
      p0 = 0.25,
      max_iter = 160,
      tol = 1e-4,
      verbose = FALSE
    ),
    NA
  )

  expect_true(isTRUE(fit$converged))
  expect_true(all(is.finite(fit$qbeta$m)))
  expect_true(all(is.finite(fit$qv$E_v)))
  expect_true(all(is.finite(fit$qv$E_inv_v)))
  expect_true(all(is.finite(fit$qs$E_s)))
  expect_true(all(is.finite(fit$qs$E_s2)))
  expect_true(is.finite(fit$qsiggam$gamma_mean))
  expect_true(is.finite(fit$qsiggam$sigma_mean))
  expect_true(fit$diagnostics$ld_block$xi$stabilized_iter_count >= 0L)
  expect_true(isTRUE(fit$diagnostics$ld_block$mode_quality$local_mode_pass))
  expect_true(isTRUE(fit$diagnostics$convergence$ld_signoff_ready))
  expect_false(isTRUE(fit$diagnostics$ld_block$stabilization$active_final))
})

test_that("static LDVB avoids the gamma=0 bad mode on the ex4 seed", {
  set.seed(20260706L)
  x <- seq(-2, 2, length.out = 180L)
  X <- cbind(1, x)
  mu <- 0.5 * x
  sigma <- 1.2 + 0.35 * x
  y <- mu + sigma * stats::rnorm(length(x))

  expect_warning(
    fit <- exdqlm::exalStaticLDVB(
      y = y,
      X = X,
      p0 = 0.25,
      max_iter = 220,
      tol = 1e-4,
      verbose = FALSE
    ),
    NA
  )

  expect_true(isTRUE(fit$converged))
  expect_true(all(is.finite(fit$qbeta$m)))
  expect_lt(abs(fit$qbeta$m[1]), 10)
  expect_lt(abs(fit$qbeta$m[2]), 10)
  expect_gt(fit$qsiggam$gamma_mean, 0.1)
  expect_true(isTRUE(fit$diagnostics$ld_block$mode_quality$local_mode_pass))
  expect_true(isTRUE(fit$diagnostics$convergence$ld_signoff_ready))
  expect_false(isTRUE(fit$diagnostics$ld_block$stabilization$active_final))
})

test_that("static MCMC slice warm start is clean on the p0=0.25 benchmark", {
  dat <- static_p025_benchmark()

  expect_warning(
    fit <- exdqlm::exalStaticMCMC(
      y = dat$y,
      X = dat$X,
      p0 = 0.25,
      n.burn = 15,
      n.mcmc = 15,
      thin = 1,
      mh.proposal = "slice",
      init.from.vb = TRUE,
      vb_init_controls = list(
        max_iter = 80,
        tol = 1e-4,
        verbose = FALSE
      ),
      verbose = FALSE
    ),
    NA
  )

  expect_true(all(is.finite(as.numeric(fit$samp.beta))))
  expect_true(all(is.finite(as.numeric(fit$samp.sigma))))
  expect_true(all(is.finite(as.numeric(fit$samp.gamma))))
  expect_identical(fit$mh.diagnostics$proposal, "slice")
  expect_true(isTRUE(fit$init.from.vb))
})