R/o2pls_pred.R

In ricoderks/Rcpm: General functions for the Center of Proteomics and Metabolomics (LUMC)

#' @title Prediction function of the opls package
#'
#' @description Prediction function of the opls package.
#'
#' @param A Observations
#' @param model o2pls model
#' @param direction from x to y ('xy') or from y to x ('yx')
#'
#' @return Matrix :
#' \item{Bhat}{Predictions}
#' \item{Scorenew}{Corresponding scores}
#' 
#' @details Prediction function of the opls package
#' 
#' @export
#'
#' @author E. Nevedomskaya
#' @author Rico Derks
o2pls_pred <- function(A, model, direction) {
	
# Prediction function of the o2pls package
#
# Input:
#   A: Observations
#   model: o2pls model
#   direction: from x to y ('xy') or from y to x ('yx')
# Output
#   Bhat : Predictions
#   Scorenew : Corresponding scores
	
	modelPred <- c()
	
	if (direction == "xy") {
		To <- c()
		
		if (length(model$TYosc) != 0) {
			for (i in 1:ncol(model$TYosc)) {
				to <- A %*% model$Wosc[ , i]
				To <- cbind(To, to)
				A <- A - to %*% t(model$PYosc[ , i])
			}
		}
		
		T <- A %*% model$W
		Yhat <- T %*% model$Bt %*% t(model$C)
		
		modelPred$T <- T
		modelPred$Yhat <- Yhat
		if (length(model$TYosc) != 0) {
			modelPred$To <- To
		}
	}
	
	if (direction == "yx") {
		Uo <- c()
		
		if (length(model$UXosc) != 0) {
			for (i in 1:ncol(model$UXosc)) { 
				uo <- A %*% model$Cosc[,i]
				Uo <- cbind(Uo, uo) 
				A <- A - uo %*% t(model$PXosc[ , i])
			}
		}
		
		U <- A %*% model$C
		Xhat <- U %*% model$Bu %*% t(model$W)
		modelPred$U <- U
		modelPred$Xhat <- Xhat
		if (length(model$UXosc) != 0) {
			modelPred$Uo <- Uo
		}
	}		
	
	return(modelPred)
}