R/wrapper.R

In tidymodels/plsmod: Model Wrappers for Projection Methods

#' Wrapper for mixOmics pls functions
#'
#' Based on arguments, this wrapper routes the data and arguments to the four
#' `pls` functions that are sparse/dense or regression/classification.
#' @param x A data frame or matrix of predictors.
#' @param y For classification, a factor. For regression, a matrix, vector, or
#' data frame.
#' @param ncomp The number of PLS components. If left NULL, the maximum possible
#' is used.
#' @param predictor_prop The maximum proportion of original predictors that can
#' have _non-zero_ coefficients for each PLS component (via regularization).
#' This value is used for all PLS components for X.
#' @return A model object generated by [mixOmics::pls()], [mixOmics::plsda()],
#' [mixOmics::spls()], or [mixOmics::splsda()].
#' @export
#' @keywords internal
pls_fit <- function(x, y, ncomp = NULL, predictor_prop = 1, ...) {
  p <- ncol(x)
  if (!is.matrix(x)) {
    x <- as.matrix(x)
  }
  if (is.null(ncomp)) {
    ncomp <- p
  } else {
    ncomp <- min(ncomp, p)
  }

  predictor_prop <- max(predictor_prop, 1e-05)
  predictor_prop <- min(predictor_prop, 1)
  cuts <- seq(0, p, length.out = p + 1)
  keepX <- as.integer(cut(predictor_prop * p, breaks = cuts, include.lowest = TRUE))
  keepX <- rep(keepX, ncomp)

  if (is.factor(y)) {
    res <- mixOmics::splsda(X = x, Y = y, ncomp = ncomp, keepX = keepX, ...)
  } else {
    res <- mixOmics::spls(X = x, Y = y, ncomp = ncomp, keepX = keepX, ...)
  }
  res
}