#' 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 (note: this means there is an index #' shift after the sample axis). #' #' @export hopca <- function(X, npc = dim(X)[-sample.axis], sample.axis = 1L) { # 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, 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 }