
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 Robust Principal Component Regression (Robust PCR)
#'
#' @description
#' Performs Robust PCA using Minimum Covariance Determinant (MCD)
#' followed by regression on robust principal components.
#' Includes PCA suitability tests, summary, loadings,
#' scree plot, biplot, and regression models.
#'
#' @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 detailed output
#'
#' @return A list containing Robust PCR outputs
#'
#' @importFrom stats prcomp lm step complete.cases sd cor
#' @importFrom robustbase covMcd
#' @importFrom psych cortest.bartlett KMO
#' @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 <- robust_pcreg(mtcars, y = "mpg")

robust_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)
    if(verbose){
      message("\nKMO: ", kmo_val,
              " - ",
              ifelse(kmo_val >= 0.6,
                     "Suitable for PCA",
                     "Not Suitable for PCA"))
    }
  } else if(verbose){
    message("\nKMO not valid")
  }

  mcd <- robustbase::covMcd(X)

  eig <- eigen(mcd$cov, symmetric = TRUE)
  eig_vals <- eig$values
  eig_vecs <- eig$vectors

  ve_full <- eig_vals / sum(eig_vals)

  pca_summary <- rbind(
    "Standard deviation" = sqrt(eig_vals),
    "Proportion of Variance" = ve_full,
    "Cumulative Proportion" = cumsum(ve_full)
  )

  colnames(pca_summary) <- paste0("PC", seq_len(ncol(pca_summary)))

  if(verbose){
    message("\n--- PCA Summary ---")
    print(round(pca_summary, 4))
  }

  load <- eig_vecs[, 1:K, drop = FALSE]
  colnames(load) <- paste0("PC", seq_len(K))
  rownames(load) <- colnames(X)
  load_df <- as.data.frame(load)

  scores <- scale(X, center = mcd$center, scale = FALSE) %*% load
  scores <- as.data.frame(scores)

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

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

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

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

    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))),
    Var = ve_full,
    CumVar = cumsum(ve_full)
  )

  scree <- ggplot2::ggplot(scree_data, ggplot2::aes(x = PC)) +
    ggplot2::geom_col(ggplot2::aes(y = Var), width = 0.7) +
    ggplot2::geom_line(ggplot2::aes(y = CumVar, group = 1),
                       color = "#D55E00", linewidth = 1.2) +
    ggplot2::geom_point(ggplot2::aes(y = CumVar),
                        color = "#D55E00", size = 3) +
    ggplot2::geom_text(ggplot2::aes(y = Var,
                                    label = paste0(round(Var * 100, 1), "%")),
                       vjust = -0.5, size = 4, fontface = "bold") +
    ggplot2::scale_y_continuous(labels = scales::percent_format(),
                                limits = c(0, 1)) +
    ggplot2::labs(title = "Robust 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.8) +
      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")),
                            linewidth = 1.2) +
      ggrepel::geom_text_repel(data = load2,
                               ggplot2::aes(PC1 * sf, PC2 * sf, label = v),
                               size = 5, fontface = "bold") +
      ggplot2::labs(title = "Robust PCA Biplot",
                    x = "Component 1",
                    y = "Component 2") +
      theme_pretty +
      ggplot2::coord_equal()

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

  } else {

    warning("Biplot requires at least 2 PCs")
    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
  ))
}
