tests/bodyfat.R

In tbm: Transformation Boosting Machines

suppressPackageStartupMessages(library("tbm"))
options(warn = -1L)
library("tram")
library("partykit")

set.seed(29)

data("bodyfat", package = "TH.data")

mf <- as.mlt(Colr(DEXfat ~ 1, data = bodyfat, order = 5))
logLik(mf)

Mstop <- 50

fd <- cv(rep(1, NROW(bodyfat)), type = "kfold", B = 2)

bctrl <- boost_control(nu = .1, trace = FALSE, mstop = Mstop)

tctrl <- ctree_control(minsplit = 8, minbucket = 5, mincriterion = 0,
                       maxdepth = 4, splittest = FALSE, 
                       testtype = "Teststatistic")

bf_t <- ctmboost(model = mf, formula = DEXfat ~ ., data = bodyfat, 
                 method = quote(mboost::blackboost), control = bctrl, 
                 tree_control = tctrl)
logLik(bf_t)

bf_ctm <- ctmboost(model = mf, formula = DEXfat ~ ., data = bodyfat, 
                   control = bctrl)
logLik(bf_ctm)
table(selected(bf_ctm))

bf_dr <- ctmboost(model = mf, formula = DEXfat ~ ., data = bodyfat,
                  baselearner = "bols", control = bctrl)
logLik(bf_dr)
table(selected(bf_dr))

bf_st <- stmboost(model = mf, formula = DEXfat ~ ., data = bodyfat, 
                  method = quote(mboost::blackboost), tree_control = tctrl)
round(logLik(bf_st), 0)

bf_shift <- stmboost(model = mf, formula = DEXfat ~ ., data = bodyfat, 
                     method = quote(mboost::gamboost))
logLik(bf_shift)
table(selected(bf_shift))

bf_lin <- stmboost(model = mf, formula = DEXfat ~ . - 1, data = bodyfat, 
                   method = quote(mboost:::glmboost.formula))
logLik(bf_lin)
table(selected(bf_lin))

mf2 <- Lm(DEXfat ~ 1, data = bodyfat)

bf_lin2 <- ctmboost(model = mf2, formula = DEXfat ~ ., data = bodyfat)
logLik(bf_lin2$model, parm = coef(bf_lin2))
table(selected(bf_lin2))

### test against L_2 glmboost
m <- Lm(DEXfat ~ 1, data = bodyfat, fixed = c("DEXfat" = 1))
bf_1 <- stmboost(model = m, formula = DEXfat ~ 0 + ., data = bodyfat, 
                  control = bctrl,
                  method = quote(mboost:::glmboost.formula), 
                  mltargs = list(fixed = c("DEXfat" = 1)))
bf_2 <- glmboost(DEXfat ~ ., data = bodyfat, offset = mean(bodyfat$DEXfat),
                  control = bctrl)
stopifnot(max(abs(mboost:::coef.glmboost(bf_1) - coef(bf_2)[-1])) < 
          sqrt(.Machine$double.eps))
r <- risk(bf_1)
stopifnot(r[length(r)] + logLik(bf_1) < sqrt(.Machine$double.eps))

stopifnot(max(abs(-nuisance(bf_1) + mboost:::predict.glmboost(bf_1) - predict(bf_2))) < 
          sqrt(.Machine$double.eps))