.run_selected_test <- function(row, info, tolerance, seed, conf_level = 0.95, audit_level = "standard") {
  id <- row$id[[1L]]
  parameter <- row$parameter[[1L]]
  label <- row$test[[1L]]
  .safe_test(
    switch(
      id,
      row_order = .test_row_order(info, tolerance, seed),
      formula_order = .test_formula_order(info, tolerance),
      model_frame = .test_model_frame(info),
      prediction_reconstruction = .test_prediction_reconstruction(info, tolerance),
      weight_semantics = .test_weight_semantics(info, tolerance),
      predictor_rescaling = .test_predictor_rescaling(info, parameter, tolerance),
      factor_label_invariance = .test_factor_label_invariance(info, parameter, tolerance),
      focus_reference_reversal = .test_focus_reference(info, tolerance),
      outcome_translation = .test_outcome_translation(info, tolerance),
      outcome_scaling = .test_outcome_scaling(info, tolerance),
      known_effect_injection = .test_known_effect(info, tolerance),
      independent_qr = .test_independent_qr(info, tolerance),
      binary_outcome_reversal = .test_binary_outcome_reversal(info, tolerance),
      likelihood_reconstruction = .test_likelihood(info, tolerance),
      anova_cell_audit = .test_anova_cells(info),
      anova_term_order = .test_anova_term_order(info, tolerance),
      group_label_invariance = .test_group_label_invariance(info, parameter, tolerance),
      mixed_convergence = .test_mixed_convergence(info),
      mixed_singularity = .test_mixed_singularity(info, tolerance),
      optimizer_agreement = .test_optimizer_agreement(info, tolerance),
      random_structure = .test_random_structure(info),
      fixed_design_condition = .test_fixed_design_condition(info),
      design_support = .test_design_support(info),
      model_convergence = .test_model_convergence(info),
      residual_shape = .test_residual_shape(info),
      residual_variance = .test_residual_variance(info),
      glm_dispersion = .test_glm_dispersion(info),
      binomial_separation = .test_binomial_separation(info),
      case_influence = .test_case_influence(info),
      mixed_design_adequacy = .test_mixed_design_adequacy(info),
      group_influence = .test_group_influence(
        info, parameter, conf_level = conf_level,
        max_groups = if (identical(audit_level, "thorough")) 100L else 30L
      ),
      survival_time_scaling = .test_survival_time_scaling(info, tolerance),
      event_coding = .test_event_coding(info),
      cox_ph_assumption = .test_cox_ph_assumption(info),
      survival_information = .test_survival_information(info),
      survival_influence = .test_survival_influence(info),
      .sw_abort("Unknown witness test: ", id)
    ),
    id = id,
    label = label
  )
}

.certificate_status <- function(tests) {
  if (any(tests$status %in% c("FAIL", "ERROR") & tests$severity == "critical")) return("FAILED")
  if (any(tests$status %in% c("WARN", "FAIL", "ERROR"))) return("WARNING")
  "PASSED"
}

#' Generate a behavioral validation certificate
#'
#' Fits a supported statistical model, selects mathematically applicable
#' behavioral tests, applies controlled transformations, and checks whether
#' the analysis responds as expected.
#'
#' @param formula A model formula. Random-effect terms using `|` are supported
#'   when `lme4` is installed. `survival::Surv()` responses are supported when
#'   `survival` is installed.
#' @param data A data frame containing all analysis variables.
#' @param focus Optional coefficient, predictor, or omnibus term such as
#'   `"criterion:model"`. If omitted, the first estimable non-intercept
#'   coefficient is audited.
#' @param family Optional model family for GLM/GLMM analyses.
#' @param weights Optional numeric vector or data-column name.
#' @param method Fitting method: `"auto"`, `"lm"`, `"aov"`, `"glm"`,
#'   `"lmer"`, `"glmer"`, `"glmmTMB"`, `"coxph"`, or `"survreg"`.
#' @param engine Optional custom fitting function. It may accept any subset of
#'   `formula`, `data`, `family`, `weights`, `method`, and `control`.
#' @param control Optional model-specific control object.
#' @param conf_level Confidence level for coefficient intervals.
#' @param tolerance Relative numerical tolerance.
#' @param seed Seed used for deterministic perturbations.
#' @param include Optional character vector of test identifiers to retain.
#' @param exclude Optional character vector of test identifiers to omit.
#' @param audit_level Audit breadth: `"core"` runs integrity and numerical checks,
#'   `"standard"` adds assumptions and feasible influence checks, and
#'   `"thorough"` raises the limit for deletion-based group audits.
#' @return An object of class `statwitness_audit`.
#' @export
statwitness <- function(formula, data, focus = NULL, family = NULL,
                        weights = NULL, method = "auto", engine = NULL,
                        control = NULL, conf_level = 0.95,
                        tolerance = 1e-7, seed = 20260712,
                        include = NULL, exclude = NULL,
                        audit_level = c("standard", "core", "thorough")) {
  audit_level <- match.arg(audit_level)
  if (!inherits(formula, "formula")) .sw_abort("`formula` must be an R formula.")
  if (!is.data.frame(data)) .sw_abort("`data` must be a data frame.")
  if (!is.numeric(conf_level) || length(conf_level) != 1L || conf_level <= 0 || conf_level >= 1) {
    .sw_abort("`conf_level` must be a single number strictly between 0 and 1.")
  }
  if (!is.numeric(tolerance) || length(tolerance) != 1L || tolerance <= 0) {
    .sw_abort("`tolerance` must be a positive number.")
  }

  focus_expr <- substitute(focus)
  focus_value <- if (missing(focus) || identical(focus_expr, quote(NULL))) {
    NULL
  } else if (is.symbol(focus_expr) && as.character(focus_expr) %in% names(data)) {
    as.character(focus_expr)
  } else focus

  weights_expr <- substitute(weights)
  weights_vec <- if (missing(weights)) {
    NULL
  } else if (is.symbol(weights_expr) && as.character(weights_expr) %in% names(data)) {
    data[[as.character(weights_expr)]]
  } else .resolve_weights(data, weights, weights_expr, FALSE)

  resolved_method <- .detect_method(formula, family, method)
  model <- .fit_analysis(formula, data, family, weights_vec, resolved_method, engine, control)
  info <- .inspect_analysis(model, formula, data, focus_value, weights_vec, engine, resolved_method, control)
  primary <- .primary_result(info, conf_level)
  plan <- .build_plan(info, audit_level = audit_level)
  selected <- plan$selected
  if (!is.null(include)) selected <- selected[selected$id %in% include, , drop = FALSE]
  if (!is.null(exclude)) selected <- selected[!selected$id %in% exclude, , drop = FALSE]
  if (!nrow(selected)) .sw_abort("No validation tests remain after applying `include` and `exclude`.")

  results <- lapply(seq_len(nrow(selected)), function(i) {
    .run_selected_test(selected[i, , drop = FALSE], info, tolerance, seed + i, conf_level, audit_level)
  })
  tests <- do.call(rbind, lapply(results, .test_to_row))
  rownames(tests) <- NULL
  domains <- .domain_summary(tests)
  status <- .certificate_status(tests)
  data_fingerprint <- .md5_object(data)
  analysis_fingerprint <- .md5_object(list(
    formula = paste(deparse(formula), collapse = " "), method = resolved_method,
    focus = primary$label, family = info$family, link = info$link,
    coefficients = .fixed_coef(model), tests = tests,
    domains = domains, audit_level = audit_level,
    data_fingerprint = data_fingerprint
  ))
  certificate_id <- paste0("SW-", toupper(substr(analysis_fingerprint, 1L, 12L)))

  structure(list(
    call = match.call(), formula = formula, focus = info$focus,
    focus_coefficient = info$focus_coef, focus_term = info$focus_term,
    focus_kind = info$focus_kind, focus_inferred = info$focus_inferred,
    model = model, model_class = info$model_class, model_type = info$model_type,
    method = resolved_method, family = info$family, link = info$link,
    primary = primary, tests = tests, domains = domains,
    selected_plan = selected, skipped_plan = plan$skipped,
    status = status, audit_level = audit_level,
    certificate_id = certificate_id, data_fingerprint = data_fingerprint,
    analysis_fingerprint = analysis_fingerprint, tolerance = tolerance, seed = seed,
    limitations = c(
      "The certificate evaluates computational behavior and selected diagnostics under registered transformations.",
      "It does not establish causal validity, absence of confounding, data accuracy, or scientific appropriateness."
    )
  ), class = "statwitness_audit")
}
