https://github.com/cran/fda
Tip revision: 4c1575a5f8d26f0a3bf07ad7bf318206f89f7c1d authored by J. O. Ramsay on 03 October 2008, 00:00:00 UTC
version 2.1.1
version 2.1.1
Tip revision: 4c1575a
varmx.pca.fd.R
varmx.pca.fd <- function(pcafd, nharm = scoresd[2], nx=501)
{
#
# Apply varimax to the first NHARM components of a pca.fd object.
# Evaluates the harmonics at NX equally spaced points.
#
# Returns:
# An object of class pcafd
# Note that pcafd is an oldClass type object
# Last modified 15 November 2006
if (!(inherits(pcafd, "pca.fd"))) stop(
"Argument PCAFD is not a pca.fd object.")
harmfd <- pcafd$harmonics
harmcoef <- harmfd$coefs
coefd <- dim(harmcoef)
ndim <- length(coefd)
scoresd <- dim(pcafd$scores)
if (nharm > scoresd[2]) nharm <- scoresd[2]
basisobj <- harmfd$basis
rangex <- basisobj$rangeval
x <- seq(rangex[1], rangex[2], length = nx)
delta <- x[2]-x[1]
harmmat <- eval.fd(x, harmfd)
# If fdmat is a 3-D array, stack into a matrix
if (ndim == 3) {
harmmatd <- dim(harmmat)
dimnames(harmmat) <- NULL
harmmat <- aperm(harmmat, c(1, 3, 2))
dim(harmmat) <- c(harmmatd[1] * harmmatd[3], harmmatd[2])
}
# compute rotation matrix for varimax rotation of harmmat
rotm <- varmx(harmmat)
# rotate coefficients and scores
if(ndim == 2)
harmcoef[,1:nharm] <- harmcoef[,1:nharm] %*% rotm
else
for(j in (1:coefd[3]))
harmcoef[,1:nharm,j] <- harmcoef[,1:nharm,j] %*% rotm
harmscrs <- pcafd$scores[,1:nharm]
harmscrs <- harmscrs %*% rotm
# compute proportions of variance
harmvar <- apply(harmscrs^2,2,sum)
varsum <- sum(harmvar)
propvar <- sum(pcafd$varprop)*harmvar/varsum
# modify pcafd object
harmfd$coefs <- harmcoef
pcafd$harmonics <- harmfd
pcafd$varprop <- propvar
pcafd$scores <- harmscrs
return(pcafd)
}