AddDensReg: Additive functional regression for densities as responses
In functionaldata/tFrechet: Statistical Analysis for Random Objects and Non-Euclidean Data
AddDensReg R Documentation
Additive functional regression for densities as responses
Description
Smooth backfitting procedure for estimating nonparametric functional additive models for density responses
Usage
AddDensReg(Ly, X, x = NULL, hu = NULL, hx = NULL, dSup = NULL)
Arguments
Ly
A list of n vectors holding random samples independently drawn from each density response
X
An n-by-d design matrix whose row vectors consist of regressors for component functions
x
A grid matrix whose row vectors consist of evaluation points for component functions. Defaults to the observed design matrix.
hu
A scalar bandwidth for kernel smoothing marginal mean function of the functional additive model
dSup
A 2-dimensional vector that specify the lower and upper limits of the common support for density responses. Defaults to the range of the observed random samples.
huA
d-dimensional vector bandwidth for kernel smoothing each component function
Details
AddDensReg fits additive functional regression models for density responses, where the conditional mean function of a transformed density response is given by the summation of nonparametric univariate functions associated with d covariates, respectively.
Instead of having functional responses as infinite-dimensional random objects, AddDensReg has inputs with random samples independently drawn from each random density, and density responses are reconstructed by kernel density estimation.
The current version only supports the log-quantile density (LQD) transformation proposed by Petersen and Mueller (2016).
Value
A list holding the following fields:
lqdGrid
A grid where the LQD transformed density responses are evaluated. Defaults to an equally space grid over dSup.
lqdSbfMean
The marginal mean function estimates evaluated on lqdGrid
LlqdSbfComp
A list of d matrices holding the estimates of each component function evaluated on lqdGrid
densGrid
A grid where density responses are evaluated. Defaults to an equally space grid over the range of the observed random samples.
densSbfMean
The density inversion of lqdSbfMean evaluated on densGrid
LdensSbfComp
A list of d matrices holding the density inversion of each component function together with lqdSbfMean evaluated on lqdGrid
References
Han, K., Mueller, H.-G., and Park, B. U. (2020), "Additive functional regression for densities as responses", Journal of the American Statistical Association , 115 (530), pp.997-1010.
Peterson, A. and Mueller, H.-G. (2016), "Functional data analysis for density functions by transformation to a Hilbert space", The Annals of Statistics, 44(1), pp.183-218
See Also
SBFitting in the fdapace package
Examples
library(MASS)
# additive component functions
g1 <- function (u, x1) sin(2*pi*u) * (2*x1 - 1)
g2 <- function (u, x2) sin(2*pi*u) * sin(2*pi*x2)
g <- function (u, x) g1(u, x[1]) + g2(u, x[2])
# generating random samples from conditional quantile functions
GenLqdNoise <- function (u, e) e[1]*sin(pi*u) + e[2]*sin(2*pi*u)
GenQdensResp <- function (u, x, e) exp(g(u, x) + GenLqdNoise(u, e))
GenQuantileResp <- function (u, x, e) {
tmp1 <- integrate(GenQdensResp, lower = 0, upper = u, x = x, e = e)$value
tmp2 <- integrate(GenQdensResp, lower = 0, upper = 1, x = x, e = e)$value
return (tmp1 / tmp2)
}
set.seed(999)
n <- 150
N <- 250
Sigma <- matrix(c(1, 0.5, 0.5, 1), nrow = 2, ncol = 2)
X <- pnorm(mvrnorm(n, rep(0, 2), Sigma))
Ly <- list()
for (i in 1:n) {
U_i <- runif(N)
E_i <- c(rnorm(1, 0, 0.1), rnorm(1, 0, 0.05))
Ly[[i]] <- sapply(1:N, function (l) GenQuantileResp(U_i[l], X[i,], E_i))
}
M <- 51
x1 <- x2 <- seq(0, 1, length.out = M)
x <- cbind(x1, x2)
hu <- 0.05
hx <- c(0.075, 0.075)
dSup <- c(0, 1)
# estimating the functional additive model
estAddDensReg <- AddDensReg(Ly = Ly, X = X, x = x, hu = hu, hx = hx, dSup = dSup)
# true LQD component functions
g1Eval <- g2Eval <- matrix(nrow = length(estAddDensReg$lqdGrid), ncol = M)
for (l in seq(estAddDensReg$lqdGrid)) {
for (m in seq(M)) {
g1Eval[l,m] <- g1(estAddDensReg$lqdGrid[l], x1[m])
g2Eval[l,m] <- g2(estAddDensReg$lqdGrid[l], x2[m])
}
}
# LQD component function estimates
g0Sbf <- estAddDensReg$lqdSbfMean
gjSbf <- estAddDensReg$LlqdSbfComp
# true density component functions
dens1Eval <- dens2Eval <- matrix(nrow = length(estAddDensReg$densGrid), ncol = M)
for (m in seq(M)) {
dens1Eval[,m] <- fdadensity::lqd2dens(lqd = g1Eval[,m],
lqdSup = estAddDensReg$lqdGrid,
dSup = estAddDensReg$densGrid)
dens2Eval[,m] <- fdadensity::lqd2dens(lqd = g2Eval[,m],
lqdSup = estAddDensReg$lqdGrid,
dSup = estAddDensReg$densGrid)
}
# density component function estimates
dens0Sbf <- estAddDensReg$densSbfMean
densjSbf <- estAddDensReg$LdensSbfComp
# graphical illustration of LQD component function estimates
par(mfrow = c(2,2))
par(mar=rep(0.5, 4)+0.1)
persp(estAddDensReg$lqdGrid, x1, g1Eval,
theta = 35, phi = 35,
xlab = '\n u', ylab = '\n x1', zlab = '\n LQD component (g1)',
border = NA, shade = 0.5,
ticktype = 'detailed')
persp(estAddDensReg$lqdGrid, x2, g2Eval,
theta = 35, phi = 35,
xlab = '\n u', ylab = '\n x1', zlab = '\n LQD component (g2)',
border = NA, shade = 0.5,
ticktype = 'detailed')
persp(estAddDensReg$lqdGrid, x1, gjSbf[[1]],
theta = 35, phi = 35,
xlab = '\n u', ylab = '\n x1', zlab = '\n SBF estimate (g1)',
border = NA, shade = 0.5,
ticktype = 'detailed')
persp(estAddDensReg$lqdGrid, x2, gjSbf[[2]],
theta = 35, phi = 35,
xlab = '\n u', ylab = '\n x2', zlab = '\n SBF estimate (g2)',
border = NA, shade = 0.5,
ticktype = 'detailed')
# graphical illustration of density component function estimates
par(mfrow = c(2,2))
par(mar=rep(0.5, 4)+0.1)
persp(estAddDensReg$densGrid, x1, dens1Eval,
theta = 35, phi = 35,
xlab = '\n y', ylab = '\n x1', zlab = '\n\n Component density \n (Inversion of g0 + g1)',
border = NA, shade = 0.5,
ticktype = 'detailed')
persp(estAddDensReg$densGrid, x2, dens2Eval,
theta = 35, phi = 35,
xlab = '\n y', ylab = '\n x1', zlab = '\n\n Component density \n (Inversion of g0 + g2)',
border = NA, shade = 0.5,
ticktype = 'detailed')
persp(estAddDensReg$densGrid, x1, densjSbf[[1]],
theta = 35, phi = 35,
xlab = '\n y', ylab = '\n x1', zlab = '\n\n SBF estimate \n (Inversion of g0 + g1)',
border = NA, shade = 0.5,
ticktype = 'detailed')
persp(estAddDensReg$densGrid, x2, densjSbf[[2]],
theta = 35, phi = 35,
xlab = '\n y', ylab = '\n x1', zlab = '\n\n SBF estimate \n (Inversion of g0 + g2)',
border = NA, shade = 0.5,
ticktype = 'detailed')
# fitted density responses
fitAddDensReg <- AddDensReg(Ly = Ly, X = X, hu = hu, hx = hx, dSup = dSup)
# fitted LQD component functions
g0SBFit <- fitAddDensReg$lqdSbfMean
gjSBFit <- fitAddDensReg$LlqdSbfComp
# fitted density responses
densSBFit <- lapply(1:n,
function (i) {
gSBFit <- g0SBFit + gjSBFit[[1]][,i] + gjSBFit[[2]][,i]
densSBFit_i <- fdadensity::lqd2dens(lqd = gSBFit,
lqdSup = fitAddDensReg$lqdGrid,
dSup = fitAddDensReg$densGrid)
return (densSBFit_i)
}
)
# graphical illustration of fitted density responses
set.seed(999)
ind <- sample(1:n, 12)
par(mfrow = c(3, 4))
par(mar=c(4, 4, 4, 1)+0.1)
for (i in ind) {
hist_i <- hist(Ly[[i]], plot = FALSE)
hist(Ly[[i]], probability = TRUE,
ylim = range(c(hist_i$density, densSBFit[[i]])),
xlab = 'Y',
main = paste(i, '-th random sample \n with X = (', round(X[i,1],2), ', ', round(X[i,2],2), ')', sep = ''))
lines(fitAddDensReg$densGrid, densSBFit[[i]], col = 2, lwd = 2)
}
functionaldata/tFrechet documentation built on Oct. 12, 2024, 6:33 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
| AddDensReg | R Documentation |
Additive functional regression for densities as responses
Description
Smooth backfitting procedure for estimating nonparametric functional additive models for density responses
Usage
AddDensReg(Ly, X, x = NULL, hu = NULL, hx = NULL, dSup = NULL)
Arguments
Ly |
A list of n vectors holding random samples independently drawn from each density response |
X |
An n-by-d design matrix whose row vectors consist of regressors for component functions |
x |
A grid matrix whose row vectors consist of evaluation points for component functions. Defaults to the observed design matrix. |
hu |
A scalar bandwidth for kernel smoothing marginal mean function of the functional additive model |
dSup |
A 2-dimensional vector that specify the lower and upper limits of the common support for density responses. Defaults to the range of the observed random samples. |
huA |
d-dimensional vector bandwidth for kernel smoothing each component function |
Details
AddDensReg fits additive functional regression models for density responses, where the conditional mean function of a transformed density response is given by the summation of nonparametric univariate functions associated with d covariates, respectively.
Instead of having functional responses as infinite-dimensional random objects, AddDensReg has inputs with random samples independently drawn from each random density, and density responses are reconstructed by kernel density estimation.
The current version only supports the log-quantile density (LQD) transformation proposed by Petersen and Mueller (2016).
Value
A list holding the following fields:
lqdGrid |
A grid where the LQD transformed density responses are evaluated. Defaults to an equally space grid over |
lqdSbfMean |
The marginal mean function estimates evaluated on |
LlqdSbfComp |
A list of d matrices holding the estimates of each component function evaluated on |
densGrid |
A grid where density responses are evaluated. Defaults to an equally space grid over the range of the observed random samples. |
densSbfMean |
The density inversion of |
LdensSbfComp |
A list of d matrices holding the density inversion of each component function together with |
References
Han, K., Mueller, H.-G., and Park, B. U. (2020), "Additive functional regression for densities as responses", Journal of the American Statistical Association , 115 (530), pp.997-1010.
Peterson, A. and Mueller, H.-G. (2016), "Functional data analysis for density functions by transformation to a Hilbert space", The Annals of Statistics, 44(1), pp.183-218
See Also
SBFitting in the fdapace package
Examples
library(MASS)
# additive component functions
g1 <- function (u, x1) sin(2*pi*u) * (2*x1 - 1)
g2 <- function (u, x2) sin(2*pi*u) * sin(2*pi*x2)
g <- function (u, x) g1(u, x[1]) + g2(u, x[2])
# generating random samples from conditional quantile functions
GenLqdNoise <- function (u, e) e[1]*sin(pi*u) + e[2]*sin(2*pi*u)
GenQdensResp <- function (u, x, e) exp(g(u, x) + GenLqdNoise(u, e))
GenQuantileResp <- function (u, x, e) {
tmp1 <- integrate(GenQdensResp, lower = 0, upper = u, x = x, e = e)$value
tmp2 <- integrate(GenQdensResp, lower = 0, upper = 1, x = x, e = e)$value
return (tmp1 / tmp2)
}
set.seed(999)
n <- 150
N <- 250
Sigma <- matrix(c(1, 0.5, 0.5, 1), nrow = 2, ncol = 2)
X <- pnorm(mvrnorm(n, rep(0, 2), Sigma))
Ly <- list()
for (i in 1:n) {
U_i <- runif(N)
E_i <- c(rnorm(1, 0, 0.1), rnorm(1, 0, 0.05))
Ly[[i]] <- sapply(1:N, function (l) GenQuantileResp(U_i[l], X[i,], E_i))
}
M <- 51
x1 <- x2 <- seq(0, 1, length.out = M)
x <- cbind(x1, x2)
hu <- 0.05
hx <- c(0.075, 0.075)
dSup <- c(0, 1)
# estimating the functional additive model
estAddDensReg <- AddDensReg(Ly = Ly, X = X, x = x, hu = hu, hx = hx, dSup = dSup)
# true LQD component functions
g1Eval <- g2Eval <- matrix(nrow = length(estAddDensReg$lqdGrid), ncol = M)
for (l in seq(estAddDensReg$lqdGrid)) {
for (m in seq(M)) {
g1Eval[l,m] <- g1(estAddDensReg$lqdGrid[l], x1[m])
g2Eval[l,m] <- g2(estAddDensReg$lqdGrid[l], x2[m])
}
}
# LQD component function estimates
g0Sbf <- estAddDensReg$lqdSbfMean
gjSbf <- estAddDensReg$LlqdSbfComp
# true density component functions
dens1Eval <- dens2Eval <- matrix(nrow = length(estAddDensReg$densGrid), ncol = M)
for (m in seq(M)) {
dens1Eval[,m] <- fdadensity::lqd2dens(lqd = g1Eval[,m],
lqdSup = estAddDensReg$lqdGrid,
dSup = estAddDensReg$densGrid)
dens2Eval[,m] <- fdadensity::lqd2dens(lqd = g2Eval[,m],
lqdSup = estAddDensReg$lqdGrid,
dSup = estAddDensReg$densGrid)
}
# density component function estimates
dens0Sbf <- estAddDensReg$densSbfMean
densjSbf <- estAddDensReg$LdensSbfComp
# graphical illustration of LQD component function estimates
par(mfrow = c(2,2))
par(mar=rep(0.5, 4)+0.1)
persp(estAddDensReg$lqdGrid, x1, g1Eval,
theta = 35, phi = 35,
xlab = '\n u', ylab = '\n x1', zlab = '\n LQD component (g1)',
border = NA, shade = 0.5,
ticktype = 'detailed')
persp(estAddDensReg$lqdGrid, x2, g2Eval,
theta = 35, phi = 35,
xlab = '\n u', ylab = '\n x1', zlab = '\n LQD component (g2)',
border = NA, shade = 0.5,
ticktype = 'detailed')
persp(estAddDensReg$lqdGrid, x1, gjSbf[[1]],
theta = 35, phi = 35,
xlab = '\n u', ylab = '\n x1', zlab = '\n SBF estimate (g1)',
border = NA, shade = 0.5,
ticktype = 'detailed')
persp(estAddDensReg$lqdGrid, x2, gjSbf[[2]],
theta = 35, phi = 35,
xlab = '\n u', ylab = '\n x2', zlab = '\n SBF estimate (g2)',
border = NA, shade = 0.5,
ticktype = 'detailed')
# graphical illustration of density component function estimates
par(mfrow = c(2,2))
par(mar=rep(0.5, 4)+0.1)
persp(estAddDensReg$densGrid, x1, dens1Eval,
theta = 35, phi = 35,
xlab = '\n y', ylab = '\n x1', zlab = '\n\n Component density \n (Inversion of g0 + g1)',
border = NA, shade = 0.5,
ticktype = 'detailed')
persp(estAddDensReg$densGrid, x2, dens2Eval,
theta = 35, phi = 35,
xlab = '\n y', ylab = '\n x1', zlab = '\n\n Component density \n (Inversion of g0 + g2)',
border = NA, shade = 0.5,
ticktype = 'detailed')
persp(estAddDensReg$densGrid, x1, densjSbf[[1]],
theta = 35, phi = 35,
xlab = '\n y', ylab = '\n x1', zlab = '\n\n SBF estimate \n (Inversion of g0 + g1)',
border = NA, shade = 0.5,
ticktype = 'detailed')
persp(estAddDensReg$densGrid, x2, densjSbf[[2]],
theta = 35, phi = 35,
xlab = '\n y', ylab = '\n x1', zlab = '\n\n SBF estimate \n (Inversion of g0 + g2)',
border = NA, shade = 0.5,
ticktype = 'detailed')
# fitted density responses
fitAddDensReg <- AddDensReg(Ly = Ly, X = X, hu = hu, hx = hx, dSup = dSup)
# fitted LQD component functions
g0SBFit <- fitAddDensReg$lqdSbfMean
gjSBFit <- fitAddDensReg$LlqdSbfComp
# fitted density responses
densSBFit <- lapply(1:n,
function (i) {
gSBFit <- g0SBFit + gjSBFit[[1]][,i] + gjSBFit[[2]][,i]
densSBFit_i <- fdadensity::lqd2dens(lqd = gSBFit,
lqdSup = fitAddDensReg$lqdGrid,
dSup = fitAddDensReg$densGrid)
return (densSBFit_i)
}
)
# graphical illustration of fitted density responses
set.seed(999)
ind <- sample(1:n, 12)
par(mfrow = c(3, 4))
par(mar=c(4, 4, 4, 1)+0.1)
for (i in ind) {
hist_i <- hist(Ly[[i]], plot = FALSE)
hist(Ly[[i]], probability = TRUE,
ylim = range(c(hist_i$density, densSBFit[[i]])),
xlab = 'Y',
main = paste(i, '-th random sample \n with X = (', round(X[i,1],2), ', ', round(X[i,2],2), ')', sep = ''))
lines(fitAddDensReg$densGrid, densSBFit[[i]], col = 2, lwd = 2)
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.