inst/doc/FLAM_fuel.R

In FDboost: Boosting Functional Regression Models

## ----ops, echo=FALSE----------------------------------------------------------
knitr::opts_chunk$set(comment=NA, warning=FALSE, message=FALSE)

## ----pkg-attach, echo = FALSE, warning=FALSE, message=FALSE-------------------
library(FDboost)

## ----load-data, echo = TRUE---------------------------------------------------
data(fuelSubset)
fuel <- fuelSubset
str(fuel)

# # normalize the wavelength to 0-1
# fuel$nir.lambda0 <- (fuel$nir.lambda - min(fuel$nir.lambda)) / 
#   (max(fuel$nir.lambda) - min(fuel$nir.lambda)) 
# fuel$uvvis.lambda0 <- (fuel$uvvis.lambda - min(fuel$uvvis.lambda)) / 
#   (max(fuel$uvvis.lambda) - min(fuel$uvvis.lambda))

# compute first derivatives as first order differences
fuel$dUVVIS <- t(apply(fuel$UVVIS, 1, diff))
fuel$dNIR <- t(apply(fuel$NIR, 1, diff)) 

# get the wavelength for the derivatives
fuel$duvvis.lambda <- fuel$uvvis.lambda[-1]
fuel$dnir.lambda <- fuel$nir.lambda[-1]
# fuel$duvvis.lambda0 <- fuel$uvvis.lambda0[-1]
# fuel$dnir.lambda0 <- fuel$nir.lambda0[-1]

## ----humidity-model, echo = TRUE, eval=FALSE----------------------------------
#  modH2O <- FDboost(h2o ~ bsignal(UVVIS, uvvis.lambda, knots=40, df=4)
#                      + bsignal(NIR, nir.lambda, knots=40, df=4)
#                      + bsignal(dUVVIS, duvvis.lambda, knots=40, df=4)
#                      + bsignal(dNIR, dnir.lambda, knots=40, df=4),
#                      timeformula=~bols(1), data=fuel)
#  
#  set.seed(212)
#  cvmH2O <- suppressWarnings(cvrisk(modH2O, grid=seq(100, 5000, by=100),
#                                folds=cv( model.weights(modH2O),
#                                type = "bootstrap", B = 10), mc.cores = 1))
#  
#  par(mfrow=c(1,2))
#  plot(cvmH2O)
#  
#  modH2O[mstop(cvmH2O)]
#  #modH2O[2400]
#  
#  #### create new variable of predicted h2o
#  h2o.fit <- modH2O$fitted()
#  
#  plot(fuel$h2o, h2o.fit)
#  abline(0,1)

## ----model-spec, echo=TRUE----------------------------------------------------
formula <- formula(heatan ~ bsignal(UVVIS, uvvis.lambda, knots=40, df=4.41) 
                   + bsignal(NIR, nir.lambda, knots=40, df=4.41))

## do a model fit:
mod <- FDboost(formula, timeformula=~bols(1), data=fuel)
mod <- mod[198]

## ----cv-model-spec, echo=TRUE, eval=FALSE-------------------------------------
#  ## get optimal mstop and do bootstrapping for coefficient estimates
#  set.seed(2703)
#  val <- validateFDboost(mod,
#                         folds=cv(model.weights(mod), type = "bootstrap", B = 50),
#                         grid = 10:500, mc.cores = 1)
#  
#  mopt <- val$grid[which.min(colMeans(val$oobrisk))]
#  print(mopt)
#  
#  ## use optimal mstop
#  mod <- mod[mopt] # 198

## ----model-spec-plot, echo=TRUE, fig.cap='Coefficient estimates for the effects of the two spectra.', fig.height=4, fig.width=10----
par(mfrow=c(1,2))
plot(mod, which=1, lwd=2, lty=5, rug=FALSE,
     ylab="", xlab="wavelength [nm]")

plot(mod, which=2, lwd=2, lty=5, rug=FALSE, 
     ylab="", xlab="wavelength [nm]")