diff --git a/R/mint.block.pls.R b/R/mint.block.pls.R index 0ca48409..565a86c9 100644 --- a/R/mint.block.pls.R +++ b/R/mint.block.pls.R @@ -40,8 +40,9 @@ #' @return \code{mint.block.pls} returns an object of class \code{"mint.pls", #' "block.pls"}, a list that contains the following components: #' -#' \item{X}{the centered and standardized original predictor matrix.} -#' \item{Y}{the centered and standardized original response vector or matrix.} +#' \item{X}{the centered and standardized original predictor and response matrices.} +# \item{Y}{the centered and standardized original response vector or matrix.} +#' \item{indY}{the position of the outcome Y in the output list X.} #' \item{ncomp}{the number of components included in the model for each block.} #' \item{mode}{the algorithm used to fit the model.} \item{mat.c}{matrix of #' coefficients from the regression of X / residual matrices X on the @@ -128,12 +129,17 @@ mint.block.pls <- function(X, DA = FALSE ) + # calculate weights for each dataset + weights = get.weights(result$variates, indY = result$indY) + # choose the desired output from 'result' out=list( call = match.call(), X = result$A, - Y = result$A[[1]], + # Y = result$A[[result$indY]], + indY = result$indY, ncomp = result$ncomp, + design = result$design, mode = result$mode, study = result$study, variates = result$variates, @@ -146,7 +152,8 @@ mint.block.pls <- function(X, iter = result$iter, max.iter = result$max.iter, nzv = result$nzv, - scale = result$scale) + scale = result$scale, + weights = weights) class(out) = c("mint.block.pls","block.pls","sgcca") return(invisible(out)) diff --git a/R/mint.block.plsda.R b/R/mint.block.plsda.R index f4cb3676..b13e06a0 100644 --- a/R/mint.block.plsda.R +++ b/R/mint.block.plsda.R @@ -225,7 +225,7 @@ mint.block.plsda <- function(X, nzv = result$nzv, scale = result$scale) - class(out) = c("mint.block.plsda","mint.block.pls","block.pls","sgccda","sgcca","DA") + class(out) = c("mint.block.plsda","mint.block.pls","block.plsda","block.pls","sgccda","sgcca","DA") return(invisible(out)) } diff --git a/R/mint.block.spls.R b/R/mint.block.spls.R index f33c8d52..529f980b 100644 --- a/R/mint.block.spls.R +++ b/R/mint.block.spls.R @@ -32,8 +32,9 @@ #' @return \code{mint.block.spls} returns an object of class \code{"mint.spls", #' "block.spls"}, a list that contains the following components: #' -#' \item{X}{the centered and standardized original predictor matrix.} -#' \item{Y}{the centered and standardized original response vector or matrix.} +#' \item{X}{the centered and standardized original predictor and response matrices.} +# \item{Y}{the centered and standardized original response vector or matrix.} +#' \item{indY}{the position of the outcome Y in the output list X.} #' \item{ncomp}{the number of components included in the model for each block.} #' \item{mode}{the algorithm used to fit the model.} \item{mat.c}{matrix of #' coefficients from the regression of X / residual matrices X on the @@ -124,16 +125,23 @@ mint.block.spls <- function(X, DA = FALSE ) + # calculate weights for each dataset + weights = get.weights(result$variates, indY = result$indY) + # choose the desired output from 'result' out = list( call = match.call(), X = result$A, - Y = result$A[[1]], + # Y = result$A[[result$indY]], + indY = result$indY, ncomp = result$ncomp, mode = result$mode, study = result$study, - keepX = result$keepA[-result$indY], - keepY = result$keepA[result$indY][[1]], + # keepX = result$keepA[-result$indY], + # keepY = result$keepA[result$indY][[1]], + keepX = lapply(result$keepA, function(x){x[,-result$indY]}), + keepY = lapply(result$keepA, function(x){x[,result$indY]}), + design = result$design, variates = result$variates, loadings = result$loadings, variates.partial = result$variates.partial, @@ -144,7 +152,8 @@ mint.block.spls <- function(X, iter = result$iter, max.iter = result$max.iter, nzv = result$nzv, - scale = result$scale + scale = result$scale, + weights = weights ) class(out) = c("mint.block.spls","block.spls","sgcca") diff --git a/R/mint.block.splsda.R b/R/mint.block.splsda.R index 7b3a569a..65a8500e 100644 --- a/R/mint.block.splsda.R +++ b/R/mint.block.splsda.R @@ -186,8 +186,10 @@ mint.block.splsda <- function(X, ncomp = result$ncomp, mode = result$mode, study = result$study, - keepX = result$keepA[-result$indY], - keepY = result$keepA[result$indY][[1]], + # keepX = result$keepA[-result$indY], + # keepY = result$keepA[result$indY][[1]], + keepX = lapply(result$keepA, function(x){x[,-result$indY]}), + keepY = lapply(result$keepA, function(x){x[,result$indY]}), variates = result$variates, loadings = result$loadings, variates.partial = result$variates.partial, @@ -201,7 +203,7 @@ mint.block.splsda <- function(X, scale = result$scale ) - class(out) = c("mint.block.splsda","mint.block.spls","block.spls","sgccda","sgcca","DA") + class(out) = c("mint.block.splsda","mint.block.spls","block.splsda","block.spls","sgccda","sgcca","DA") return(invisible(out)) } diff --git a/R/predict.R b/R/predict.R index 10bf3097..4739c179 100644 --- a/R/predict.R +++ b/R/predict.R @@ -221,7 +221,7 @@ predict.mixo_pls <- multilevel = NULL } - mint.object = c("mint.pls", "mint.spls", "mint.plsda", "mint.splsda") + mint.object = c("mint.block.spls", "mint.block.pls", "mint.pls", "mint.spls", "mint.plsda", "mint.splsda") block.object = c("block.pls", "block.spls", "block.plsda", "block.splsda") ### if the object is a block, the input newdata is different, we check newdata, make sure it's a list and check newdata/X if(!inherits(object, block.object)) # not a block (pls/spls/plsda/splsda/mint...) @@ -510,6 +510,7 @@ predict.mixo_pls <- means.Y=matrix(0,nrow=nrow(concat.newdata[[1]]),ncol=q) sigma.Y=matrix(1,nrow=nrow(concat.newdata[[1]]),ncol=q) + # NOTE: Could use same values as for non mint here to use training data to estimate values for new studies #loop on the blocks to define means.Y and sigma.Y for mint analysis for(m in 1:M)