## generate sample data
set.seed(4321)
s <- seq(0, 1, length.out = 100)
t <- seq(0, 1, length.out = 100)
p1 <- 5
p2 <- 6
r <- 10
n <- 50
beta_basis1 <- splines::bs(s, df = p1, intercept = TRUE) # first basis for beta
beta_basis2 <- splines::bs(s, df = p2, intercept = TRUE) # second basis for beta
data_basis <- splines::bs(s, df = r, intercept = TRUE) # basis for X
x_0 <- apply(matrix(rnorm(p1 * p2, sd = 1), p1, p2), 1,
fdaSP::softhresh, 1.5) # regression coefficients
x_fun <- beta_basis2 %*% x_0 %*% t(beta_basis1)
fun_data <- matrix(rnorm(n*r), n, r) %*% t(data_basis)
b <- fun_data %*% x_fun + rnorm(n * 100, sd = sd(fun_data %*% x_fun )/3)
## set the hyper-parameters
maxit <- 1000
rho_adaptation <- FALSE
rho <- 0.01
reltol <- 1e-5
abstol <- 1e-5
## fit functional regression model
mod_cv <- f2fSP_cv(mY = b, mX = fun_data, L = p1, M = p2,
group_weights = NULL, var_weights = NULL,
standardize.data = FALSE, splOrd = 4,
lambda = NULL, nlambda = 30, cv.fold = 5,
lambda.min.ratio = NULL,
control = list("abstol" = abstol,
"reltol" = reltol,
"maxit" = maxit,
"adaptation" = rho_adaptation,
"rho" = rho,
"print.out" = FALSE))
### graphical presentation
plot(log(mod_cv$lambda), mod_cv$mse, type = "l", col = "blue", lwd = 2, bty = "n",
xlab = latex2exp::TeX("$\\log(\\lambda)$"), ylab = "Prediction Error",
ylim = range(mod_cv$mse - mod_cv$mse.sd, mod_cv$mse + mod_cv$mse.sd),
main = "Cross-validated Prediction Error")
fdaSP::confband(xV = log(mod_cv$lambda), yVmin = mod_cv$mse - mod_cv$mse.sd,
yVmax = mod_cv$mse + mod_cv$mse.sd)
abline(v = log(mod_cv$lambda[which(mod_cv$lambda == mod_cv$lambda.min)]), col = "red", lwd = 1.0)
### comparison with oracle error
mod <- f2fSP(mY = b, mX = fun_data, L = p1, M = p2,
group_weights = NULL, var_weights = NULL,
standardize.data = FALSE, splOrd = 4,
lambda = NULL, nlambda = 30, lambda.min.ratio = NULL,
control = list("abstol" = abstol,
"reltol" = reltol,
"maxit" = maxit,
"adaptation" = rho_adaptation,
"rho" = rho,
"print.out" = FALSE))
err_mod <- apply(mod$sp.coef.path, 1, function(x) sum((x - x_0)^2))
plot(log(mod$lambda), err_mod, type = "l", col = "blue", lwd = 2,
xlab = latex2exp::TeX("$\\log(\\lambda)$"),
ylab = "Estimation Error", main = "True Estimation Error", bty = "n")
abline(v = log(mod$lambda[which(err_mod == min(err_mod))]), col = "red", lwd = 1.0)
abline(v = log(mod_cv$lambda[which(mod_cv$lambda == mod_cv$lambda.min)]),
col = "red", lwd = 1.0, lty = 2)
Run the code above in your browser using DataLab