R/asmbPLS.fit.R

In asmbPLS: Predicting and Classifying Patient Phenotypes with Multi-Omics Data

#' asmbPLS for block-structured data
#'
#' Function to fit the adaptive sparse multi-block partial least square model 
#' (asmbPLS) with several explanatory blocks \eqn{(X_1, ..., X_B)} as our predictors
#' to explain the outcome Y.
#' 
#' @param X.matrix Predictors matrix. Samples in rows, variables in columns.
#' @param Y.matrix Outcome matrix. Samples in rows, this is a matrix with one 
#' column (continuous variable). The outcome could be imputed survival time. 
#' For survival time with right-censored survival time and event indicator, the 
#' right censored time could be imputed by \code{\link{meanimp}}.
#' @param PLS.comp Number of PLS components in asmbPLS.
#' @param X.dim A vector containing the number of predictors in each block 
#' (ordered).
#' @param quantile.comb A matrix containing quantile combinations used for 
#' different PLS components, whose row number equals to the number of PLS 
#' components used, column number equals to the number of blocks.
#' @param center A logical value indicating whether mean center should be 
#' implemented for X.matrix and Y.matrix. The default is TRUE.
#' @param scale  A logical value indicating whether scale should be 
#' implemented for X.matrix and Y.matrix. The default is TRUE.
#' @param maxiter A integer indicating the maximum number of iteration. The
#' default number is 100.
#' 
#' @return 
#' \code{asmbPLS.fit} returns a list containing the following components:
#' \item{X_dim}{A vector containing the number of predictors in each block.}
#' \item{X_weight}{A list containing the weights of predictors for different 
#' blocks in different PLS components.}
#' \item{X_score}{A list containing the scores of samples in different blocks
#' in different PLS components.}
#' \item{X_loading}{A list containing the loadings of predictors for different
#' blocks in different PLS components.}
#' \item{X_super_weight}{A matrix containing the super weights of different
#' blocks for different PLS components.}
#' \item{X_super_score}{A matrix containing the super scores of samples for
#' different PLS components.}
#' \item{Y_weight}{A matrix containing the weights of outcome for different 
#' PLS components.}
#' \item{Y_score}{A matrix containing the scores of outcome for different 
#' PLS components.}
#' \item{X_col_mean}{A matrix containing the mean of each predictor for scaling.}
#' \item{Y_col_mean}{The mean of outcome matrix for scaling.}
#' \item{X_col_sd}{A matrix containing the standard deviation of each predictor
#' for scaling. Predictor with sd = 0 will be set to 1.}
#' \item{Y_col_sd}{The standard deviation of outcome matrix for scaling.}
#' \item{center}{A logical value indicating whether mean center is
#' implemented for X.matrix and Y.matrix.}
#' \item{scale}{A logical value indicating whether scale is implemented for 
#' X.matrix and Y.matrix.}

#' @examples
#' ## Use the example dataset
#' data(asmbPLS.example)
#' X.matrix = asmbPLS.example$X.matrix
#' Y.matrix = asmbPLS.example$Y.matrix
#' PLS.comp = asmbPLS.example$PLS.comp
#' X.dim = asmbPLS.example$X.dim
#' quantile.comb = asmbPLS.example$quantile.comb
#'  
#' ## asmbPLS fit
#' asmbPLS.results <- asmbPLS.fit(X.matrix = X.matrix, 
#'                                Y.matrix = Y.matrix, 
#'                                PLS.comp = PLS.comp, 
#'                                X.dim = X.dim, 
#'                                quantile.comb = quantile.comb)
#' 
#' @export
#' @useDynLib asmbPLS, .registration=TRUE
#' @importFrom Rcpp sourceCpp
#' @importFrom stats quantile

asmbPLS.fit <- function(X.matrix, Y.matrix, PLS.comp, X.dim, quantile.comb, center = TRUE, scale = TRUE, maxiter = 100){
  stopifnot(!missing(X.matrix),
            !missing(Y.matrix),
            !missing(PLS.comp),
            !missing(X.dim),
            !missing(quantile.comb),
            is.matrix(X.matrix), 
            is.matrix(Y.matrix),
            is.matrix(quantile.comb))
  blocks_vector <- rep(1:length(X.dim), times = X.dim)
  blocks <- lapply(1:2, function(x) which(blocks_vector == x))
  fit.results <- asmbPLS_fit(X.matrix, Y.matrix, PLS.comp, X.dim, quantile.comb, center, scale, maxiter)
  for(i in 1:length(X.dim)) {
    row.names(fit.results$X_weight[[i]]) <- colnames(X.matrix)[blocks[[i]]]
  }
  return(fit.results)
}