https://github.com/cran/fda
Raw File
Tip revision: 4c1575a5f8d26f0a3bf07ad7bf318206f89f7c1d authored by J. O. Ramsay on 03 October 2008, 00:00:00 UTC
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)
}

back to top