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

#' @title Principal Component Regression (PCR)
#'
#' @description
#' Performs Principal Component Analysis (PCA) on predictors
#' followed by regression using selected principal components.
#' Includes Bartlett's test, KMO measure,
#' scree plot, biplot, and backward model selection.
#'
#' @param data A data frame or matrix
#' @param y Response variable name
#' @param scale. Logical; should variables be scaled?
#' @param center Logical; should variables be centered?
#' @param verbose Logical; print summaries?
#'
#' @return A list containing PCA results,
#' regression models, diagnostics, and plots.
#'
#' @importFrom stats cor prcomp lm step complete.cases
#' @importFrom psych cortest.bartlett KMO
#' @importFrom ggplot2 ggplot aes geom_col geom_line geom_point
#' @importFrom ggplot2 geom_text scale_y_continuous labs
#' @importFrom ggplot2 theme_minimal theme
#' @importFrom ggplot2 element_text element_line
#' @importFrom ggplot2 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 <- pcreg(mtcars, y = "mpg")

pcreg <- function(data,
                  y,
                  scale. = TRUE,
                  center = TRUE,
                  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 (!is.character(y) ||
      length(y) != 1) {
    stop("y must be a single character string")
  }

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

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

  Y <- df[[y]]

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

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

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

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

  cm <- stats::cor(X)

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

  bart <- NULL
  kmo <- NULL

  if (!singular) {

    bart <- tryCatch(
      psych::cortest.bartlett(
        cm,
        n = nrow(X)
      ),
      error = function(e) NULL
    )

    kmo <- tryCatch(
      psych::KMO(cm),
      error = function(e) NULL
    )
  }

  if (verbose) {

    message("\n--- PCA Suitability ---")

    if (!is.null(bart)) {

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

    } else {

      message("\nBartlett test not valid")
    }

    if (!is.null(kmo)) {

      message(
        "\nKMO: ",
        round(kmo$MSA, 3)
      )

    } else {

      message("\nKMO not valid")
    }
  }

  pca <- stats::prcomp(
    X,
    scale. = scale.,
    center = center
  )

  loadings <- as.data.frame(
    pca$rotation
  )

  scores <- as.data.frame(
    pca$x
  )

  variance <- pca$sdev^2 /
    sum(pca$sdev^2)

  if (verbose) {

    message("\n--- PCA Summary ---")

    print(summary(pca)$importance)

    message("\n--- PCA Loadings ---")

    print(round(loadings, 3))
  }

  ncomp <- which(
    cumsum(variance) >= 0.80
  )[1]

  ncomp <- min(
    ncomp,
    ncol(scores)
  )

  if (verbose) {

    message(
      "\nNumber of PCs retained: ",
      ncomp
    )
  }

  reg_data <- data.frame(
    Y = Y,
    scores[, 1:ncomp, drop = FALSE]
  )

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

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

  if (verbose) {

    message("\n--- Full PCR Model ---")

    print(summary(full_model))

    message(
      "\n--- Backward Selected Model ---"
    )

    print(summary(backward_model))
  }

  theme_pretty <-
    ggplot2::theme_minimal(
      base_family = "serif",
      base_size = 14
    ) +
    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 =
        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(variance)
      ),
      levels = paste0(
        "PC",
        seq_along(variance)
      )
    ),
    Var = variance,
    CumVar = cumsum(variance)
  )

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

  biplot_obj <- NULL

  if (ncol(scores) >= 2) {

    load2 <- loadings[
      , 1:2,
      drop = FALSE
    ]

    load2$v <- rownames(load2)

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

    scale_factor <- max(
      abs(score2)
    )

    biplot_obj <- ggplot2::ggplot() +

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

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

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

      ggplot2::labs(
        title = "PCA Biplot",
        x = "PC1",
        y = "PC2"
      ) +

      ggplot2::coord_equal() +
      theme_pretty

    gridExtra::grid.arrange(
      scree_plot,
      biplot_obj,
      ncol = 2
    )

  } else {

    warning(
      paste(
        "Biplot requires at least",
        "two principal components"
      )
    )

    print(scree_plot)
  }

  invisible(list(
    pca = pca,
    bartlett = bart,
    kmo = kmo,
    loadings = loadings,
    scores = scores,
    variance = variance,
    ncomp = ncomp,

    full_model = full_model,
    full_model_summary =
      summary(full_model),

    backward_model = backward_model,
    backward_model_summary =
      summary(backward_model),

    scree_plot = scree_plot,
    biplot = biplot_obj
  ))
}
