tensor_predictors/tensorPredictors/R/HOPCA.R

37 lines
1.3 KiB
R
Raw Normal View History

#' Higher Order Principal Component Analysis
#'
#' @param X multi-dimensional array (at least a matrix)
#' @param npc Number of Principal Components for each axis, if not specified
#' its the maximum
#' @param sample.axis index of the sample mode, a.k.a. observation axis index
#'
#' @return list of matrices, each entry are the first PCs of the corresponding
#' axis. The `i`'th entry are the `npc[i]` first Principal Components of the
#' `i`th axis excluding the sample axis.
#'
#' @export
2023-11-14 13:35:43 +00:00
HOPCA <- function(X, npc = dim(X)[-sample.axis], sample.axis = 1L, use.C = FALSE) {
# observation index numbers (all axis except the sample axis)
modes <- seq_along(dim(X))[-sample.axis]
# Mean (a.k.a. sum elements over the sample axis)
mu <- apply(X, modes, mean, simplify = TRUE)
# Center `X` by subtraction of the mean `mu` from each observation
X.centered <- sweep(X, modes, mu)
# PCA for each mode (axis)
PCs <- Map(function(i) {
La.svd(mcrossprod(X.centered, mode = modes[i]), npc[i], 0)$u
}, seq_along(modes))
# Set names if any
if (!is.null(dimnames(X))) {
names(PCs) <- names(dimnames(X)[-sample.axis])
for (i in seq_along(modes)) {
dimnames(PCs[[i]]) <- list(dimnames(X)[-sample.axis][[i]], NULL)
}
}
PCs
}