tensor_predictors/tensorPredictors/R/HOPCA.R

#' 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
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
}