
utils::globalVariables(c("varname"))

#' @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)

  if (verbose) {
    message("--- 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 Analysis (Sparse PCA)
#'
#' @description
#' Performs Sparse PCA using elastic net regularisation with custom scree plot and biplot.
#'
#' @param data Numeric data frame or matrix
#' @param K Number of components (auto if NULL)
#' @param threshold Variance threshold for automatic K selection
#' @param verbose Logical; prints diagnostic messages
#'
#' @return List with PCA results
#'
#' @importFrom stats prcomp cor complete.cases
#' @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_pca(mtcars)
#' }

sparse_pca <- function(data,
                       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 (ncol(df) < 2) {
    stop("Need at least 2 numeric variables")
  }

  df <- df[stats::complete.cases(df), , drop = FALSE]

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

  if (is.null(K)) {

    K <- choose_K(
      data = df,
      threshold = threshold
    )

  }
  if (K > ncol(df)) {
    stop("K cannot exceed number of variables")
  }

  if (verbose) {
    message("Using K = ", K)
  }

  # FIXED: define X and cm
  X <- scale(df)
  cm <- stats::cor(df)

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

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

  if (!is.null(bart)) {
    if (verbose) {
      message("Bartlett Test:")
      message("Chi-square: ", round(bart$chisq, 3))
      message("df: ", bart$df)
      message("p-value: ", format.pval(bart$p.value))
    }
  } else {
    if (verbose) {
      message("Bartlett 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("KMO: ", kmo_val, " - ", suitability)
    }

  } else {

    if (verbose) {
      message("KMO not valid")
    }

  }

  sp <- elasticnet::spca(
    X,
    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(df)

  load <- as.data.frame(load)

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

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

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

  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[, 1:2, drop = FALSE]
    load2$varname <- 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 = varname
        )
      ) +
      ggplot2::labs(
        title = "Sparse PCA Biplot",
        x = "Component 1",
        y = "Component 2"
      ) +
      theme_pretty +
      ggplot2::coord_equal()

  } else {

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

  }

  invisible(list(
    K = K,
    bartlett = bart,
    kmo = kmo,
    loadings = load,
    scores = scores,
    variance = ve_full,
    scree_plot = scree,
    biplot = if (exists("biplot")) biplot else NULL
  ))
}
