test_that("four dispersed chain initializations are generated and validated", {
  inits <- ambs:::.make_chain_inits("ww", c(0.2, 0.5, 1, 2), NULL)
  expect_length(inits, 4)
  expect_equal(length(unique(vapply(inits, `[[`, numeric(1), "alpha"))), 4)
  expect_equal(length(unique(vapply(inits, `[[`, numeric(1), "p"))), 4)
  expect_error(
    ambs:::.make_chain_inits(
      "ww", c(0.2, 1), list(alpha = 0, p = 1, k1 = 2, th1 = 1, k2 = 2, th2 = 2)
    ),
    "initial p"
  )
})

test_that("proposal scales adapt during burn-in and then remain valid", {
  set.seed(441)
  fit <- suppressWarnings(alpmixsurv(
    c(0.2, 0.4, 0.7, 1, 1.5, 2), c(1, 1, 1, 0, 1, 0),
    model = "ww", mcmc = list(nburn = 100, nsamp = 20), ident = "none"
  ))
  expect_length(fit$chains, 1)
  expect_true(all(vapply(fit$chains, nrow, integer(1)) == 20))
  expect_equal(nrow(fit$posterior), 20)
  expect_length(fit$proposal_scales, 1)
  initial_scales <- c(alpha = 0.05, p = 0.20, th1 = 0.10,
                      th2 = 0.10, k1 = 0.10, k2 = 0.10)
  expect_false(isTRUE(all.equal(fit$proposal_scales[[1]], initial_scales)))
  expect_true(all(is.finite(fit$proposal_scales[[1]])))
  expect_true(all(fit$proposal_scales[[1]] > 0))
  expect_true(all(is.finite(fit$acceptance_warmup)))
  expect_true(all(fit$acceptance >= 0 & fit$acceptance <= 1))
  expect_equal(fit$convergence$status, "not_assessed")
  expect_true(fit$sampling$status %in% c("ok", "check"))
  expect_true(fit$block_proposals[[1]]$enabled)
  expect_length(fit$block_proposals[[1]]$parameters, 3)
  expect_true(all(is.finite(fit$block_proposals[[1]]$covariance)))
  expect_true(is.finite(fit$block_proposals[[1]]$acceptance))
})

test_that("adaptation helper moves scales in the acceptance-rate direction", {
  out <- ambs:::.adapt_scales(
    c(slow = 0.1, fast = 0.1), accepted = c(5, 45),
    attempted = c(50, 50), batch_index = 1
  )
  expect_lt(out["slow"], 0.1)
  expect_gt(out["fast"], 0.1)
})

test_that("block target includes transformed-scale Jacobians", {
  prior <- ambs:::.default_prior("ww")
  values <- c(alpha = 0.2, p = 0.4, k1 = 1.5, th1 = 0.8,
              k2 = 2.1, th2 = 1.7)
  old <- ambs:::.to_unconstrained("ww", values)
  new <- old
  new["log_th1"] <- log(1.1)
  time <- c(0.2, 0.5, 1, 2)
  status <- c(1, 1, 0, 1)
  implemented <-
    ambs:::.block_log_target("ww", new, time, status, prior) -
    ambs:::.block_log_target("ww", old, time, status, prior)
  expected <-
    ambs:::.logpost_th1_ww(
      values["alpha"], values["p"], 1 - values["p"], 1.1, values["th2"],
      values["k1"], values["k2"], time, status, 1, 1
    ) -
    ambs:::.logpost_th1_ww(
      values["alpha"], values["p"], 1 - values["p"], values["th1"],
      values["th2"], values["k1"], values["k2"], time, status, 1, 1
    ) + log(1.1 / values["th1"])
  expect_equal(unname(implemented), unname(expected), tolerance = 1e-10)
})

test_that("mcmcdiag adds three chains and computes multi-chain diagnostics", {
  set.seed(442)
  fit <- suppressWarnings(alpmixsurv(
    c(0.2, 0.4, 0.7, 1, 1.5, 2), c(1, 1, 1, 0, 1, 0),
    model = "ww", mcmc = list(nburn = 10, nsamp = 20), ident = "none"
  ))
  fit4 <- suppressWarnings(mcmcdiag(fit, seed = 443))
  expect_length(fit4$chains, 4)
  expect_equal(nrow(fit4$posterior), 80)
  expect_equal(fit4$convergence$chains, 4)
  expect_true(fit4$convergence$status %in% c("ok", "check"))
  expect_true(isTRUE(fit4$diagnosed))
  expect_equal(length(fit$chains), 1)
  expect_error(mcmcdiag(fit4), "exactly one chain")
})

test_that("WW arithmetic-mixture likelihood remains finite for separated components", {
  time <- c(0.0015, seq(0.1, 20, length.out = 500))
  status <- rep(c(0, 1), length.out = length(time))
  ll <- ambs:::.loglik_ww(
    1, 0.75, 0.25, 1.52, 7.25, 3, 1.5, time, status
  )
  expect_true(is.finite(ll))
})

test_that("R-hat detects a shifted chain and ESS detects autocorrelation", {
  set.seed(99)
  make_chain <- function(mu = 0) {
    x <- rnorm(400, mu)
    cbind(alpha = x, p = plogis(rnorm(400)), loglik = -x^2)
  }
  stable <- replicate(4, make_chain(), simplify = FALSE)
  shifted <- stable
  shifted[[4]][, "alpha"] <- shifted[[4]][, "alpha"] + 3
  expect_lt(ambs:::.split_rhat(stable)["alpha"], 1.05)
  expect_gt(ambs:::.split_rhat(shifted)["alpha"], 1.05)

  independent <- replicate(4, make_chain(), simplify = FALSE)
  correlated <- lapply(seq_len(4), function(i) {
    e <- rnorm(400)
    x <- stats::filter(e, 0.95, method = "recursive")
    cbind(alpha = as.numeric(x), p = plogis(rnorm(400)), loglik = -as.numeric(x)^2)
  })
  expect_gt(ambs:::.effective_size(independent)["alpha"],
            ambs:::.effective_size(correlated)["alpha"])
})

test_that("getcurve returns draw-wise posterior intervals", {
  posterior <- rbind(
    c(alpha = 0, p = 0.3, k1 = 1.5, th1 = 0.8, k2 = 2, th2 = 2, loglik = -1),
    c(alpha = 0.5, p = 0.4, k1 = 1.7, th1 = 1, k2 = 2.2, th2 = 2.3, loglik = -2),
    c(alpha = 1, p = 0.5, k1 = 2, th1 = 1.2, k2 = 2.5, th2 = 2.6, loglik = -3)
  )
  object <- list(posterior = posterior, model = "ww", time = c(0.2, 2))
  plot_file <- tempfile(fileext = ".pdf")
  grDevices::pdf(plot_file)
  on.exit({ grDevices::dev.off(); unlink(plot_file) }, add = TRUE)
  curve <- getcurve(object, type = "s", t = c(0.3, 1, 1.8), level = 0.8)
  expect_named(curve, c("time", "estimate", "lower", "upper"))
  expect_true(all(curve$lower <= curve$estimate))
  expect_true(all(curve$estimate <= curve$upper))
  direct <- apply(vapply(seq_len(nrow(posterior)), function(i) {
    ambs:::.curve_ww(posterior[i, ], c(0.3, 1, 1.8), "s")
  }, numeric(3)), 1, stats::median)
  expect_equal(curve$estimate, direct)
})

test_that("model criteria remain finite for extremely small likelihoods", {
  posterior <- cbind(
    alpha = seq(-0.1, 0.1, length.out = 20),
    p = rep(0.5, 20), mu1 = rep(0, 20), mu2 = rep(1, 20),
    sig1 = rep(0.5, 20), sig2 = rep(0.7, 20),
    loglik = rep(-3000, 20)
  )
  pointwise <- matrix(rep(c(-900, -1000, -1100), each = 20), nrow = 20)
  criteria <- ambs:::.criteria_from_loglik(
    posterior, pointwise, c(1, 2, 3), c(1, 0, 1), model = "ll"
  )
  expect_true(all(is.finite(unlist(criteria))))
})