Fixes to mint.block.(s)pls() and predict() functions

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))

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))
 
 }

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")

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))
 
 }

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)