R/smooth.fd.R

In fda: Functional Data Analysis

smooth.fd <- function(fdobj, fdParobj){
#SMOOTH_FD smooths a functional data object.
#
#  Arguments for this function:
#
#  FDOBJ    ... A functional data object.
#  FDPAROBJ ... A functional parameter object.
#
#  Returns a functional data object containing a smoothed version
#    of the input functional data object
#
#  Last modified: 20081003;  previously modified 26 October 2005
#

#  check fdParobj

if (!inherits(fdParobj,"fdPar")) stop(
		"FDPAROBJ is not a functional parameter object.")

#  check LFD

Lfdobj <- fdParobj$Lfd
Lfdobj <- int2Lfd(Lfdobj)
nderiv <- Lfdobj$nderiv

#  set up FDOBJ

newfdobj <- fdParobj$fd

#  set up basis

basisobj <- newfdobj$basis

#
#  Main smoothing step
#

coef  <- fdobj$coefs
coefd <- dim(coef)
ndim  <- length(coefd)
if (ndim == 3)  nvar <- coefd[3] else nvar <- 1

Bmat  <- inprod(basisobj, basisobj)

#
#  set up coefficient matrix for normal equations
#

lambda <- fdParobj$lambda
penmat <- eval.penalty(basisobj, Lfdobj)

penmat <- eval.penalty(basisobj, Lfdobj)
Cmat   <- Bmat + lambda * penmat

#
#  solve normal equations for each observation
#
if (ndim < 3){
     Dmat <- inprod(basisobj, fdobj)
     coef <- solve(Cmat, Dmat)
} else {
	coef <- array(0,coefd)
    for(ivar in 1:nvar){
        Dmat <- inprod(basisobj, fdobj[,ivar])
        coef[,,ivar] <- solve(Cmat, Dmat)
    }
}

#  set up the smoothed functional data object

fdnames <- fdobj$fdnames
smthfd  <- fd(coef, basisobj, fdnames)

return(smthfd)
}