.rm_fit <- function(data, outcome, id, within, between, type, correction) {
  .require_namespace("afex", "repeated-measures ANOVA")
  afex::aov_ez(
    id = id, dv = outcome, data = data,
    within = within, between = between,
    type = type, anova_table = list(correction = correction, es = "pes"),
    factorize = TRUE, return = "afex_aov"
  )
}

.rm_table <- function(model) {
  as.data.frame(model$anova_table)
}

.rm_numeric_column <- function(tab, patterns) {
  nm <- colnames(tab)
  hit <- unique(unlist(lapply(patterns, function(p) grep(p, nm, ignore.case = TRUE, value = TRUE))))
  if (!length(hit)) return(rep(NA_real_, nrow(tab)))
  suppressWarnings(as.numeric(tab[[hit[[1L]]]]))
}

.rm_effect_names <- function(tab) {
  rn <- rownames(tab)
  if (!is.null(rn) && all(nzchar(rn))) return(rn)
  if ("Effect" %in% names(tab)) return(as.character(tab$Effect))
  paste0("Effect_", seq_len(nrow(tab)))
}

.rm_primary <- function(model, focus) {
  tab <- .rm_table(model)
  effects <- .rm_effect_names(tab)
  if (is.null(focus)) focus <- effects[[1L]]
  idx <- match(focus, effects)
  if (is.na(idx)) .sw_abort("Could not match repeated-measures focus `", focus, "`. Available effects: ", paste(effects, collapse = ", "), ".")
  fval <- .rm_numeric_column(tab, c("^F$", "F.value", "^F "))
  pval <- .rm_numeric_column(tab, c("Pr", "p.value", "^p$"))
  ndf <- .rm_numeric_column(tab, c("num.Df", "num df", "^df1$"))
  ddf <- .rm_numeric_column(tab, c("den.Df", "den df", "^df2$"))
  pes <- .rm_numeric_column(tab, c("pes", "partial"))
  list(
    kind = "term", label = focus, coefficient = NA_character_, estimate = pes[[idx]],
    standard_error = NA_real_, statistic = fval[[idx]], df = c(ndf[[idx]], ddf[[idx]]),
    p_value = pval[[idx]], conf_level = NA_real_, lower = NA_real_, upper = NA_real_,
    transformed = NULL, n = NA_integer_,
    method = "afex repeated-measures ANOVA", effect_size_label = "partial eta-squared"
  )
}

.rm_compare_tables <- function(m1, m2, tolerance) {
  t1 <- .rm_table(m1)
  t2 <- .rm_table(m2)
  e1 <- .rm_effect_names(t1)
  e2 <- .rm_effect_names(t2)
  if (!identical(e1, e2)) return(list(ok = FALSE, diff = Inf))
  f1 <- .rm_numeric_column(t1, c("^F$", "F.value", "^F "))
  f2 <- .rm_numeric_column(t2, c("^F$", "F.value", "^F "))
  p1 <- .rm_numeric_column(t1, c("Pr", "p.value", "^p$"))
  p2 <- .rm_numeric_column(t2, c("Pr", "p.value", "^p$"))
  diffs <- c(.max_abs_diff(f1, f2), .max_abs_diff(p1, p2))
  diff <- if (all(is.na(diffs))) Inf else max(diffs, na.rm = TRUE)
  list(ok = .within_tol(f1, f2, tolerance * 100) && .within_tol(p1, p2, tolerance * 100), diff = diff)
}

.rm_test_design <- function(data, id, within) {
  key_vars <- c(id, within)
  key <- interaction(data[key_vars], drop = TRUE, lex.order = TRUE)
  duplicate_cells <- sum(duplicated(key))
  expected <- do.call(expand.grid, lapply(data[within], function(x) unique(stats::na.omit(x))))
  expected_n <- nrow(expected)
  counts <- table(data[[id]])
  incomplete_ids <- sum(counts != expected_n)
  status <- if (duplicate_cells > 0 || incomplete_ids > 0) "WARN" else "PASS"
  .new_test(
    "rm_design_integrity", "Repeated-measures design integrity", status, severity = "warning",
    expected = "One observation per participant-condition cell and complete within-subject cells.",
    observed = paste0("duplicate participant-condition rows = ", duplicate_cells,
                      "; participants with unexpected row counts = ", incomplete_ids),
    details = if (status == "PASS") "The long-format repeated design has one complete row per participant-condition cell." else "Duplicate or incomplete participant-condition cells were detected; verify aggregation and missingness handling."
  )
}

#' Audit a repeated-measures ANOVA
#'
#' Uses `afex::aov_ez()` and applies design-integrity and metamorphic checks.
#'
#' @param data Long-format data frame.
#' @param outcome Name of the numeric outcome column.
#' @param id Name of the participant identifier column.
#' @param within Character vector of within-subject factor names.
#' @param between Optional character vector of between-subject factor names.
#' @param focus Optional omnibus effect name, for example `"criterion:model"`.
#' @param type Sums-of-squares type passed to `afex::aov_ez()`.
#' @param correction Sphericity correction, usually `"GG"`.
#' @param tolerance Relative numerical tolerance.
#' @param seed Seed for row-order checks.
#' @param audit_level Audit breadth: `"core"`, `"standard"`, or `"thorough"`.
#' @return An object of class `statwitness_audit`.
#' @export
statwitness_repeated <- function(data, outcome, id, within, between = NULL,
                                 focus = NULL, type = 3, correction = "GG",
                                 tolerance = 1e-7, seed = 20260712,
                                 audit_level = c("standard", "core", "thorough")) {
  audit_level <- match.arg(audit_level)
  if (!is.data.frame(data)) .sw_abort("`data` must be a data frame.")
  args <- c(outcome, id, within, between)
  missing_vars <- setdiff(args, names(data))
  if (length(missing_vars)) .sw_abort("Missing columns: ", paste(missing_vars, collapse = ", "), ".")
  if (!is.numeric(data[[outcome]])) .sw_abort("`outcome` must identify a numeric column.")
  model <- .rm_fit(data, outcome, id, within, between, type, correction)
  primary <- .rm_primary(model, focus)
  primary$n <- length(unique(data[[id]]))

  tests <- list(.rm_test_design(data, id, within))
  tests[[length(tests) + 1L]] <- .rm_test_sphericity(data, within, correction)
  if (audit_level != "core") {
    tests[[length(tests) + 1L]] <- .rm_test_residual_shape(model)
    tests[[length(tests) + 1L]] <- .rm_test_id_influence(
      data, outcome, id, within, between, type, correction, primary$label,
      model, max_ids = if (identical(audit_level, "thorough")) 100L else 25L
    )
  }
  set.seed(seed)
  shuffled <- data[sample.int(nrow(data)), , drop = FALSE]
  m_row <- .rm_fit(shuffled, outcome, id, within, between, type, correction)
  cmp <- .rm_compare_tables(model, m_row, tolerance)
  tests[[length(tests) + 1L]] <- .new_test(
    "rm_row_order", "Repeated-ANOVA row-order invariance", if (cmp$ok) "PASS" else "FAIL",
    expected = "Equivalent F tests and p-values after row permutation.",
    observed = paste0("maximum ANOVA-table difference = ", .format_num(cmp$diff)),
    details = if (cmp$ok) "The repeated-measures ANOVA was invariant to row order." else "Row ordering changed the repeated-measures ANOVA."
  )

  relabeled <- data
  relabeled[[id]] <- factor(relabeled[[id]])
  levels(relabeled[[id]]) <- paste0("SW_ID_", seq_along(levels(relabeled[[id]])))
  m_id <- .rm_fit(relabeled, outcome, id, within, between, type, correction)
  cmp <- .rm_compare_tables(model, m_id, tolerance)
  tests[[length(tests) + 1L]] <- .new_test(
    "rm_id_label", "Participant-label invariance", if (cmp$ok) "PASS" else "FAIL",
    expected = "Renaming participant identifiers preserves omnibus tests.",
    observed = paste0("maximum ANOVA-table difference = ", .format_num(cmp$diff)),
    details = if (cmp$ok) "Participant labels were treated as identifiers." else "Renaming participant identifiers changed the ANOVA."
  )

  translated <- data
  shift <- stats::sd(translated[[outcome]], na.rm = TRUE)
  if (!is.finite(shift) || shift == 0) shift <- 1
  translated[[outcome]] <- translated[[outcome]] + shift
  m_trans <- .rm_fit(translated, outcome, id, within, between, type, correction)
  cmp <- .rm_compare_tables(model, m_trans, tolerance)
  tests[[length(tests) + 1L]] <- .new_test(
    "rm_outcome_translation", "Repeated-outcome translation", if (cmp$ok) "PASS" else "FAIL",
    expected = "Adding a constant preserves F tests and p-values.",
    observed = paste0("maximum ANOVA-table difference = ", .format_num(cmp$diff)),
    details = if (cmp$ok) "Outcome translation preserved the repeated-measures tests." else "Outcome translation altered the repeated-measures tests."
  )

  scaled <- data
  scaled[[outcome]] <- scaled[[outcome]] * 10
  m_scale <- .rm_fit(scaled, outcome, id, within, between, type, correction)
  cmp <- .rm_compare_tables(model, m_scale, tolerance)
  tests[[length(tests) + 1L]] <- .new_test(
    "rm_outcome_scaling", "Repeated-outcome scaling", if (cmp$ok) "PASS" else "FAIL",
    expected = "Changing outcome units preserves F tests and p-values.",
    observed = paste0("maximum ANOVA-table difference = ", .format_num(cmp$diff)),
    details = if (cmp$ok) "Outcome scaling preserved the repeated-measures tests." else "Outcome scaling altered the repeated-measures tests."
  )

  test_df <- do.call(rbind, lapply(tests, .test_to_row))
  domains <- .domain_summary(test_df)
  status <- .certificate_status(test_df)
  data_fingerprint <- .md5_object(data)
  analysis_fingerprint <- .md5_object(list(
    outcome = outcome, id = id, within = within, between = between,
    focus = primary$label, type = type, correction = correction,
    tests = test_df, domains = domains, audit_level = audit_level,
    data_fingerprint = data_fingerprint
  ))

  structure(list(
    call = match.call(), formula = NULL, focus = primary$label,
    focus_coefficient = NA_character_, focus_term = primary$label,
    focus_kind = "term", focus_inferred = is.null(focus), model = model,
    model_class = "afex_aov", model_type = "repeated_measures_anova",
    method = "afex_aov_ez", family = "gaussian", link = "identity",
    primary = primary, tests = test_df, domains = domains,
    selected_plan = NULL, skipped_plan = NULL, status = status,
    audit_level = audit_level,
    certificate_id = paste0("SW-", toupper(substr(analysis_fingerprint, 1L, 12L))),
    data_fingerprint = data_fingerprint,
    analysis_fingerprint = analysis_fingerprint,
    tolerance = tolerance, seed = seed,
    repeated_design = list(outcome = outcome, id = id, within = within,
                           between = between, type = type, correction = correction),
    limitations = c(
      "The certificate validates repeated-measures computation and design structure under registered transformations.",
      "It does not establish causal validity, sphericity truth, or scientific appropriateness."
    )
  ), class = "statwitness_audit")
}

.rm_test_sphericity <- function(data, within, correction) {
  levels_n <- vapply(within, function(v) length(unique(stats::na.omit(data[[v]]))), integer(1))
  relevant <- any(levels_n > 2L)
  declared <- !is.null(correction) && nzchar(as.character(correction)) &&
    !tolower(as.character(correction)) %in% c("none", "no", "false")
  issue <- relevant && !declared
  .new_test(
    "rm_sphericity", "Repeated-measures sphericity handling",
    if (issue) "WARN" else "PASS", severity = "warning",
    expected = "A declared correction when a within-subject factor has more than two levels.",
    observed = paste0("within-factor levels = ",
                      paste(names(levels_n), levels_n, sep = ":", collapse = ", "),
                      "; correction = ", correction %||% "none"),
    details = if (issue) {
      "At least one within-subject factor has more than two levels but no sphericity correction was declared."
    } else if (relevant) {
      "A sphericity correction was declared for the repeated-measures analysis."
    } else {
      "No within-subject factor has more than two levels, so sphericity correction is not required for a single-factor contrast."
    }
  )
}

.rm_test_residual_shape <- function(model) {
  lm_part <- tryCatch(model$lm, error = function(e) NULL)
  if (is.null(lm_part)) {
    return(.new_test(
      "rm_residual_shape", "Repeated-model residual-shape screening", "WARN",
      severity = "warning", expected = "An accessible fitted linear-model component.",
      observed = "The residual model component was unavailable.",
      details = "Residual shape could not be screened automatically."
    ))
  }
  r <- tryCatch(as.numeric(stats::residuals(lm_part)), error = function(e) numeric())
  r <- r[is.finite(r)]
  if (length(r) < 8L || stats::sd(r) == 0) {
    return(.new_test(
      "rm_residual_shape", "Repeated-model residual-shape screening", "WARN",
      severity = "warning", expected = "Enough nonconstant residuals.",
      observed = paste0("usable residuals = ", length(r)),
      details = "Residual shape could not be screened reliably."
    ))
  }
  z <- (r - mean(r)) / stats::sd(r)
  skew <- mean(z^3)
  excess <- mean(z^4) - 3
  issue <- abs(skew) > 2 || excess > 7
  .new_test(
    "rm_residual_shape", "Repeated-model residual-shape screening",
    if (issue) "WARN" else "PASS", severity = "warning",
    expected = "No extreme residual skewness or tail heaviness.",
    observed = paste0("skewness = ", .format_num(skew),
                      "; excess kurtosis = ", .format_num(excess)),
    details = if (issue) "The repeated-model residuals are strongly asymmetric or heavy-tailed." else "No extreme residual-shape issue was detected."
  )
}

.rm_test_id_influence <- function(data, outcome, id, within, between, type,
                                  correction, focus, base_model,
                                  max_ids = 25L) {
  ids <- unique(stats::na.omit(data[[id]]))
  if (length(ids) > max_ids) {
    return(.new_test(
      "rm_id_influence", "Participant-deletion influence", "WARN",
      severity = "warning", expected = paste0("At most ", max_ids, " participants in the selected audit level."),
      observed = paste0("participants = ", length(ids)),
      details = "The complete leave-one-participant-out audit was skipped to control computation; use audit_level = 'thorough' to raise the limit."
    ))
  }
  base <- .rm_primary(base_model, focus)
  changes <- numeric()
  reversals <- logical()
  labels <- character()
  failures <- 0L
  for (who in ids) {
    d2 <- data[data[[id]] != who, , drop = FALSE]
    snap <- tryCatch(.rm_primary(.rm_fit(d2, outcome, id, within, between, type, correction), focus),
                     error = function(e) NULL)
    if (is.null(snap)) {
      failures <- failures + 1L
      next
    }
    denom <- max(abs(base$statistic), 1e-8)
    changes <- c(changes, abs(snap$statistic - base$statistic) / denom)
    reversals <- c(reversals, (snap$p_value < 0.05) != (base$p_value < 0.05))
    labels <- c(labels, as.character(who))
  }
  if (!length(changes)) {
    return(.new_test(
      "rm_id_influence", "Participant-deletion influence", "WARN",
      severity = "warning", expected = "At least one successful leave-one-participant-out refit.",
      observed = paste0("failed refits = ", failures),
      details = "No participant-deletion refit completed successfully."
    ))
  }
  idx <- which.max(changes)
  issue <- any(reversals) || max(changes) > 0.5
  .new_test(
    "rm_id_influence", "Participant-deletion influence",
    if (issue) "WARN" else "PASS", severity = "warning",
    expected = "The focus test remains decisionally stable and changes by no more than 50% after deleting one participant.",
    observed = paste0("largest relative statistic change = ", .format_num(max(changes)),
                      " after deleting ", labels[[idx]],
                      "; decision reversals = ", sum(reversals),
                      "; failed refits = ", failures),
    details = if (issue) "The repeated-measures result is sensitive to at least one participant." else "No single participant caused a large test-statistic change or decision reversal."
  )
}
