R/bootMbpcaK.R

In mengchen18/mogsa: Multiple omics data integrative clustering and gene set analysis

#' An internal function called by \code{\link{bootMbpca}}.
#' 
#' An internal function called by \code{\link{bootMbpca}}.
#' 
#' 
#' @param data A \code{list} of \code{matrix} to bootstrap.
#' @param replace A logical variable to indicate sampling with or without
#' replacement
#' @param B Integer; number of bootstrap.
#' @param mc.cores Integer; number of cores used in bootstrap. This value is
#' passed to function mclapply
#' @param resample Could be one of "sample", "gene" or "total". "sample" and
#' "gene" means sample-wise and variable-wise resampling, repectively. "total"
#' means total resampling.
#' @param ncomp passed to \code{\link{mbpca}}.
#' @param method passed to \code{\link{mbpca}}.
#' @param k passed to \code{\link{mbpca}}.
#' @param center passed to \code{\link{mbpca}}.
#' @param scale passed to \code{\link{mbpca}}.
#' @param option passed to \code{\link{mbpca}}.
#' @param maxiter passed to \code{\link{mbpca}}.
#' @param svd.solver passed to \code{\link{mbpca}}.
#' @return A matrix of mbpca eigenvalues resulted from bootstrap samples
#' @author Chen Meng
#' @importFrom parallel mclapply
#' @export
#' @seealso \code{\link{bootMbpca}}
bootMbpcaK <-
function(data, replace, B=100, mc.cores=1, resample = c("sample", "total", "gene"), 
                       ncomp, method, k, 
                       center=FALSE, scale=FALSE, option="uniform", 
                       maxiter=1000, svd.solver=c("svd", "fast.svd", "propack")) {
  
  
  resampleMbpca <- function(d, ncomp, method, k, center, scale, option, 
                            maxiter, replace, resample, svd.solver) {
    rsd <- switch(resample,
                  "sample" = lapply(d, function(x) x[, sample(1:ncol(x), replace = replace)]),
                  "gene" = lapply(d, function(x) t(apply(x, 1, sample, replace=replace))),
                  "total" = lapply(d, function(x) apply(x, 2, sample, replace=replace)))
                  # "total" = lapply(d, function(x) x[sample(1:nrow(x), replace = replace), sample(1:ncol(x), replace = replace)]))
    res <- mbpca(x = rsd, verbose = FALSE, moa=FALSE, 
                 ncomp=ncomp, method=method, k=k, center=center, 
                 scale=scale, option=option, maxiter=maxiter, svd.solver)
    diag(crossprod(res$t))
  }
  
  svd.solver <- match.arg(svd.solver)
  resample <- match.arg(resample)
  r <- mclapply(1:B, mc.cores = mc.cores, function(x) 
    resampleMbpca(data, ncomp, method, k, center, scale, option, maxiter, replace, resample, svd.solver))
  do.call("rbind", r)
  
}