R/pls_prediction.R

In kimsche/MetaboMate: All you need for NMR-based metabolic profiling with R!

#' Predicting scores and Y outcome using PLS component(s)
#' @param X Input matrix with rows and columns representing new observations with identical number of variables than length of \code{pls_mod$loadings}.
#' @param pls_mod PLS component as outputted by function \cite{\code{NIPALS_PLS_component}}
#' @return Returned is a list with the following entries:
#' \item{Scores_pred}{Predicted PLS component scores.}
#' \item{Y_hat}{Predicted outcome. Averaged over all components in multi-PLS-component case.}
#' #' \item{Y_hat_components}{Predicted outcome (Y) for each component.}
#' @author Torben Kimhofer \email{tkimhofer@@gmail.com}
pls_prediction <- function(pls_mod, X) {
    # in case of one sample scenario
    if (is.null(ncol(X))) {
        X <- rbind(X)
    }
    # calc scores predictions and residuals
    t_pred <- X %*% t(pls_mod$weights)
    E_h <- X - (t_pred %*% pls_mod$loadings)
    betas <- pls_mod$betas
    q_h <- pls_mod$Qpc
    # if(q_h[1,1]==-q_h[2,1]){q_h=rbind(q_h[1,])}
    res <- matrix(NA, nrow = nrow(X), ncol = ncol(pls_mod$scores))
    for (i in 1:ncol(pls_mod$scores)) {
        opts <- t(cbind(betas[i]) %*% t_pred[, i]) %*% (q_h[, i])
        res[, i] <- apply(opts, 1, sum)  # this sums up over all components, in two case scenario both columns are identical but different sign: that nulls this.
    }
    totalPrediction <- apply(res, 1, sum)
    res <- list(Scores_pred = t_pred, Y_hat = totalPrediction, Y_hat_components = res)
    return(res)
}