https://github.com/cran/fda
Tip revision: 3eb6ff18b66f5356573490974ba95badd695f44a authored by J. O. Ramsay on 17 November 2021, 14:50:02 UTC
version 5.5.1
version 5.5.1
Tip revision: 3eb6ff1
eval.posfd.R
predict.posfd <- function(object, newdata=NULL, Lfdobj=0, ...){
# Last modified 7 May 2012 by Jim Ramsay
if (is.null(newdata)) newdata <- object$argvals
evalPos <- eval.posfd(newdata, object$Wfdobj, Lfdobj)
#
evalPos
}
fitted.posfd <- function(object, ...){
predict(object)
}
residuals.posfd <- function(object, ...){
pred <- predict(object)
object$y-pred
}
eval.posfd <- function(evalarg, Wfdobj, Lfdobj=int2Lfd(0))
{
# Evaluates a value or a derivative of a positive functional
# data object.
# A positive functional data object h is = the form
# h(x) = (exp Wfdobj)(x)
# Note that the linear differential operator object LFDOBJ
# MUST be an integer in the range 0 to 1.
# Note that the first two arguments may be interchanged.
#
# Arguments:
# EVALARG ... A vector of values at which all functions are to
# evaluated.
# WFDOBJ ... Functional data object. It must define a single
# functional data observation.
# LFDOBJ ... A linear differential operator object
# applied to the functions that are evaluated.
# Default is INT2LFD(0).
#
# Returns: An array of function values corresponding to the
# argument values in EVALARG
# Exchange the first two arguments if the first is an FD object
# and the second numeric
if (is.numeric(Wfdobj) & inherits(class(evalarg), "fd")) {
temp <- Wfdobj
Wfdobj <- evalarg
evalarg <- temp
}
# Check the arguments
if (!is.numeric(evalarg)) stop(
"Argument EVALARG is not numeric.")
evalarg <- as.vector(evalarg)
# check WFDOBJ
if (!inherits(Wfdobj, "fd")) stop(
"Argument WFDOBJ is not a functional data object.")
# check LFDOBJ
Lfdobj = int2Lfd(Lfdobj)
if (!inherits(Lfdobj, "Lfd")) stop(
"LFDOBJ is not linear differential operator object.")
nderiv = Lfdobj$nderiv
# Extract information about the basis
basisobj <- Wfdobj$basis
nbasis <- basisobj$nbasis
rangeval <- basisobj$rangeval
onerow <- rep(1,nbasis)
# Set up coefficient array for FD
coef <- Wfdobj$coefs
# Evaluate function values
index <- evalarg < rangeval[1]-1e-10
if (length(evalarg[index]) > 0) evalarg <- evalarg[!index]
index <- evalarg > rangeval[2]+1e-10
if (length(evalarg[index]) > 0) evalarg <- evalarg[!index]
basismat <- getbasismatrix(evalarg, basisobj, 0)
fdvec <- exp(basismat %*% coef)
# If a differential operator has been defined in LFDOBJ, compute
# the derivative values
if (nderiv > 0) {
Lbasismat <- eval.basis(evalarg, basisobj, Lfdobj)
evalarray <- fdvec*(Lbasismat %*% coef)
} else evalarray <- fdvec
return(evalarray)
}