# Argument validation: every exported function must fail early with a message
# that names the offending argument.

sim <- simulate_var_example(T = 80, seed = 7)
Y   <- sim$Y

test_that("post_sim validates its inputs", {
    expect_error(post_sim(as.data.frame(Y), p = 1L, R = 5L), "numeric matrix")
    expect_error(post_sim(Y[, 1, drop = FALSE], p = 1L, R = 5L), "at least 2 columns")
    Yna <- Y; Yna[3, 2] <- NA
    expect_error(post_sim(Yna, p = 1L, R = 5L), "missing")
    expect_error(post_sim(Y, p = 0, R = 5L), "`p`")
    expect_error(post_sim(Y, p = 1.5, R = 5L), "`p`")
    expect_error(post_sim(Y, p = nrow(Y), R = 5L), "`p`")
    expect_error(post_sim(Y, p = 1L, R = 0), "`R`")
    expect_error(post_sim(Y, p = 1L, R = 5L, kappa3 = -1), "`kappa3`")
    expect_error(post_sim(Y, p = 1L, R = 5L, var_names = c("a", "b")), "`var_names`")
})

test_that("build_yX, build_s2 and optim_hyper validate their inputs", {
    expect_error(build_yX(Y, p = -1), "`p`")
    expect_error(build_yX(c(1, 2, 3), p = 1), "numeric matrix")
    expect_error(build_s2(list("a")), "numeric vectors")
    dat <- build_yX(Y, 1L); s2 <- build_s2(dat$y_list)$s2
    expect_error(optim_hyper(dat$y_list, dat$X_list[1:2], 1L, s2), "same length")
    expect_error(optim_hyper(dat$y_list, dat$X_list, 1L, s2[1:2]), "`s2`")
    expect_error(optim_hyper(dat$y_list, dat$X_list, 1L, -s2), "`s2`")
    expect_error(optim_hyper(dat$y_list, dat$X_list, 1L, s2, init = c(0.1, -0.1)), "`init`")
})

test_that("sign_restrict validates mcmc, S and the integer arguments", {
    mcmc <- post_sim(Y, p = 1L, R = 5L)
    S <- rbind(c(1, -1, 0), c(1, 1, 0), c(-1, -1, 1))
    expect_error(sign_restrict(list(), S), "post_sim")
    expect_error(sign_restrict(mcmc, S[, 1:2]), "columns")
    S2 <- S; S2[1, 1] <- 2
    expect_error(sign_restrict(mcmc, S2), "\\{-1, 0, 1\\}")
    S0 <- S; S0[3, ] <- 0
    expect_error(sign_restrict(mcmc, S0), "all zero")
    expect_error(sign_restrict(mcmc, S, n_id = 4), "`n_id`")
    expect_error(sign_restrict(mcmc, S, max_tries = 0), "`max_tries`")
    expect_error(sign_restrict(mcmc, S, verbose = NA), "`verbose`")
})

test_that("collect_irfs, compute_irf and plot_irfs validate their inputs", {
    mcmc <- post_sim(Y, p = 1L, R = 5L)
    S <- rbind(c(1, -1, 0), c(1, 1, 0), c(-1, -1, 1))
    acc <- sign_restrict(mcmc, S, max_tries = 500L, verbose = FALSE)
    expect_error(collect_irfs(list(), n = 3L, p = 1L, H = 4L), "empty")
    expect_error(collect_irfs(acc, n = 2L, p = 1L, H = 4L), "`n` = 2")
    expect_error(collect_irfs(acc, n = 3L, p = 2L, H = 4L), "`p` = 2")
    expect_error(collect_irfs(acc, n = 3L, p = 1L, H = -1), "`H`")
    expect_error(compute_irf(acc[[1]]$impact, acc[[1]]$B_rf[, 1:2], 3L, 1L, 4L), "`B_rf`")
    irfs <- collect_irfs(acc, n = 3L, p = 1L, H = 4L)
    expect_error(plot_irfs(irfs[, , , 1]), "4-dimensional")
    expect_error(plot_irfs(irfs, probs = c(0.9, 0.1)), "`probs`")
    expect_error(plot_irfs(irfs, var_names = "x"), "`var_names`")
})

test_that("recover_rf and simulate_var_example validate their inputs", {
    expect_error(recover_rf(list(1, 2), c(1)), "same length")
    expect_error(recover_rf(list(1, 2), c(1, -1)), "positive variances")
    expect_error(simulate_var_example(T = 3), "`T`")
})

test_that("check_S accepts a matrix or a 3-d array and rejects the rest", {
    S <- rbind(c(1, -1, 0), c(1, 1, 0))
    a <- acpbvar:::check_S(S, 3, horizons = 2L)
    expect_equal(dim(a), c(2, 3, 3))
    expect_true(all(a[, , 2] == S))
    A <- array(0, c(2, 3, 3)); A[1, 1, ] <- 1; A[2, 2, 2] <- -1
    expect_equal(dim(acpbvar:::check_S(A, 3, horizons = 2L)), c(2, 3, 3))
    expect_error(acpbvar:::check_S(A, 3, horizons = 1L), "slices")
    A0 <- A; A0[2, , ] <- 0
    expect_error(acpbvar:::check_S(A0, 3, horizons = 2L), "all zero")
    expect_error(acpbvar:::check_S(1:3, 3), "3-d array")
    sim  <- simulate_var_example(T = 80, seed = 7)
    mcmc <- post_sim(sim$Y, p = 1L, R = 5L)
    expect_error(sign_restrict(mcmc, S, horizons = -1), "`horizons`")
    expect_error(sign_restrict(mcmc, S, horizons = 1.5), "`horizons`")
})

test_that("build_s2 matches an OLS AR(4) fit with intercept (mean squared residuals)", {
    sim <- simulate_var_example(T = 150, seed = 3)
    dat <- build_yX(sim$Y, p = 1L)
    s2  <- build_s2(dat$y_list)$s2
    y   <- dat$y_list[[2]]
    E   <- embed(y, 5)
    r   <- residuals(lm(E[, 1] ~ E[, 2:5]))
    expect_equal(s2[2], mean(r^2))
    expect_equal(build_s2(list(c(1, 2, 3, 2)))$s2, var(c(1, 2, 3, 2)))   # too short: sample variance
})

test_that("elicit = 'reduced' adds the Supplement Section 2 correction and leaves the rest unchanged", {
    sim <- simulate_var_example(T = 120, seed = 1)
    dat <- build_yX(sim$Y, p = 1L)
    s2  <- build_s2(dat$y_list)$s2
    a <- build_prior_asym(dat$y_list, 1L, s2, 0.04, 0.004)
    b <- build_prior_asym(dat$y_list, 1L, s2, 0.04, 0.004, elicit = "reduced")

    expect_equal(b$V_beta[[1]], a$V_beta[[1]])                        # first equation unchanged
    expect_equal(b$V_beta[[2]], a$V_beta[[2]] + a$V_beta[[1]])        # one addend
    expect_equal(b$V_beta[[3]], a$V_beta[[3]] + a$V_beta[[1]] + a$V_beta[[2]])
    expect_equal(b$m_beta, a$m_beta)                                  # means unchanged
    expect_equal(b$V_alpha, a$V_alpha)
    expect_equal(b$nu, a$nu)
    expect_equal(b$S, a$S)

    # unit-root mean: equation 2 also receives m_1^2 / s2_1 at the first own lag of variable 1
    au <- build_prior_asym(dat$y_list, 1L, s2, 0.04, 0.004, unit_root_mean = TRUE)
    bu <- build_prior_asym(dat$y_list, 1L, s2, 0.04, 0.004, unit_root_mean = TRUE, elicit = "reduced")
    expect_equal(bu$V_beta[[2]] - (au$V_beta[[2]] + au$V_beta[[1]]), c(0, 1 / s2[1], 0, 0))

    expect_error(build_prior_asym(dat$y_list, 1L, s2, 0.04, 0.004, elicit = "foo"))
})