#' List the behavioral tests known to statwitness
#'
#' @return A data frame describing built-in validation tests, audit domains,
#'   and supported model families.
#' @export
witness_registry <- function() {
  ids <- c(
    "row_order", "formula_order", "model_frame", "prediction_reconstruction",
    "factor_label_invariance", "predictor_rescaling", "focus_reference_reversal",
    "outcome_translation", "outcome_scaling", "known_effect_injection",
    "independent_qr", "binary_outcome_reversal", "likelihood_reconstruction",
    "anova_cell_audit", "anova_term_order", "weight_semantics",
    "fixed_design_condition", "design_support", "model_convergence", "case_influence",
    "residual_shape", "residual_variance", "glm_dispersion",
    "binomial_separation", "group_label_invariance", "mixed_convergence",
    "mixed_singularity", "optimizer_agreement", "random_structure",
    "mixed_design_adequacy", "group_influence", "survival_time_scaling",
    "event_coding", "cox_ph_assumption", "survival_information",
    "survival_influence", "rm_design_integrity", "rm_row_order",
    "rm_id_label", "rm_outcome_translation", "rm_outcome_scaling",
    "rm_sphericity", "rm_residual_shape", "rm_id_influence"
  )
  models <- c(
    "all supported", "lm, aov, glm", "all supported", "all supported",
    "factor predictors", "simple numeric predictors", "two-level focus factors",
    "Gaussian lm/lmer/glmmTMB", "Gaussian lm/lmer/glmmTMB", "Gaussian lm/lmer",
    "lm/aov", "binomial glm", "binomial or Poisson glm",
    "factorial lm/aov", "factorial lm/aov", "weighted supported models",
    "all fixed-effect model matrices", "all supported", "glm/coxph/survreg and closed-form models",
    "lm/aov/glm", "Gaussian lm/aov/lmer", "Gaussian lm/aov/lmer",
    "glm/glmer/glmmTMB", "binomial glm/glmer/glmmTMB",
    "lmer/glmer/glmmTMB", "lmer/glmer/glmmTMB", "lmer/glmer/glmmTMB",
    "lmer/glmer", "lmer/glmer/glmmTMB", "lmer/glmer/glmmTMB",
    "lmer/glmer/glmmTMB", "coxph", "coxph/survreg", "coxph",
    "coxph/survreg", "coxph/survreg", "repeated-measures ANOVA",
    "repeated-measures ANOVA", "repeated-measures ANOVA",
    "repeated-measures ANOVA", "repeated-measures ANOVA",
    "repeated-measures ANOVA", "repeated-measures ANOVA",
    "repeated-measures ANOVA"
  )
  purpose <- c(
    "Checks invariance to row order.",
    "Checks invariance to equivalent ordering of fixed-effect terms.",
    "Reconstructs the analysis sample from supplied variables.",
    "Reconstructs fixed-effect predictions from the design matrix.",
    "Renames factor labels while preserving membership.",
    "Changes units of simple numeric predictors.",
    "Reverses a two-level reference category.",
    "Adds a constant to a Gaussian outcome.",
    "Rescales a Gaussian outcome.",
    "Injects a known linear effect.",
    "Recomputes ordinary linear coefficients by weighted QR.",
    "Reverses a 0/1 logit outcome.",
    "Reconstructs supported GLM likelihoods.",
    "Reports empty and unbalanced ANOVA cells.",
    "Checks sensitivity of an omnibus ANOVA term to term ordering.",
    "Checks that supplied and perturbed weights reach the fit.",
    "Checks fixed-effect rank and numerical conditioning.",
    "Reports basic observation, parameter, residual-df, and factor-level support.",
    "Inspects model-specific convergence indicators.",
    "Screens ordinary models with Cook's distance.",
    "Screens Gaussian residual asymmetry and tail heaviness.",
    "Screens residual-variance changes across fitted values.",
    "Checks Pearson dispersion for generalized models.",
    "Screens binomial models for numerical signs of separation.",
    "Renames random-effect grouping labels.",
    "Inspects mixed-model optimizer convergence diagnostics.",
    "Detects singular or boundary random-effect structures.",
    "Refits lme4 models with an alternative optimizer.",
    "Summarizes random-effect variance and correlation boundaries.",
    "Compares within-cluster predictors with registered random slopes.",
    "Refits after deleting one grouping level at a time.",
    "Changes Cox-model survival time units.",
    "Checks event-indicator coding.",
    "Runs Schoenfeld-residual proportional-hazards diagnostics.",
    "Reports event information relative to fitted model size.",
    "Screens survival DFBETA influence.",
    "Checks duplicate and missing subject-condition cells.",
    "Checks repeated-ANOVA invariance to row order.",
    "Renames participant identifiers.",
    "Adds a constant to the repeated outcome.",
    "Rescales the repeated outcome.",
    "Checks whether a sphericity correction is declared when relevant.",
    "Screens residual shape from the repeated-measures fit.",
    "Refits after deleting one participant at a time when feasible."
  )
  data.frame(
    id = ids,
    domain = vapply(ids, .test_domain, character(1)),
    models = models,
    purpose = purpose,
    stringsAsFactors = FALSE
  )
}

.build_plan <- function(info, audit_level = "standard") {
  audit_level <- match.arg(audit_level, c("core", "standard", "thorough"))
  selected <- list()
  skipped <- list()
  add_selected <- function(id, label, parameter = NA_character_) {
    selected[[length(selected) + 1L]] <<- data.frame(
      id = id, test = label, parameter = parameter, status = "SELECTED",
      domain = .test_domain(id), reason = "Applicable to this analysis.",
      stringsAsFactors = FALSE)
  }
  add_skipped <- function(id, label, reason) {
    skipped[[length(skipped) + 1L]] <<- data.frame(
      id = id, test = label, parameter = NA_character_, status = "SKIPPED",
      domain = .test_domain(id), reason = reason, stringsAsFactors = FALSE)
  }

  # Shared integrity and numerical domains.
  add_selected("row_order", "Row-order invariance")
  add_selected("model_frame", "Analysis-sample reconstruction")
  add_selected("prediction_reconstruction", "Fixed-prediction reconstruction")
  add_selected("fixed_design_condition", "Fixed-effect design conditioning")
  add_selected("design_support", "Basic design-support audit")

  if (!info$is_mixed && !info$is_survival && length(info$term_labels) > 1L) {
    add_selected("formula_order", "Formula-order invariance")
  } else {
    add_skipped("formula_order", "Formula-order invariance", "Formula reordering is limited to non-mixed, non-survival fixed-effect formulas.")
  }

  if (info$weights_supplied) add_selected("weight_semantics", "Weight-semantics validation") else
    add_skipped("weight_semantics", "Weight-semantics validation", "No analysis weights were supplied.")

  if (length(info$factor_predictors)) {
    for (v in info$factor_predictors) add_selected("factor_label_invariance", paste0("Factor-label invariance: ", v), v)
  } else add_skipped("factor_label_invariance", "Factor-label invariance", "No simple factor predictors were found.")

  eligible_numeric <- intersect(info$numeric_predictors, info$simple_only_predictors)
  if (length(eligible_numeric)) {
    for (v in eligible_numeric) add_selected("predictor_rescaling", paste0("Predictor-unit rescaling: ", v), v)
  } else add_skipped("predictor_rescaling", "Predictor-unit rescaling", "No simple numeric predictor outside an interaction was found.")

  if (info$focus_kind == "coefficient" && info$focus_binary_factor && !info$focus_in_interaction) {
    add_selected("focus_reference_reversal", "Focus-reference reversal", info$focus)
  } else add_skipped("focus_reference_reversal", "Focus-reference reversal", "Requires a coefficient-level two-level factor focus outside an interaction.")

  gaussian_models <- c("lm", "aov", "lmerMod", "glmmTMB")
  is_gaussian <- info$model_class %in% gaussian_models && .is_gaussian_identity(info)
  if (is_gaussian && info$response_simple && info$response_name %in% names(info$data) && is.numeric(info$data[[info$response_name]])) {
    if (info$has_intercept) add_selected("outcome_translation", "Outcome translation") else
      add_skipped("outcome_translation", "Outcome translation", "Requires an intercept.")
    add_selected("outcome_scaling", "Outcome-unit scaling")
    if (info$focus_kind == "coefficient" && !info$focus_in_interaction &&
        (info$focus %in% eligible_numeric || info$focus_binary_factor) && info$model_class != "glmmTMB") {
      add_selected("known_effect_injection", "Known-effect injection", info$focus)
    } else add_skipped("known_effect_injection", "Known-effect injection", "Requires a simple coefficient-level focus in a supported Gaussian model.")
  } else {
    add_skipped("outcome_translation", "Outcome translation", "Only defined for direct Gaussian identity-link outcomes.")
    add_skipped("outcome_scaling", "Outcome-unit scaling", "Only defined for direct Gaussian identity-link outcomes.")
    add_skipped("known_effect_injection", "Known-effect injection", "Only defined for supported Gaussian models with a simple focus.")
  }

  if (info$model_class %in% c("lm", "aov")) add_selected("independent_qr", "Independent weighted-QR coefficient calculation") else
    add_skipped("independent_qr", "Independent weighted-QR coefficient calculation", "Only applies to ordinary linear models.")

  # Ordinary linear/ANOVA domains.
  if (info$model_class %in% c("lm", "aov")) {
    add_selected("model_convergence", "Model convergence audit")
    if (audit_level != "core") {
      add_selected("case_influence", "Case-level influence screening")
      add_selected("residual_shape", "Residual-shape screening")
      add_selected("residual_variance", "Residual-variance screening")
    }
  }

  # GLM domains.
  if (info$model_class == "glm") {
    add_selected("model_convergence", "Model convergence audit")
    y <- stats::model.response(stats::model.frame(info$model))
    if (info$family == "binomial" && info$link == "logit" && is.numeric(y) && all(y %in% c(0, 1))) {
      add_selected("binary_outcome_reversal", "Binary-outcome reversal")
    } else add_skipped("binary_outcome_reversal", "Binary-outcome reversal", "Requires a Bernoulli 0/1 outcome with a logit link.")
    if ((info$family == "binomial" && is.numeric(y) && all(y %in% c(0, 1))) || info$family == "poisson") {
      add_selected("likelihood_reconstruction", "Independent log-likelihood reconstruction")
    } else add_skipped("likelihood_reconstruction", "Independent log-likelihood reconstruction", "Supports Bernoulli-binomial and Poisson GLMs.")
    if (audit_level != "core") {
      add_selected("glm_dispersion", "Generalized-model dispersion audit")
      add_selected("case_influence", "Case-level influence screening")
      if (info$family == "binomial" && info$link == "logit") {
        add_selected("binomial_separation", "Binomial separation screening")
      }
    }
  } else {
    add_skipped("binary_outcome_reversal", "Binary-outcome reversal", "Currently implemented for ordinary GLMs.")
    add_skipped("likelihood_reconstruction", "Independent log-likelihood reconstruction", "Currently implemented for ordinary GLMs.")
  }

  # Factorial ANOVA domains.
  if (info$model_class %in% c("lm", "aov") && info$all_factor_design && length(info$factor_predictors) >= 2L) {
    add_selected("anova_cell_audit", "ANOVA cell-structure audit")
    add_selected("anova_term_order", "ANOVA term-order sensitivity")
  } else {
    add_skipped("anova_cell_audit", "ANOVA cell-structure audit", "Requires at least two simple factor predictors in an ordinary linear model.")
    add_skipped("anova_term_order", "ANOVA term-order sensitivity", "Requires a factorial ordinary linear model.")
  }

  # Mixed models get parallel numerical, design, assumption, and influence domains.
  if (info$is_mixed) {
    for (v in info$random_groups) add_selected("group_label_invariance", paste0("Grouping-label invariance: ", v), v)
    add_selected("mixed_convergence", "Mixed-model convergence audit")
    add_selected("mixed_singularity", "Random-effects singularity audit")
    add_selected("random_structure", "Random-effects structure summary")
    add_selected("mixed_design_adequacy", "Random-effects design audit")
    if (info$model_class %in% c("lmerMod", "glmerMod")) add_selected("optimizer_agreement", "Alternative-optimizer agreement") else
      add_skipped("optimizer_agreement", "Alternative-optimizer agreement", "Currently implemented for lme4 models.")
    if (audit_level != "core") {
      for (v in info$random_groups) add_selected("group_influence", paste0("Group-deletion influence: ", v), v)
      if (is_gaussian) {
        add_selected("residual_shape", "Residual-shape screening")
        add_selected("residual_variance", "Residual-variance screening")
      } else {
        add_selected("glm_dispersion", "Generalized-model dispersion audit")
        if (info$family == "binomial" && info$link == "logit") add_selected("binomial_separation", "Binomial separation screening")
      }
    }
  } else {
    add_skipped("group_label_invariance", "Grouping-label invariance", "No random-effect grouping factor was detected.")
    add_skipped("mixed_convergence", "Mixed-model convergence audit", "Not a mixed-effects model.")
    add_skipped("mixed_singularity", "Random-effects singularity audit", "Not a mixed-effects model.")
    add_skipped("random_structure", "Random-effects structure summary", "Not a mixed-effects model.")
    add_skipped("mixed_design_adequacy", "Random-effects design audit", "Not a mixed-effects model.")
    add_skipped("optimizer_agreement", "Alternative-optimizer agreement", "Not an lme4 mixed-effects model.")
    add_skipped("group_influence", "Group-deletion influence", "Not a mixed-effects model.")
  }

  # Survival domains.
  if (info$is_survival) {
    add_selected("model_convergence", "Model convergence audit")
    if (info$model_class == "coxph") add_selected("survival_time_scaling", "Survival-time unit scaling") else
      add_skipped("survival_time_scaling", "Survival-time unit scaling", "Automatic time-unit invariance is currently certified for Cox models only.")
    add_selected("event_coding", "Event-coding audit")
    add_selected("survival_information", "Survival information audit")
    if (info$model_class == "coxph") add_selected("cox_ph_assumption", "Proportional-hazards diagnostic") else
      add_skipped("cox_ph_assumption", "Proportional-hazards diagnostic", "Only applies to Cox models.")
    if (audit_level != "core") add_selected("survival_influence", "Survival influence screening")
  } else {
    add_skipped("survival_time_scaling", "Survival-time unit scaling", "Not a survival model.")
    add_skipped("event_coding", "Event-coding audit", "Not a survival model.")
    add_skipped("cox_ph_assumption", "Proportional-hazards diagnostic", "Not a Cox model.")
    add_skipped("survival_information", "Survival information audit", "Not a survival model.")
    add_skipped("survival_influence", "Survival influence screening", "Not a survival model.")
  }

  selected_df <- if (length(selected)) do.call(rbind, selected) else data.frame()
  skipped_df <- if (length(skipped)) do.call(rbind, skipped) else data.frame()
  list(selected = selected_df, skipped = skipped_df)
}

#' Preview the validation tests selected for an analysis
#'
#' @inheritParams statwitness
#' @return A data frame containing selected and skipped tests with reasons.
#' @export
audit_plan <- function(formula, data, focus = NULL, family = NULL, weights = NULL,
                       method = "auto", engine = NULL, control = NULL,
                       audit_level = c("standard", "core", "thorough")) {
  audit_level <- match.arg(audit_level)
  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)
  plan <- .build_plan(info, audit_level = audit_level)
  out <- rbind(plan$selected, plan$skipped)
  rownames(out) <- NULL
  out
}
