#' Select the ridge penalty for COMBSS by leave-one-out cross-validation.
#'
#' Mirrors `combss.cv.select_lambda` in the Python `combss` package. For each
#' candidate `lambda` and each subset size `k = 1, ..., q`, runs COMBSS to
#' obtain a subset and evaluates LOOCV error of a refit. Returns the best
#' `lambda` overall and the best `lambda` per `k`.
#'
#' @param x Numeric design matrix `(n, p)`.
#' @param y Response (numeric / binary / factor depending on `family`).
#' @param family One of `"gaussian"` (alias `"linear"`), `"binomial"`,
#'   `"multinomial"`.
#' @param q Maximum subset size.
#' @param lambda_grid Candidate ridge penalties. Defaults to
#'   `c(0, 10^seq(-3, 1, length.out = 10))`.
#' @param Niter Number of homotopy iterations passed to `combss()`.
#' @param verbose Print progress.
#'
#' @return List with:
#'   - `best_lambda`: ridge penalty with best mean LOOCV metric across `k`
#'   - `best_lambda_per_k`: numeric vector, length `q`
#'   - `results`: data frame `(lambda, k, loocv_metric)`
#'
#' @export
combss_cv <- function(x, y,
                      family = c("gaussian", "binomial", "multinomial"),
                      q,
                      lambda_grid = NULL,
                      Niter = 25,
                      verbose = FALSE) {
  family <- resolve_family(family)
  if (is.null(lambda_grid)) lambda_grid <- c(0, 10^seq(-3, 1, length.out = 10))

  x <- as.matrix(x)
  n <- nrow(x)
  results <- list()
  best_lambda_per_k <- rep(NA_real_, q)
  best_metric_per_k <- rep(NA_real_, q)

  for (lam in lambda_grid) {
    if (verbose) message(sprintf("lambda = %g", lam))
    fit <- combss(x, y, family = family, q = q,
                  lam_ridge = lam, Niter = Niter, verbose = FALSE)
    for (k in seq_len(q)) {
      idx <- fit$subset_list[[k]]
      metric_k <- loocv_metric(x, y, idx, family)
      results[[length(results) + 1]] <- data.frame(
        lambda = lam, k = k, loocv_metric = metric_k
      )
      better <- if (family == "gaussian")
        is.na(best_metric_per_k[k]) || metric_k < best_metric_per_k[k]
      else
        is.na(best_metric_per_k[k]) || metric_k > best_metric_per_k[k]
      if (better) {
        best_lambda_per_k[k] <- lam
        best_metric_per_k[k] <- metric_k
      }
    }
  }

  results <- do.call(rbind, results)
  agg <- aggregate(results$loocv_metric, by = list(lambda = results$lambda),
                   FUN = if (family == "gaussian") mean else mean)
  best_lambda <- if (family == "gaussian")
    agg$lambda[which.min(agg$x)] else agg$lambda[which.max(agg$x)]

  list(best_lambda = best_lambda,
       best_lambda_per_k = best_lambda_per_k,
       results = results)
}

#' LOOCV metric for a fixed subset.
#'
#' Gaussian: hat-matrix shortcut for ridge LOOCV MSE.
#' Binomial / multinomial: explicit leave-one-out refit (slow but simple).
#'
#' @keywords internal
#' @noRd
loocv_metric <- function(x, y, idx, family) {
  n <- nrow(x)
  if (length(idx) == 0) {
    if (family == "gaussian") return(mean((y - mean(y))^2))
    return(mean(as.character(y) == names(which.max(table(y)))))
  }

  X_sub <- cbind(1, x[, idx, drop = FALSE])

  if (family == "gaussian") {
    XtX <- crossprod(X_sub)
    H <- X_sub %*% solve(XtX + diag(1e-8, ncol(XtX))) %*% t(X_sub)
    yhat <- as.numeric(H %*% as.numeric(y))
    h_diag <- pmin(diag(H), 1 - 1e-8)
    err <- (as.numeric(y) - yhat) / (1 - h_diag)
    return(mean(err^2))
  }

  acc <- 0
  for (i in seq_len(n)) {
    pred_i <- refit_predict(x[-i, , drop = FALSE], y[-i],
                            x[i, , drop = FALSE], idx, family)
    if (family == "binomial") {
      acc <- acc + (pred_i == as.numeric(y[i]))
    } else {
      acc <- acc + (pred_i == as.character(y[i]))
    }
  }
  acc / n
}
