.test_row_order <- function(info, tolerance, seed) {
  set.seed(seed)
  ord <- sample.int(nrow(info$data))
  d2 <- info$data[ord, , drop = FALSE]
  w2 <- if (is.null(info$weights)) NULL else info$weights[ord]
  m2 <- .refit(info, d2, weights = w2)
  ov <- .named_overlap(.fixed_coef(info$model), .fixed_coef(m2))
  ll1 <- .model_loglik(info$model)
  ll2 <- .model_loglik(m2)
  ok_coef <- .within_tol(ov$x, ov$y, tolerance * 100)
  ok_ll <- if (is.na(ll1) || is.na(ll2)) TRUE else .within_tol(ll1, ll2, tolerance * 100)
  ok <- ok_coef && ok_ll
  .new_test(
    "row_order", "Row-order invariance", if (ok) "PASS" else "FAIL",
    expected = "Equivalent fixed effects and likelihood after permuting rows.",
    observed = paste0("maximum fixed-effect difference = ", .format_num(.max_abs_diff(ov$x, ov$y)),
                      "; likelihood difference = ", .format_num(abs(ll1 - ll2))),
    details = if (ok) "The analysis was invariant to row order." else "The result changed after row permutation."
  )
}

.reordered_formula <- function(formula) {
  trm <- stats::terms(formula)
  labels <- rev(attr(trm, "term.labels"))
  response <- paste(deparse(formula[[2L]]), collapse = "")
  f2 <- stats::reformulate(labels, response = response, intercept = attr(trm, "intercept"))
  environment(f2) <- environment(formula)
  f2
}

.test_formula_order <- function(info, tolerance) {
  f2 <- .reordered_formula(info$formula)
  m2 <- .refit(info, info$data, formula = f2)
  ov <- .named_overlap(.fixed_coef(info$model), .fixed_coef(m2))
  p1 <- .model_fixed_prediction(info$model)
  p2 <- .model_fixed_prediction(m2)
  ok <- .within_tol(ov$x, ov$y, tolerance * 10) && .within_tol(p1, p2, tolerance * 10)
  .new_test(
    "formula_order", "Formula-order invariance", if (ok) "PASS" else "FAIL",
    expected = "Equivalent coefficients and predictions after reordering formula terms.",
    observed = paste0("maximum coefficient difference = ", .format_num(.max_abs_diff(ov$x, ov$y)),
                      "; maximum prediction difference = ", .format_num(.max_abs_diff(p1, p2))),
    details = if (ok) "Equivalent term order produced the same fitted analysis." else "Equivalent formula ordering changed the fitted result."
  )
}

.test_model_frame <- function(info) {
  vars <- intersect(.analysis_variables(info$formula), names(info$data))
  keep <- stats::complete.cases(info$data[vars])
  if (!is.null(info$weights)) keep <- keep & !is.na(info$weights)
  expected_n <- sum(keep)
  observed_n <- .model_nobs(info$model)
  mf <- .model_frame_safe(info$model)
  same_rows <- NA
  if (!is.null(mf)) {
    expected_rows <- rownames(info$data)[keep]
    observed_rows <- rownames(mf)
    same_rows <- identical(sort(expected_rows), sort(observed_rows))
  }
  ok <- expected_n == observed_n && (is.na(same_rows) || same_rows)
  .new_test(
    "model_frame", "Analysis-sample reconstruction", if (ok) "PASS" else "FAIL",
    expected = paste0(expected_n, " complete analysis rows reconstructed from the supplied data."),
    observed = paste0(observed_n, " rows in the fitted model; row identities matched = ", same_rows, "."),
    details = if (ok) "The fitted sample size and available row identities were reconstructed." else "The fitted sample did not match the supplied data and formula."
  )
}

.test_prediction_reconstruction <- function(info, tolerance) {
  model <- info$model
  X <- .model_matrix_fixed(model)
  beta <- .fixed_coef(model)
  estimable <- !is.na(beta)
  common <- intersect(colnames(X), names(beta)[estimable])
  eta <- drop(X[, common, drop = FALSE] %*% beta[common])
  mf <- .model_frame_safe(model)
  if (!is.null(mf)) {
    off <- stats::model.offset(mf)
    if (!is.null(off)) eta <- eta + off
  }
  observed <- .model_fixed_prediction(model)
  if (info$model_class == "coxph") {
    eta <- eta - mean(eta)
    observed <- observed - mean(observed)
  }
  ok <- .within_tol(eta, observed, tolerance * 100)
  .new_test(
    "prediction_reconstruction", "Fixed-prediction reconstruction", if (ok) "PASS" else "FAIL",
    expected = "Fixed-effect predictions reconstructed from the model matrix and coefficients.",
    observed = paste0("maximum reconstruction difference = ", .format_num(.max_abs_diff(eta, observed))),
    details = if (ok) "The fixed-effect linear predictor was independently reconstructed." else "Stored predictions disagree with the reconstructed fixed-effect calculation."
  )
}

.test_predictor_rescaling <- function(info, variable, tolerance) {
  d2 <- info$data
  d2[[variable]] <- d2[[variable]] * 10
  m2 <- .refit(info, d2)
  c1 <- .fixed_coef(info$model)
  c2 <- .fixed_coef(m2)
  expected <- c1
  if (!variable %in% names(c1)) {
    return(.new_test("predictor_rescaling", paste0("Predictor-unit rescaling: ", variable), "ERROR",
      expected = "A direct coefficient for the rescaled predictor.",
      observed = "No coefficient with the predictor name was found.",
      details = "This test supports simple numeric main effects only."))
  }
  expected[[variable]] <- expected[[variable]] / 10
  ov <- .named_overlap(expected, c2)
  p1 <- .model_fixed_prediction(info$model)
  p2 <- .model_fixed_prediction(m2)
  ok <- .within_tol(ov$x, ov$y, tolerance * 100) && .within_tol(p1, p2, tolerance * 100)
  .new_test(
    "predictor_rescaling", paste0("Predictor-unit rescaling: ", variable), if (ok) "PASS" else "FAIL",
    expected = paste0("The ", variable, " coefficient divides by 10 while fixed predictions remain unchanged."),
    observed = paste0("coefficient difference from expectation = ", .format_num(.max_abs_diff(ov$x, ov$y)),
                      "; maximum prediction difference = ", .format_num(.max_abs_diff(p1, p2))),
    details = if (ok) "Changing predictor units propagated correctly." else "Changing predictor units did not propagate as expected."
  )
}

.test_focus_reference <- function(info, tolerance) {
  v <- info$focus
  d2 <- info$data
  d2[[v]] <- factor(d2[[v]])
  old_levels <- levels(d2[[v]])
  d2[[v]] <- stats::relevel(d2[[v]], ref = old_levels[[2L]])
  m2 <- .refit(info, d2)
  c1 <- .fixed_coef(info$model)[[info$focus_coef]]
  candidates <- names(.fixed_coef(m2))[startsWith(names(.fixed_coef(m2)), v)]
  candidates <- candidates[!grepl(":", candidates, fixed = TRUE)]
  candidates <- candidates[!is.na(.fixed_coef(m2)[candidates])]
  if (length(candidates) != 1L) {
    return(.new_test("focus_reference_reversal", "Focus-reference reversal", "ERROR",
      expected = "Exactly one reversed focus coefficient.",
      observed = paste(length(candidates), "candidate coefficients found."),
      details = "The factor parameterization could not be matched automatically."))
  }
  c2 <- .fixed_coef(m2)[[candidates[[1L]]]]
  p1 <- .model_fixed_prediction(info$model)
  p2 <- .model_fixed_prediction(m2)
  ok <- .within_tol(c2, -c1, tolerance * 100) && .within_tol(p1, p2, tolerance * 100)
  .new_test(
    "focus_reference_reversal", "Focus-reference reversal", if (ok) "PASS" else "FAIL",
    expected = "The focus coefficient reverses sign while fixed predictions remain unchanged.",
    observed = paste0("original = ", .format_num(c1), "; reversed = ", .format_num(c2),
                      "; maximum prediction difference = ", .format_num(.max_abs_diff(p1, p2))),
    details = if (ok) "Reference-category reversal behaved as expected." else "Reference-category reversal changed more than the parameterization."
  )
}

.test_factor_label_invariance <- function(info, variable, tolerance) {
  d2 <- info$data
  x <- factor(d2[[variable]])
  levels(x) <- paste0("SW_LEVEL_", seq_along(levels(x)))
  d2[[variable]] <- x
  m2 <- .refit(info, d2)
  p1 <- .model_fixed_prediction(info$model)
  p2 <- .model_fixed_prediction(m2)
  ll1 <- .model_loglik(info$model)
  ll2 <- .model_loglik(m2)
  ok <- .within_tol(p1, p2, tolerance * 100) && (is.na(ll1) || .within_tol(ll1, ll2, tolerance * 100))
  .new_test(
    "factor_label_invariance", paste0("Factor-label invariance: ", variable), if (ok) "PASS" else "FAIL",
    expected = "Renaming factor labels without changing membership preserves predictions and likelihood.",
    observed = paste0("maximum prediction difference = ", .format_num(.max_abs_diff(p1, p2)),
                      "; likelihood difference = ", .format_num(abs(ll1 - ll2))),
    details = if (ok) "Factor labels were treated as labels rather than data values." else "Renaming factor labels changed the fitted analysis."
  )
}

.effective_model_weights <- function(model) {
  if (inherits(model, "glm")) return(model$prior.weights)
  if (inherits(model, "lm")) return(model$weights)
  if (inherits(model, "merMod")) return(tryCatch(stats::weights(model), error = function(e) NULL))
  if (inherits(model, "coxph")) return(model$weights)
  NULL
}

.test_weight_semantics <- function(info, tolerance) {
  vars <- intersect(.analysis_variables(info$formula), names(info$data))
  keep <- stats::complete.cases(info$data[vars]) & !is.na(info$weights)
  expected_original <- info$weights[keep]
  observed_original <- .effective_model_weights(info$model)
  if (is.null(observed_original)) {
    return(.new_test("weight_semantics", "Weight-semantics validation", "FAIL",
      expected = "The fitted model records the supplied analysis weights.",
      observed = "The fitted model contains no accessible effective weights.",
      details = "The fitting engine may have ignored the supplied weights."))
  }
  perturbed <- info$weights
  idx <- which(!is.na(perturbed))
  perturbed[idx] <- perturbed[idx] * rep(c(1, 2), length.out = length(idx))
  m2 <- .refit(info, info$data, weights = perturbed)
  observed_perturbed <- .effective_model_weights(m2)
  expected_perturbed <- perturbed[keep]
  original_ok <- .within_tol(expected_original, observed_original, tolerance * 100)
  perturbed_ok <- !is.null(observed_perturbed) && .within_tol(expected_perturbed, observed_perturbed, tolerance * 100)
  ok <- original_ok && perturbed_ok
  .new_test(
    "weight_semantics", "Weight-semantics validation", if (ok) "PASS" else "FAIL",
    expected = "Original and deliberately perturbed weights reach the fitting engine.",
    observed = paste0("original maximum difference = ", .format_num(.max_abs_diff(expected_original, observed_original)),
                      "; perturbed maximum difference = ", .format_num(.max_abs_diff(expected_perturbed, observed_perturbed))),
    details = if (ok) "The weight vectors reached the original and perturbed fits." else "The fitting engine did not preserve supplied weight semantics."
  )
}
