.surv_response_parts <- function(formula) {
  lhs <- formula[[2L]]
  if (!is.call(lhs)) return(character())
  fn <- paste(deparse(lhs[[1L]]), collapse = "")
  if (!fn %in% c("Surv", "survival::Surv")) return(character())
  vapply(as.list(lhs)[-1L], function(x) paste(deparse(x), collapse = ""), character(1))
}

.test_survival_time_scaling <- function(info, tolerance) {
  parts <- .surv_response_parts(info$formula)
  if (length(parts) < 2L || !parts[[1L]] %in% names(info$data)) {
    return(.new_test("survival_time_scaling", "Survival-time unit scaling", "ERROR",
      expected = "A direct Surv(time, event) response.", observed = "The survival time variable could not be identified.",
      details = "Time scaling currently supports direct column names in Surv()."))
  }
  time_var <- parts[[1L]]
  d2 <- info$data
  d2[[time_var]] <- d2[[time_var]] * 10
  m2 <- .refit(info, d2)
  ov <- .named_overlap(.fixed_coef(info$model), .fixed_coef(m2))
  ok <- .within_tol(ov$x, ov$y, tolerance * 100)
  .new_test(
    "survival_time_scaling", "Survival-time unit scaling", if (ok) "PASS" else "FAIL",
    expected = "Changing the time unit preserves regression coefficients and hazard ratios.",
    observed = paste0("maximum coefficient difference = ", .format_num(.max_abs_diff(ov$x, ov$y))),
    details = if (ok) "The survival model was invariant to time-unit conversion." else "Changing time units altered the regression effects."
  )
}

.test_event_coding <- function(info) {
  parts <- .surv_response_parts(info$formula)
  if (length(parts) < 2L || !parts[[2L]] %in% names(info$data)) {
    return(.new_test("event_coding", "Event-coding audit", "WARN", severity = "warning",
      expected = "A direct event indicator is identifiable.", observed = "Event coding could not be inspected automatically.",
      details = "Inspect the Surv() response and event coding manually."))
  }
  event <- info$data[[parts[[2L]]]]
  vals <- sort(unique(stats::na.omit(event)))
  ok <- all(vals %in% c(0, 1)) && length(vals) == 2L
  .new_test(
    "event_coding", "Event-coding audit", if (ok) "PASS" else "WARN", severity = "warning",
    expected = "A two-valued 0/1 event indicator for right-censored data.",
    observed = paste0("observed event values: ", paste(vals, collapse = ", ")),
    details = if (ok) "The event indicator uses conventional 0/1 coding." else "Nonstandard or single-valued event coding was detected; verify the Surv() semantics."
  )
}

.test_cox_ph_assumption <- function(info) {
  if (info$model_class != "coxph") {
    return(.new_test("cox_ph_assumption", "Proportional-hazards diagnostic", "WARN", severity = "warning",
      expected = "A Cox proportional-hazards model.", observed = "The model is not coxph.",
      details = "This diagnostic is specific to Cox models."))
  }
  z <- survival::cox.zph(info$model)
  tab <- z$table
  pcol <- grep("p", colnames(tab), ignore.case = TRUE, value = TRUE)
  p <- tab[, pcol[[1L]]]
  names(p) <- rownames(tab)
  term_p <- p[setdiff(names(p), "GLOBAL")]
  global <- if ("GLOBAL" %in% names(p)) p[["GLOBAL"]] else NA_real_
  issue <- any(term_p < 0.05, na.rm = TRUE) || (!is.na(global) && global < 0.05)
  min_term <- if (length(term_p)) min(term_p, na.rm = TRUE) else NA_real_
  .new_test(
    "cox_ph_assumption", "Proportional-hazards diagnostic", if (issue) "WARN" else "PASS",
    severity = "warning",
    expected = "No strong Schoenfeld-residual evidence against proportional hazards.",
    observed = paste0("minimum term p-value = ", .format_num(min_term),
                      "; global p-value = ", .format_num(global)),
    details = if (issue) "At least one proportional-hazards diagnostic is below 0.05; inspect time-varying effects." else "No strong proportional-hazards violation was detected by cox.zph()."
  )
}
