factor response and applyFolds()

[sbrockhaus]

applyFolds() does not work for factor response; i.e., response for family = Binomial().

[sbrockhaus]

applyFolds() gives the same results as cvrisk() for settings in which there should be no difference.

library(FDboost)

#############################################################
#############################################################
## sof

data("fuelSubset", package = "FDboost")
fuelSubset$UVVIS <- scale(fuelSubset$UVVIS, scale = FALSE)

## model fit with scalar response 
## include no intercept as all base-learners are centered around 0
mod2 <- FDboost(heatan ~ bsignal(UVVIS, uvvis.lambda), 
                timeformula = NULL, data = fuelSubset) 

set.seed(123)      
folds2 <- cv(weights = model.weights(mod2), B = 3)     
cvm2 <- cvrisk(mod2, folds = folds2, grid = 1:500)
appl2 <- applyFolds(mod2, folds = folds2, grid = 1:500)

par(mfrow = c(1,2))
plot(cvm2)
plot(appl2)

#############################################################

fuelSubset$bin <- rep(0, 129)
fuelSubset$bin[fuelSubset$heatan > 24] <- 1
fuelSubset$bin <- factor(fuelSubset$bin)

mod2 <- FDboost(bin ~ bsignal(UVVIS, uvvis.lambda), 
                timeformula = NULL, data = fuelSubset, family = Binomial()) 


set.seed(123)      
folds2 <- cv(weights = model.weights(mod2), B = 3)     
cvm2 <- cvrisk(mod2, folds = folds2, grid = 1:500)
appl2 <- applyFolds(mod2, folds = folds2, grid = 1:500)

par(mfrow = c(1,2))
plot(cvm2)
plot(appl2)


#############################################################
#############################################################
## fof

require(fda)

data("CanadianWeather", package = "fda")
CanadianWeather$l10precip <- t(log(CanadianWeather$monthlyPrecip))
CanadianWeather$temp <- t(CanadianWeather$monthlyTemp)
CanadianWeather$region <- factor(CanadianWeather$region)
CanadianWeather$month.s <- CanadianWeather$month.t <- 1:12

## center the temperature curves per time-point
CanadianWeather$temp <- scale(CanadianWeather$temp, scale = FALSE)
rownames(CanadianWeather$temp) <- NULL ## delete row-names

## fit model with cyclic splines over the year
mod3 <- FDboost(l10precip ~ bols(region, df = 2.5, contrasts.arg = "contr.dummy") 
                + bsignal(temp, month.s, knots = 11, cyclic = TRUE, 
                          df = 2.5, boundary.knots = c(0.5,12.5), check.ident = FALSE), 
                timeformula = ~ bbs(month.t, knots = 11, cyclic = TRUE, 
                                    df = 3, boundary.knots = c(0.5, 12.5)), 
                offset = "scalar", offset_control = o_control(k_min = 5), 
                data = CanadianWeather) 

set.seed(1234)      
folds2 <- cv(rep(1, length(unique(mod3$id))), B = 5)     
cvm2 <- cvrisk(mod3, folds = folds2[mod3$id, ], grid = 1:200)
appl2 <- applyFolds(mod3, folds = folds2, grid = 1:200)

par(mfrow = c(1,2))
plot(cvm2)
plot(appl2)


#############################################################
CanadianWeather$bin <- CanadianWeather$l10precip

CanadianWeather$bin[CanadianWeather$l10precip >= 0.5] <- "a"
CanadianWeather$bin[CanadianWeather$l10precip < 0.5 ] <- "b"


## fit model with cyclic splines over the year
mod3 <- FDboost(bin ~ bols(region, df = 2.5, contrasts.arg = "contr.dummy") 
                + bsignal(temp, month.s, knots = 11, cyclic = TRUE, 
                          df = 2.5, boundary.knots = c(0.5,12.5), check.ident = FALSE), 
                timeformula = ~ bbs(month.t, knots = 11, cyclic = TRUE, 
                                    df = 3, boundary.knots = c(0.5, 12.5)), 
                offset = "scalar", offset_control = o_control(k_min = 5), 
                data = CanadianWeather, family = Binomial()) 


set.seed(1234)      
folds2 <- cv(rep(1, length(unique(mod3$id))), B = 5)     
cvm2 <- cvrisk(mod3, folds = folds2[mod3$id, ], grid = 1:200)
appl2 <- applyFolds(mod3, folds = folds2, grid = 1:200)

par(mfrow = c(1,2))
plot(cvm2)
plot(appl2)