.test_outcome_translation <- function(info, tolerance) {
  yname <- info$response_name
  d2 <- info$data
  y <- d2[[yname]]
  shift <- stats::sd(y, na.rm = TRUE)
  if (!is.finite(shift) || shift == 0) shift <- 1
  d2[[yname]] <- y + shift
  m2 <- .refit(info, d2)
  expected <- .fixed_coef(info$model)
  if ("(Intercept)" %in% names(expected)) expected[["(Intercept)"]] <- expected[["(Intercept)"]] + shift
  observed <- .fixed_coef(m2)
  ov <- .named_overlap(expected, observed)
  sigma1 <- .model_sigma(info$model)
  sigma2 <- .model_sigma(m2)
  sd1 <- .random_sd_vector(info$model)
  sd2 <- .random_sd_vector(m2)
  sdov <- .named_overlap(sd1, sd2)
  ok_sigma <- if (is.na(sigma1) || is.na(sigma2)) TRUE else .within_tol(sigma1, sigma2, tolerance * 100)
  ok_random <- if (!length(sdov$x)) TRUE else .within_tol(sdov$x, sdov$y, tolerance * 100)
  ok <- .within_tol(ov$x, ov$y, tolerance * 100) && ok_sigma && ok_random
  .new_test(
    "outcome_translation", "Outcome translation", if (ok) "PASS" else "FAIL",
    expected = "Adding a constant changes only the fixed intercept and leaves scale parameters unchanged.",
    observed = paste0("maximum fixed-effect difference from expectation = ", .format_num(.max_abs_diff(ov$x, ov$y)),
                      "; residual-scale difference = ", .format_num(abs(sigma1 - sigma2)),
                      "; maximum random-SD difference = ", .format_num(.max_abs_diff(sdov$x, sdov$y))),
    details = if (ok) "Outcome translation propagated correctly." else "The model did not respond correctly to outcome translation."
  )
}

.test_outcome_scaling <- function(info, tolerance) {
  yname <- info$response_name
  d2 <- info$data
  d2[[yname]] <- d2[[yname]] * 10
  m2 <- .refit(info, d2)
  expected <- .fixed_coef(info$model) * 10
  observed <- .fixed_coef(m2)
  ov <- .named_overlap(expected, observed)
  p1 <- .model_p_values(info$model)
  p2 <- .model_p_values(m2)
  pv <- .named_overlap(p1, p2)
  sigma1 <- .model_sigma(info$model)
  sigma2 <- .model_sigma(m2)
  sd1 <- .random_sd_vector(info$model)
  sd2 <- .random_sd_vector(m2)
  sdov <- .named_overlap(10 * sd1, sd2)
  ok_sigma <- if (is.na(sigma1) || is.na(sigma2)) TRUE else .within_tol(10 * sigma1, sigma2, tolerance * 100)
  ok_random <- if (!length(sdov$x)) TRUE else .within_tol(sdov$x, sdov$y, tolerance * 100)
  ok <- .within_tol(ov$x, ov$y, tolerance * 100) && .within_tol(pv$x, pv$y, tolerance * 100) && ok_sigma && ok_random
  .new_test(
    "outcome_scaling", "Outcome-unit scaling", if (ok) "PASS" else "FAIL",
    expected = "Fixed effects and Gaussian scale parameters multiply by 10 while p-values remain unchanged.",
    observed = paste0("maximum fixed-effect difference = ", .format_num(.max_abs_diff(ov$x, ov$y)),
                      "; maximum p-value difference = ", .format_num(.max_abs_diff(pv$x, pv$y)),
                      "; residual-scale difference = ", .format_num(abs(10 * sigma1 - sigma2)),
                      "; maximum random-SD difference = ", .format_num(.max_abs_diff(sdov$x, sdov$y))),
    details = if (ok) "Outcome-unit conversion propagated correctly." else "Outcome scaling did not propagate as expected."
  )
}

.test_known_effect <- function(info, tolerance) {
  d2 <- info$data
  yname <- info$response_name
  y <- d2[[yname]]
  delta <- stats::sd(y, na.rm = TRUE) / 2
  if (!is.finite(delta) || delta == 0) delta <- 1
  if (info$focus_binary_factor) {
    xfac <- factor(d2[[info$focus]])
    x <- as.numeric(xfac == levels(xfac)[[2L]])
  } else {
    x <- d2[[info$focus]]
  }
  d2[[yname]] <- y + delta * x
  m2 <- .refit(info, d2)
  expected <- .fixed_coef(info$model)
  expected[[info$focus_coef]] <- expected[[info$focus_coef]] + delta
  observed <- .fixed_coef(m2)
  ov <- .named_overlap(expected, observed)
  ok <- .within_tol(ov$x, ov$y, tolerance * 100)
  .new_test(
    "known_effect_injection", "Known-effect injection", if (ok) "PASS" else "FAIL",
    expected = paste0("Injecting ", .format_num(delta), " units adds that amount to the focus coefficient."),
    observed = paste0("expected focus coefficient = ", .format_num(expected[[info$focus_coef]]),
                      "; observed = ", .format_num(observed[[info$focus_coef]])),
    details = if (ok) "The known injected linear effect was recovered." else "The injected effect was not recovered as expected."
  )
}

.test_independent_qr <- function(info, tolerance) {
  model <- info$model
  X <- stats::model.matrix(model)
  y <- stats::model.response(stats::model.frame(model))
  if (!is.null(model$offset)) y <- y - model$offset
  w <- .effective_model_weights(model)
  if (is.null(w)) w <- rep(1, nrow(X))
  sw <- sqrt(w)
  q <- qr(X * sw)
  beta <- qr.coef(q, y * sw)
  names(beta) <- colnames(X)
  ov <- .named_overlap(stats::coef(model), beta)
  ok <- .within_tol(ov$x, ov$y, tolerance * 10)
  .new_test(
    "independent_qr", "Independent weighted-QR coefficient calculation", if (ok) "PASS" else "FAIL",
    expected = "Coefficients match a separately executed weighted QR solution.",
    observed = paste0("maximum coefficient difference = ", .format_num(.max_abs_diff(ov$x, ov$y))),
    details = if (ok) "The coefficient vector was independently reconstructed." else "The fitted coefficients disagree with the weighted QR calculation."
  )
}

.test_anova_cells <- function(info) {
  vars <- info$factor_predictors
  tab <- do.call(table, c(info$data[vars], useNA = "no"))
  values <- as.numeric(tab)
  empty <- sum(values == 0)
  positive <- values[values > 0]
  ratio <- if (length(positive)) max(positive) / min(positive) else Inf
  status <- if (empty > 0) "WARN" else "PASS"
  .new_test(
    "anova_cell_audit", "ANOVA cell-structure audit", status, severity = "warning",
    expected = "All factor combinations are represented; imbalance is reported transparently.",
    observed = paste0("empty cells = ", empty, "; largest/smallest non-empty cell ratio = ", .format_num(ratio)),
    details = if (empty > 0) "At least one design cell is empty; omnibus effects may depend strongly on hypothesis parameterization." else "No empty design cells were found. Cell-size imbalance is reported but not judged automatically."
  )
}

.test_anova_term_order <- function(info, tolerance) {
  if (info$focus_kind != "term") {
    return(.new_test("anova_term_order", "ANOVA term-order sensitivity", "WARN", severity = "warning",
      expected = "An omnibus focus term is supplied.", observed = "The focus is coefficient-level.",
      details = "Term-order sensitivity is most meaningful for omnibus ANOVA terms."))
  }
  get_sequential_p <- function(model, term) {
    tab <- stats::anova(model)
    idx <- match(term, rownames(tab))
    pcol <- grep("Pr\\(", colnames(tab), value = TRUE)
    if (is.na(idx) || !length(pcol)) return(NA_real_)
    unname(tab[idx, pcol[[1L]]])
  }
  f2 <- .reordered_formula(info$formula)
  m2 <- .refit(info, info$data, formula = f2)
  p1 <- get_sequential_p(info$model, info$focus_term)
  p2 <- get_sequential_p(m2, info$focus_term)
  diff <- abs(p1 - p2)
  status <- if (is.na(diff) || diff <= tolerance * 100) "PASS" else "WARN"
  .new_test(
    "anova_term_order", "ANOVA term-order sensitivity", status, severity = "warning",
    expected = "The sequential omnibus result is stable to an equivalent term ordering.",
    observed = paste0("original sequential p-value = ", .format_num(p1), "; reordered p-value = ", .format_num(p2)),
    details = if (status == "PASS") "No material Type-I term-order sensitivity was detected." else "The sequential ANOVA result changed with term ordering; report the sums-of-squares and hypothesis convention explicitly."
  )
}
