#' Internal function for computing bootstrap of RGCCA.
#' @inheritParams rgcca_bootstrap
#' @param inds A vector of integers defining the index of the observations
#' taken into account for this bootstrap sample.
#' @param type A character indicating the type of the second object to return.
#' @return \item{W}{A list of RGCCA bootstrap weights. Returned only if there
#' are no missing variables, otherwise the name of the missing variables are
#' returned.}
#' @return \item{L}{If type == "loadings", a list of RGCCA bootstrap loadings.
#' Returned only if there are no missing variables, otherwise the name of the
#' missing variables are returned.
#' If type == "AVE", the AVE of the fitted RGCCA model.}
#' @title Compute bootstrap (internal).
#' @noRd
rgcca_bootstrap_k <- function(rgcca_res, inds = NULL, type = "loadings") {
if (length(inds) > 0) {
rgcca_res$call$blocks <- lapply(rgcca_res$call$blocks, function(x) {
y <- x[inds, , drop = FALSE]
rownames(y) <- paste("S", seq_along(inds))
return(y)
})
}
rgcca_res_boot <- rgcca(rgcca_res)
# block-weight vector
missing_var <- unlist(lapply(
seq_along(rgcca_res_boot$a),
function(x) {
setdiff(
colnames(rgcca_res$blocks[[x]]),
rownames(rgcca_res_boot$a[[x]])
)
}
))
if (length(missing_var) == 0) {
# block-loadings vector
A <- check_sign_comp(rgcca_res, rgcca_res_boot$a)
if (type == "loadings") {
Y <- lapply(
seq_along(A),
function(j) pm(rgcca_res_boot$blocks[[j]], A[[j]])
)
L <- lapply(
seq_along(A),
function(j) {
cor2(rgcca_res_boot$blocks[[j]], Y[[j]])
}
)
} else {
L <- lapply(names(A), function(n) {
if (!(n %in% names(rgcca_res$AVE$AVE_X))) {
res <- rep(-1, NCOL(rgcca_res$a[[n]]))
} else {
res <- rgcca_res_boot$AVE$AVE_X[[n]]
}
res <- matrix(
res, nrow = nrow(A[[n]]),
ncol = length(res), byrow = TRUE
)
rownames(res) <- rownames(A[[n]])
return(res)
})
}
names(L) <- names(rgcca_res$a)
return(list(W = A, L = L))
} else {
return(NULL)
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.