
utils::globalVariables(c("PC", "Var", "CumVar", "PC1", "PC2", "v"))

#' @keywords internal
#' @noRd
choose_K <- function(data,
                     threshold = 0.9,
                     verbose = FALSE){

  df <- as.data.frame(data)
  df <- df[, vapply(df, is.numeric, logical(1)), drop = FALSE]

  p <- stats::prcomp(df, scale. = TRUE)

  ve <- p$sdev^2 / sum(p$sdev^2)
  cumvar <- cumsum(ve)

  K_var <- which(cumvar >= threshold)[1]

  d1 <- diff(ve)
  d2 <- diff(d1)

  K_elbow <- if(length(d2) > 0) {
    which.min(d2) + 1
  } else {
    1
  }

  K <- min(K_var, K_elbow, ncol(df))

  if(verbose){
    message("\n--- Auto Selection of K ---")
    message("K (Variance >= ", threshold * 100, "%): ", K_var)
    message("K (Elbow): ", K_elbow)
    message("Selected K: ", K)
  }

  return(K)
}

#' @title Sparse Principal Component Regression (Sparse PCR)
#'
#' @description
#' Performs Sparse PCA followed by regression with automatic selection
#' of number of components. Includes PCA suitability tests, loadings,
#' regression models, scree plot, and biplot.
#'
#' @param data A data frame or matrix
#' @param y Response variable name (character)
#' @param K Number of components (optional)
#' @param threshold Variance threshold for automatic K selection
#' @param verbose Logical; print messages and summaries
#'
#' @return A list containing model outputs and PCA results
#'
#' @importFrom stats cor prcomp lm step complete.cases sd
#' @importFrom psych cortest.bartlett KMO
#' @importFrom elasticnet spca
#' @importFrom ggplot2 ggplot aes geom_col geom_line geom_point geom_text
#' @importFrom ggplot2 scale_y_continuous labs theme_minimal theme
#' @importFrom ggplot2 element_text element_line element_blank coord_equal
#' @importFrom ggrepel geom_text_repel
#' @importFrom gridExtra grid.arrange
#' @importFrom scales percent_format
#' @importFrom grid unit arrow
#' @export
#'
#' @examples
#' data(mtcars)
#' Result <- sparse_pcreg(mtcars, y = "mpg")

sparse_pcreg <- function(data,
                         y,
                         K = NULL,
                         threshold = 0.9,
                         verbose = FALSE){

  if(!is.data.frame(data) && !is.matrix(data)){
    stop("data must be a data frame or matrix")
  }

  df <- as.data.frame(data)

  df <- df[, vapply(df, is.numeric, logical(1)), drop = FALSE]

  if(!(y %in% colnames(df))){
    stop("Response variable not found")
  }

  Y <- df[[y]]

  if(!is.numeric(Y)){
    stop("Response must be numeric")
  }

  X <- df[, setdiff(names(df), y), drop = FALSE]

  if(ncol(X) < 2){
    stop("Need at least 2 predictors")
  }

  idx <- stats::complete.cases(X, Y)

  X <- X[idx, , drop = FALSE]
  Y <- Y[idx]

  if(nrow(X) < 2){
    stop("Not enough complete observations")
  }

  const <- vapply(X, function(x) stats::sd(x) == 0, logical(1))

  if(any(const)){

    if(verbose){
      message(
        "Removed constant predictors: ",
        paste(names(X)[const], collapse = ", ")
      )
    }

    X <- X[, !const, drop = FALSE]
  }

  if(ncol(X) < 2){
    stop("Need at least 2 non-constant predictors")
  }

  if(is.null(K)){
    K <- choose_K(X,
                  threshold = threshold,
                  verbose = verbose)
  }

  if(K > ncol(X)){
    stop("K cannot exceed number of predictors")
  }

  if(verbose){
    message("\nUsing K = ", K)
  }

  cm <- stats::cor(X)

  if(verbose){
    message("\n--- PCA Suitability ---")
  }

  singular <- tryCatch(
    base::det(cm) < 1e-10,
    error = function(e) TRUE
  )

  bart <- if(!singular){
    tryCatch(
      psych::cortest.bartlett(cm, n = nrow(X)),
      error = function(e) NULL
    )
  } else {
    NULL
  }

  if(!is.null(bart)){

    if(verbose){
      message("\nBartlett Test:")
      message("Chi-square: ", round(bart$chisq, 3))
      message("df: ", bart$df)
      message("p-value: ", format.pval(bart$p.value))
    }

  } else {

    if(verbose){
      message("\nBartlett test not valid")
    }
  }

  kmo <- if(!singular){
    tryCatch(
      psych::KMO(cm),
      error = function(e) NULL
    )
  } else {
    NULL
  }

  if(!is.null(kmo)){

    kmo_val <- round(kmo$MSA, 3)

    suitability <- ifelse(
      kmo_val >= 0.6,
      "Suitable for PCA",
      "Not Suitable for PCA"
    )

    if(verbose){
      message("\nKMO: ", kmo_val, " - ", suitability)
    }

  } else {

    if(verbose){
      message("\nKMO not valid")
    }
  }

  X_scaled <- scale(X)

  sp <- elasticnet::spca(
    X_scaled,
    K = K,
    type = "predictor",
    sparse = "varnum",
    para = rep(ceiling(ncol(X) / 2), K)
  )

  load <- as.matrix(sp$loadings)

  colnames(load) <- paste0("PC", seq_len(K))
  rownames(load) <- colnames(X)

  load_df <- as.data.frame(load)

  scores <- as.data.frame(X_scaled %*% load)

  p_full <- stats::prcomp(X, scale. = TRUE)

  ve_full <- p_full$sdev^2 / sum(p_full$sdev^2)

  if(verbose){
    message("\n--- PCA Summary ---")
    print(summary(p_full))

    message("\n--- Sparse PCA Loadings ---")
    print(round(load_df, 3))
  }

  reg_data <- data.frame(Y = Y, scores)

  full_model <- stats::lm(Y ~ ., data = reg_data)

  if(verbose){
    message("\n--- FULL SPARSE PCR MODEL ---")
    print(summary(full_model))
  }

  step_model <- tryCatch(
    stats::step(full_model, direction = "backward", trace = 0),
    error = function(e) full_model
  )

  if(verbose){
    message("\n--- BACKWARD SELECTED MODEL ---")
    print(summary(step_model))
  }

  theme_pretty <-
    ggplot2::theme_minimal(
      base_family = "serif",
      base_size = 16
    ) +
    ggplot2::theme(
      plot.title =
        ggplot2::element_text(
          face = "bold",
          hjust = 0.5
        ),
      axis.title =
        ggplot2::element_text(face = "bold"),
      axis.text =
        ggplot2::element_text(
          face = "bold",
          color = "black"
        ),
      axis.line.x =
        ggplot2::element_line(color = "black"),
      axis.line.y =
        ggplot2::element_line(color = "black"),
      axis.ticks =
        ggplot2::element_line(color = "black"),
      panel.grid.minor =
        ggplot2::element_blank()
    )

  scree_data <- data.frame(
    PC = factor(
      paste0("PC", seq_along(ve_full)),
      levels = paste0("PC", seq_along(ve_full))
    ),
    Var = ve_full,
    CumVar = cumsum(ve_full)
  )

  scree <- ggplot2::ggplot(
    scree_data,
    ggplot2::aes(x = PC)
  ) +
    ggplot2::geom_col(
      ggplot2::aes(y = Var),
      fill = "#4C72B0",
      width = 0.6,
      alpha = 0.85
    ) +
    ggplot2::geom_line(
      ggplot2::aes(y = CumVar, group = 1),
      color = "#DD8452",
      linewidth = 1.2
    ) +
    ggplot2::geom_point(
      ggplot2::aes(y = CumVar),
      color = "#DD8452",
      size = 3
    ) +
    ggplot2::geom_text(
      ggplot2::aes(
        y = Var,
        label = paste0(round(Var * 100, 1), "%")
      ),
      vjust = -0.5,
      size = 4,
      family = "serif",
      fontface = "bold"
    ) +
    ggplot2::scale_y_continuous(
      labels = scales::percent_format(),
      limits = c(0, 1)
    ) +
    ggplot2::labs(
      title = "Sparse PCA Scree Plot",
      x = "Principal Components",
      y = "Variance Explained"
    ) +
    theme_pretty

  if(ncol(scores) >= 2){

    load2 <- load_df[, 1:2, drop = FALSE]
    load2$v <- rownames(load2)

    score2 <- scores[, 1:2, drop = FALSE]

    sf <- max(abs(score2))

    biplot <- ggplot2::ggplot() +

      ggplot2::geom_point(
        data = score2,
        ggplot2::aes(PC1, PC2),
        size = 3,
        alpha = 0.75,
        color = "#2C7BB6"
      ) +

      ggplot2::geom_segment(
        data = load2,
        ggplot2::aes(
          x = 0,
          y = 0,
          xend = PC1 * sf,
          yend = PC2 * sf
        ),
        arrow = grid::arrow(
          length = grid::unit(0.3, "cm")
        ),
        color = "#D7191C",
        linewidth = 1.2
      ) +

      ggrepel::geom_text_repel(
        data = load2,
        ggplot2::aes(
          PC1 * sf,
          PC2 * sf,
          label = v
        ),
        size = 5,
        color = "#D7191C",
        family = "serif",
        fontface = "bold"
      ) +

      ggplot2::labs(
        title = "Sparse PCA Biplot",
        x = "Component 1",
        y = "Component 2"
      ) +

      theme_pretty +
      ggplot2::coord_equal()

    gridExtra::grid.arrange(
      scree,
      biplot,
      ncol = 2
    )

  } else {

    warning("Biplot not created: less than 2 components")

    print(scree)
  }

  invisible(list(
    K = K,
    bartlett = bart,
    kmo = kmo,
    loadings = load_df,
    scores = scores,
    variance = ve_full,
    full_model = summary(full_model),
    backward_model = summary(step_model),
    scree_plot = scree,
    biplot = if (exists("biplot")) biplot else NULL
  ))
}
