Running ‘birds_Biometrics.R’ [10s/10s]
  Comparing ‘birds_Biometrics.Rout’ to ‘birds_Biometrics.Rout.save’ ... OK
  Running ‘bugfixes.R’ [38s/41s]
  Running ‘regtest-baselearner.R’ [1s/2s]
  Running ‘regtest-blackboost.R’ [42s/48s]
  Comparing ‘regtest-blackboost.Rout’ to ‘regtest-blackboost.Rout.save’ ... OK
  Running ‘regtest-family.R’ [14s/16s]
  Comparing ‘regtest-family.Rout’ to ‘regtest-family.Rout.save’ ... OK
  Running ‘regtest-gamboost.R’ [6s/6s]
  Comparing ‘regtest-gamboost.Rout’ to ‘regtest-gamboost.Rout.save’ ... OK
  Running ‘regtest-glmboost.R’ [9s/10s]
  Comparing ‘regtest-glmboost.Rout’ to ‘regtest-glmboost.Rout.save’ ... OK
  Running ‘regtest-hatmatrix.R’ [2s/3s]
  Comparing ‘regtest-hatmatrix.Rout’ to ‘regtest-hatmatrix.Rout.save’ ... OK
  Running ‘regtest-varimp.R’ [3s/4s]
  Comparing ‘regtest-varimp.Rout’ to ‘regtest-varimp.Rout.save’ ... OK
Running the tests in ‘tests/bugfixes.R’ failed.
Complete output:
  > 
  > options(digits = 3)
  > 
  > 
  > .all.equal <- function(...) isTRUE(all.equal(..., check.environment = FALSE))
  > 
  > require("mboost")
  Loading required package: mboost
  Loading required package: parallel
  Loading required package: stabs
  > require("Matrix")
  Loading required package: Matrix
  > 
  > set.seed(290875)
  > 
  > ### predict did not return factor levels for blackboost models
  > dummy <- data.frame(y = gl(2, 100), x = runif(200))
  > pr <- predict(blackboost(y ~ x, data = dummy, family = Binomial()),
  +               newdata = dummy, type = "class")
  > print(is.factor(pr) && all(levels(pr) %in% levels(dummy$y)))
  [1] TRUE
  > 
  > ### predict for g{al}mboost.matrix did not work
  > ctrl <- boost_control(mstop = 10)
  > X <- cbind(int = 1, x = dummy$x)
  > gb <- glmboost(x = X, y = dummy$y, family = Binomial(), center = FALSE,
  +                control = ctrl)
  > print(.all.equal(predict(gb), predict(gb, newdata = X)))
  [1] TRUE
  > 
  > if (FALSE) {
  + gb <- gamboost(x = X, y = dummy$y, family = Binomial(),
  +                control = ctrl)
  + print(.all.equal(predict(gb), predict(gb, newdata = X)))
  + }
  > 
  > ### predict with center = TRUE in glmboost.matrix() did not work
  > gb <- glmboost(x = X, y = dummy$y, family = Binomial(),
  +                control = ctrl, center=TRUE)
  > p1 <- X %*% coef(gb)
  
  NOTE: Coefficients from a Binomial model are half the size of coefficients
   from a model fitted via glm(... , family = 'binomial').
  See Warning section in ?coef.mboost
  
  > print(max(abs(p1 - predict(gb, newdata = X))) < sqrt(.Machine$double.eps))
  [1] TRUE
  > 
  > ### blackboost _did_ touch the response, arg!
  > 
  > data("bodyfat", package = "TH.data")
  > ctrl <- boost_control(mstop = 500, nu = 0.01)
  > bb <- blackboost(DEXfat ~ ., data = bodyfat, control = ctrl)
  > n <- nrow(bodyfat)
  > bs <- rmultinom(3, n, rep(1, n) / n)
  > x <- seq(from = 10, to = 500, by = 10)
  > cv <- cvrisk(bb, bs, grid = x, papply = lapply)
  > ctrl$risk <- "oobag"
  > tmp <- blackboost(DEXfat ~ ., data = bodyfat, control = ctrl,
  +                  weights = bs[,3])
  > 
  > print(identical(max(abs(tmp$risk()[x + 1] / sum(bs[,3] == 0)  - cv[3,])), 0))
  [1] TRUE
  > 
  > ### center = TRUE and cvrisk were broken; same issue with masking original data
  > 
  > gb <- glmboost(DEXfat ~ ., data = bodyfat, center = TRUE)
  > cv1 <- cvrisk(gb, folds = bs, papply = lapply)
  > tmp <- glmboost(DEXfat ~ ., data = bodyfat, center = TRUE,
  +                 control = boost_control(risk = "oobag"),
  +                 weights = bs[,3])
  > print(identical(max(tmp$risk()[attr(cv1, "mstop") + 1] / sum(bs[,3] == 0) - cv1[3,]), 0))
  [1] TRUE
  > 
  > ### same problem, just another check
  > 
  > indep <- names(bodyfat)[names(bodyfat) != "DEXfat"]
  > cbodyfat <- bodyfat
  > cbodyfat[indep] <- lapply(cbodyfat[indep], function(x) x - mean(x))
  > bffm <- DEXfat ~ age + waistcirc + hipcirc + elbowbreadth + kneebreadth +
  +       anthro3a + anthro3b + anthro3c + anthro4
  > 
  > bf_glm_1 <- glmboost(bffm, data = cbodyfat, center = FALSE)
  > cv1 <- cvrisk(bf_glm_1, folds = bs, papply = lapply)
  > bf_glm_2 <- glmboost(bffm, data = bodyfat, center = TRUE)
  > cv2 <- cvrisk(bf_glm_2, folds = bs, papply = lapply)
  > 
  > print(mstop(cv1) == mstop(cv2))
  [1] TRUE
  > 
  > if (FALSE){
  + ### dfbase=1 was not working correctly for ssp
  + ### spotted by Matthias Schmid <Matthias.Schmid@imbe.imed.uni-erlangen.de>
  + data("bodyfat", package = "TH.data")
  + ctrl <- boost_control(mstop = 100)
  + ### COMMENT: Not using ssp here but P-splines
  + ### Remove check!
  + ga <- gamboost(DEXfat ~ ., data = bodyfat, dfbase = 1, control = ctrl)
  + gl <- glmboost(DEXfat ~ ., data = bodyfat, center = TRUE, control = ctrl)
  + print(max(abs(predict(ga) - predict(gl))) < 1e-8)
  + AIC(gl)
  + }
  > 
  > if (FALSE) {
  + ### prediction with matrices was broken for gamboost,
  + ### spotted by <Max.Kuhn@pfizer.com>
  + x <- matrix(rnorm(1000), ncol = 10)
  + colnames(x) <- 1:ncol(x)
  + y <- rnorm(100)
  + fit <- gamboost(x = x, y = y, control = boost_control(mstop = 10))
  + a <- predict(fit, newdata = x[1:10,])
  + }
  > 
  > ### AIC for centered covariates didn't work
  > y <- gl(2, 10)
  > xn <- rnorm(20)
  > xnm <- xn - mean(xn)
  > gc <- glmboost(y ~ xn, center = TRUE,
  +                family = Binomial())
  > g <- glmboost(y ~ xnm, center = FALSE, family = Binomial())
  > cgc <- coef(gc, off2int = TRUE)
  
  NOTE: Coefficients from a Binomial model are half the size of coefficients
   from a model fitted via glm(... , family = 'binomial').
  See Warning section in ?coef.mboost
  
  > cg <- coef(g, off2int = TRUE) - c(mean(xn) * coef(g)[2], 0)
  
  NOTE: Coefficients from a Binomial model are half the size of coefficients
   from a model fitted via glm(... , family = 'binomial').
  See Warning section in ?coef.mboost
  
  
  NOTE: Coefficients from a Binomial model are half the size of coefficients
   from a model fitted via glm(... , family = 'binomial').
  See Warning section in ?coef.mboost
  
  > names(cgc) <- NULL
  > names(cg) <- NULL
  > print(.all.equal(cgc, cg))
  [1] TRUE
  > print(.all.equal(mstop(AIC(gc, "classical")),
  +                     mstop(AIC(g, "classical"))))
  [1] TRUE
  > 
  > ### fit ANCOVA models with centering
  > n <- 50
  > set.seed(290875)
  > x <- gl(3, n)
  > x1 <- sample(ordered(gl(3, n)))
  > z <- rnorm(length(x))
  > X <- model.matrix(~ x + z + x1)
  > eff <- X %*% (1:ncol(X))
  > y <- rnorm(length(x), mean = eff)
  > 
  > ctr <- list(list(x = "contr.treatment"), list(x = "contr.sum"),
  +             list(x = "contr.helmert"), list(x = "contr.SAS"))
  > mstop <- 2000
  > fm <- y ~ z:x + x + z:x1
  > 
  > for (cc in ctr) {
  +     modlm <- lm(fm, contrasts = cc)
  +     modT <- glmboost(fm, contrasts.arg = cc,
  +                      center = TRUE)[mstop]
  +     print(max(abs(coef(modlm) - coef(modT, off2int = TRUE)))
  +                       < .Machine$double.eps^(1/3))
  +     print(max(abs(hatvalues(modlm) - hatvalues(modT))) < 0.01)
  +     print(max(abs(predict(modlm) - predict(modT)))
  +                       < .Machine$double.eps^(1/3))
  + }
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  > 
  > y <- factor(rbinom(length(x), size = 1,
  +                     prob = plogis(eff / max(abs(eff)) * 3)))
  > for (cc in ctr) {
  +     modlm <- glm(fm, contrasts = cc,
  +                  family = binomial())
  +     modT <- glmboost(fm, contrasts.arg = cc,
  +         center = TRUE, family = Binomial())[mstop]
  +     print(max(abs(coef(modlm) - coef(modT, off2int = TRUE) * 2))
  +                       < .Machine$double.eps^(1/3))
  +     print(max(abs(predict(modlm) - predict(modT) * 2))
  +                       < .Machine$double.eps^(1/3))
  + }
  
  NOTE: Coefficients from a Binomial model are half the size of coefficients
   from a model fitted via glm(... , family = 'binomial').
  See Warning section in ?coef.mboost
  
  [1] TRUE
  [1] TRUE
  
  NOTE: Coefficients from a Binomial model are half the size of coefficients
   from a model fitted via glm(... , family = 'binomial').
  See Warning section in ?coef.mboost
  
  [1] TRUE
  [1] TRUE
  
  NOTE: Coefficients from a Binomial model are half the size of coefficients
   from a model fitted via glm(... , family = 'binomial').
  See Warning section in ?coef.mboost
  
  [1] TRUE
  [1] TRUE
  
  NOTE: Coefficients from a Binomial model are half the size of coefficients
   from a model fitted via glm(... , family = 'binomial').
  See Warning section in ?coef.mboost
  
  [1] TRUE
  [1] TRUE
  > 
  > 
  > ### check gamboost with weights (use weighted some of residuals
  > ### for variable selection)
  > data("bodyfat", package = "TH.data")
  > 
  > set.seed(290875)
  > n <- nrow(bodyfat)
  > w <- numeric(n)
  > w <- rmultinom(1, n, rep(1, n) / n)[,1]
  > ctrl <- boost_control(mstop = 20)
  > 
  > mod1 <- glmboost(DEXfat ~ ., data = bodyfat, weights = w, center = FALSE)
  > aic1 <- AIC(mod1, "corrected")
  > attributes(aic1) <- NULL
  > 
  > mod2 <- glmboost(DEXfat ~ ., data = bodyfat[rep(1:n, w),], center = FALSE)
  > aic2 <- AIC(mod2, "corrected")
  > attributes(aic2) <- NULL
  > 
  > print(.all.equal(round(aic1, 3), round(aic2, 3)))
  [1] TRUE
  > 
  > mod1 <- gamboost(DEXfat ~ ., data = bodyfat, weights = w, con = ctrl)
  > aic1 <- AIC(mod1, "corrected")
  > attributes(aic1) <- NULL
  > 
  > mod2 <- gamboost(DEXfat ~ ., data = bodyfat[rep(1:n, w),], con = ctrl)
  > aic2 <- AIC(mod2, "corrected")
  > attributes(aic2) <- NULL
  > 
  > print(.all.equal(round(aic1, 1), round(aic2, 1)))
  [1] TRUE
  > 
  > mod1 <- blackboost(DEXfat ~ ., data = bodyfat, weights = w)
  > mod2 <- blackboost(DEXfat ~ ., data = bodyfat[rep(1:n, w),])
  > 
  > ratio <- mod1$risk() / mod2$risk()
  > print(ratio[1] > 0.95 && ratio[2] < 1.05)
  [1] TRUE
  > 
  > if (FALSE){
  + ### df <= 2
  + ctrl$risk <- "oobag"
  + mod1 <- gamboost(DEXfat ~ ., data = bodyfat, weights = w, con = ctrl, base = "bss", dfbase = 2)
  + mod2 <- gamboost(DEXfat ~ ., data = bodyfat, weights = w, con = ctrl, base = "bbs", dfbase = 2)
  + mod3 <- gamboost(DEXfat ~ ., data = bodyfat, weights = w, con = ctrl, base = "bols")
  + print(max(abs(predict(mod1) - predict(mod2))) < sqrt(.Machine$double.eps))
  + print(max(abs(predict(mod1) - predict(mod3))) < sqrt(.Machine$double.eps))
  + }
  > 
  > ### check predictions of zero-weight observations (via out-of-bag risk)
  > mod1 <- gamboost(DEXfat ~ ., data = bodyfat, weights = w, con = ctrl, base = "bss")
  Warning message:
  In gamboost(DEXfat ~ ., data = bodyfat, weights = w, con = ctrl,  :
    bss and bns are deprecated, bbs is used instead
  > mod2 <- gamboost(DEXfat ~ ., data = bodyfat, weights = w, con = ctrl, base = "bbs")
  > print(abs(coef(lm(mod1$risk() ~ mod2$risk() - 1)) - 1) < 0.01)
  mod2$risk() 
         TRUE 
  > 
  > ### not really a bug, a new feature; test fastp
  > df <- data.frame(y = rnorm(100), x = runif(100), z = runif(100))
  > eps <- sqrt(.Machine$double.eps)
  > s <- seq(from = 1, to = 100, by = 3)
  > 
  > x <- glmboost(y ~ ., data = df, center = FALSE)
  > for (i in s)
  +     print(max(abs(predict(x[i]) - predict(x[max(s)], agg = "cumsum")[,i])) < eps)
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  > 
  > x <- gamboost(y ~ ., data = df)
  > for (i in s)
  +     print(max(abs(predict(x[i]) - predict(x[max(s)], agg = "cumsum")[,i])) < eps)
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  > 
  > x <- blackboost(y ~ ., data = df)
  > for (i in s)
  +     print(max(abs(predict(x[i]) - predict(x[max(s)], agg = "cumsum")[,i])) < eps)
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  [1] TRUE
  > 
  > ### make sure environment(formula) is used for evaluation
  > if (require("partykit")) {
  +     data("cars")
  +     ctl  <- boost_control(mstop = 100, trace = TRUE)
  +     tctl <- ctree_control(teststat = "max", testtype = "Teststat",
  +                           mincrit = 0, maxdepth = 5, saveinfo = FALSE)
  +     myfun <- function(cars, xx, zz){
  +         mboost(dist ~ btree(speed, tree_controls = zz),
  +                data = cars, control = xx)
  +     }
  +     try(mod <- myfun(cars, xx = ctl, zz = tctl))
  + }
  Loading required package: partykit
  Loading required package: grid
  Loading required package: libcoin
  Loading required package: mvtnorm
  
  Attaching package: 'partykit'
  
  The following object is masked from 'package:mboost':
  
      varimp
  
  [   1] ...................................... -- risk: 9247 
  [  41] ...................................... -- risk: 9006 
  [  81] ..................
  Final risk: 8977 
  > 
  > ### bbs with weights and expanded data
  > x <- runif(100)
  > y <- rnorm(length(x))
  > knots <- seq(from = 0.1, to = 0.9, by = 0.1)
  > w <- rmultinom(1, length(x), rep(1, length(x)) / length(x))[,1]
  > iw <- rep(1:length(x), w)
  > 
  > m1 <- bbs(x, knots = knots)$dpp(w)$fit(y)$model
  > m2 <- bbs(x[iw], knots = knots)$dpp(rep(1, length(iw)))$fit(y[iw])$model
  > 
  > print(max(abs(m1 - m2)) < sqrt(.Machine$double.eps))
  [1] TRUE
  > 
  > ### base learner handling
  > print(max(abs(fitted(gamboost(DEXfat ~ age, data = bodyfat)) -
  +                   fitted(gamboost(DEXfat ~ bbs(age), data = bodyfat)))) <
  +           sqrt(.Machine$double.eps))
  [1] TRUE
  > 
  > ### predict for matrix interface to glmboost
  > x <- matrix(runif(1000), ncol = 10)
  > y <- rowMeans(x) + rnorm(nrow(x))
  > mod <- glmboost(x = x, y = y, center = FALSE)
  > print(length(predict(mod, newdata = x[1:2,])) == 2)
  [1] TRUE
  > try(predict(mod, newdata = as.data.frame(x[1:2,])))
  Error in object$newX(newdata) : 
    'newdata' is not a matrix with the same variables as 'x'
  > 
  > 
  > ### predict for varying coefficient models with categorical z
  > set.seed(1907)
  > x <- rnorm(100)
  > z <- gl(2,50)
  > y <- rnorm(100, sd = 0.1)
  > data <- data.frame(y=y, x=x, z=z)
  > 
  > model <- gamboost(y ~ bols(x, by=z), data = data)
  > print(!is.na(predict(model,data[1,-1])))
       [,1]
  [1,] TRUE
  > 
  > model <- gamboost(y ~ bbs(x, by=z), data = data)
  > print(!is.na(predict(model,data[1,-1])))
       [,1]
  [1,] TRUE
  > 
  > x <- as.factor(sample(1:10, 100, replace=TRUE))
  > data <- data.frame(y=y, x=x, z=z)
  > model <- gamboost(y ~ brandom(x, by=z), data = data)
  > print(!is.na(predict(model,data[1,-1])))
       [,1]
  [1,] TRUE
  > 
  > x1 <- rnorm(100)
  > x2 <- rnorm(100)
  > data <- data.frame(y=y, x1=x1, x2=x2, z=z)
  > model <- gamboost(y ~ bspatial(x1,x2, by=z), data = data)
  > print(!is.na(predict(model,data[1,-1])))
       [,1]
  [1,] TRUE
  > 
  > ### bols with intercept = FALSE for categorical covariates was broken
  > x <- gl(2, 50)
  > y <- c(rnorm(50, mean = -1), rnorm(50, mean = 1))
  > print(length(coef(gamboost(y ~ bols(x, intercept=FALSE)))) == 1)
  [1] TRUE
  > 
  > # check also for conntinuous x
  > x <- rnorm(100)
  > y <- c(rnorm(100, mean = 1 * x))
  > print(length(coef(gamboost(y ~ bols(x, intercept=FALSE)))) == 1)
  [1] TRUE
  > 
  > ### check interface of coef
  > set.seed(1907)
  > x1 <- rnorm(100)
  > int <- rep(1, 100)
  > y <- 3 * x1 + rnorm(100, sd=0.1)
  > dummy <- data.frame(y = y, int = int, x1 = x1)
  > 
  > gbm <- gamboost(y ~ bols(int, intercept=FALSE) +  bols(x1, intercept=FALSE) +
  +                 bbs(x1, center=TRUE, df=1), data = dummy)
  > 
  > ### check prediction if intercept=FALSE
  > gbm <- gamboost(y ~ bols(x1, intercept=FALSE), data = dummy)
  > print(!is.na(predict(gbm)) &
  +           max(abs(predict(gbm) - fitted(gbm))) < sqrt(.Machine$double.eps))
         [,1]
    [1,] TRUE
    [2,] TRUE
    [3,] TRUE
    [4,] TRUE
    [5,] TRUE
    [6,] TRUE
    [7,] TRUE
    [8,] TRUE
    [9,] TRUE
   [10,] TRUE
   [11,] TRUE
   [12,] TRUE
   [13,] TRUE
   [14,] TRUE
   [15,] TRUE
   [16,] TRUE
   [17,] TRUE
   [18,] TRUE
   [19,] TRUE
   [20,] TRUE
   [21,] TRUE
   [22,] TRUE
   [23,] TRUE
   [24,] TRUE
   [25,] TRUE
   [26,] TRUE
   [27,] TRUE
   [28,] TRUE
   [29,] TRUE
   [30,] TRUE
   [31,] TRUE
   [32,] TRUE
   [33,] TRUE
   [34,] TRUE
   [35,] TRUE
   [36,] TRUE
   [37,] TRUE
   [38,] TRUE
   [39,] TRUE
   [40,] TRUE
   [41,] TRUE
   [42,] TRUE
   [43,] TRUE
   [44,] TRUE
   [45,] TRUE
   [46,] TRUE
   [47,] TRUE
   [48,] TRUE
   [49,] TRUE
   [50,] TRUE
   [51,] TRUE
   [52,] TRUE
   [53,] TRUE
   [54,] TRUE
   [55,] TRUE
   [56,] TRUE
   [57,] TRUE
   [58,] TRUE
   [59,] TRUE
   [60,] TRUE
   [61,] TRUE
   [62,] TRUE
   [63,] TRUE
   [64,] TRUE
   [65,] TRUE
   [66,] TRUE
   [67,] TRUE
   [68,] TRUE
   [69,] TRUE
   [70,] TRUE
   [71,] TRUE
   [72,] TRUE
   [73,] TRUE
   [74,] TRUE
   [75,] TRUE
   [76,] TRUE
   [77,] TRUE
   [78,] TRUE
   [79,] TRUE
   [80,] TRUE
   [81,] TRUE
   [82,] TRUE
   [83,] TRUE
   [84,] TRUE
   [85,] TRUE
   [86,] TRUE
   [87,] TRUE
   [88,] TRUE
   [89,] TRUE
   [90,] TRUE
   [91,] TRUE
   [92,] TRUE
   [93,] TRUE
   [94,] TRUE
   [95,] TRUE
   [96,] TRUE
   [97,] TRUE
   [98,] TRUE
   [99,] TRUE
  [100,] TRUE
  > 
  > ### check coef.glmboost
  > set.seed(1907)
  > x1 <- rnorm(100)
  > x2 <- rnorm(100)
  > y <- rnorm(100, mean= 3 * x1,sd=0.01)
  > linMod <- glmboost(y ~ x1 + x2, center = FALSE)
  > print(length(coef(linMod)) == 2)
  [1] TRUE
  > 
  > ### automated offset computation in Family
  > x <- rnorm(100)
  > y <- rnorm(100)
  > w <- drop(rmultinom(1, 100, rep(1 / 100, 100)))
  > 
  > G <- Gaussian()
  > fm <- Family(ngradient = G@ngradient, risk = G@risk)
  > 
  > m1 <- glmboost(y ~ x, family = G, center = FALSE)
  > m2 <- glmboost(y ~ x, family = fm, center = FALSE)
  > print(.all.equal(coef(m1), coef(m2)))
  [1] TRUE
  > 
  > ### formula evaluation
  > f <- function() {
  + 
  +     x <- rnorm(100)
  +     y <- rnorm(100)
  +     list(mboost(y ~ bbs(x)),
  +          gamboost(y ~ x),
  +          glmboost(y ~ x, center = FALSE),
  +          blackboost(y ~ x))
  + }
  > tmp <- f()
  > 
  > ### both loss and risk given, spotted by
  > ### Fabian Scheipl <fabian.scheipl@stat.uni-muenchen.de>
  > print(extends(class(Family(ngradient = function(y, f) y,
  +                                loss = function(y, w) sum(y),
  +                                risk = function(y, f, w) sum(y))),
  +                   "boost_family"))
  [1] TRUE
  > 
  > ### check coef with aggregate = "cumsum"
  > mod <- glmboost(DEXfat ~ ., data = bodyfat, center = FALSE)
  > 
  > print(max(abs(sapply(coef(mod, aggregate="cumsum"), function(x) x[,100])
  +                   - coef(mod))) < sqrt(.Machine$double.eps))
  [1] TRUE
  > 
  > ### get_index() was broken for factors
  > ### (spotted by Juliane Schaefer <JSchaefer _at_ uhbs.ch>)
  > y <- factor(c(2, 1, 1, 2, 2, 2, 1, 1, 2, 2), levels = 1:2, labels = c("N", "S"))
  > x <- factor(c(2, 1, 2, 2, 2, 1, 1, 1, 2, 2), levels = 1:2,
  +             labels = c("No", "Yes"))
  > data <- data.frame(y,x)
  > m1 <- glm(y ~ x, data = data, family = binomial())
  > m2 <- glmboost(y ~ x, data = data, family = Binomial(),
  +                control = boost_control(mstop = 2000), center = FALSE)
  > m3 <- gamboost(y ~ bols(x), data = data, family = Binomial(),
  +                control = boost_control(mstop = 1000))
  > cf1 <- coef(m1)
  > a <- coef(m2); a[1] <- a[1] + m2$offset;
  
  NOTE: Coefficients from a Binomial model are half the size of coefficients
   from a model fitted via glm(... , family = 'binomial').
  See Warning section in ?coef.mboost
  
  > cf2 <- as.vector(a) * 2
  > b <- coef(m3); b[[1]][1] <- b[[1]][1] + m3$offset;
  > cf3 <- b[[1]] * 2
  > 
  > print(max(abs(cf1 - cf2)) < sqrt(.Machine$double.eps))
  [1] TRUE
  > print(max(abs(cf1 - cf3)) < sqrt(.Machine$double.eps))
  [1] TRUE
  > print(max(abs(predict(m2) - predict(m3))) < sqrt(.Machine$double.eps))
  [1] TRUE
  > 
  > ### bug in setting contrasts correctly
  > z <- as.ordered(gl(3, 10))
  > BL <- bols(z, contrasts.arg = "contr.treatment")$dpp
  > print(attr(get("X", envir = environment(BL)), "contrasts")$z == "contr.treatment")
  [1] TRUE
  > 
  > ### check dimensions
  > try(glmboost(x = matrix(1:10, nrow = 5), y = rnorm(4)))
  Error in glmboost.matrix(x = matrix(1:10, nrow = 5), y = rnorm(4)) : 
    dimensions of 'x' and 'y' do not match
  > 
  > ### (slight) abuse of bolscw
  > X <- runif(1000)
  > X <- matrix(X, nrow = 100)
  > y <- rnorm(100)
  > glmboost(x = X, y = y)
  
  	 Generalized Linear Models Fitted via Gradient Boosting
  
  Call:
  glmboost.matrix(x = X, y = y)
  
  
  	 Squared Error (Regression) 
  
  Loss function: (y - f)^2 
   
  
  Number of boosting iterations: mstop = 100 
  Step size:  0.1 
  Offset:  -0.0242 
  
  Coefficients: 
       V1      V2      V3      V4      V5      V6      V7      V8      V9 
  -0.2433 -0.0787  0.3093 -0.1547 -0.4141 -0.0611 -0.2597 -0.7462  0.6370 
  attr(,"offset")
  [1] -0.0242
  
  Warning message:
  In glmboost.matrix(x = X, y = y) :
    model with centered covariates does not contain intercept
  > b <- list(mboost:::bolscw(X))
  > mboost_fit(blg = b, response = y)
  
  	 Model-based Boosting
  
  
  	 Squared Error (Regression) 
  
  Loss function: (y - f)^2 
   
  
  Number of boosting iterations: mstop = 100 
  Step size:  0.1 
  Offset:  -0.0242 
  Number of baselearners:  1 
  
  > z <- rnorm(100)
  > b <- list(b1 = mboost:::bolscw(X), b2 = bbs(z))
  > mboost_fit(blg = b, response = y)
  
  	 Model-based Boosting
  
  
  	 Squared Error (Regression) 
  
  Loss function: (y - f)^2 
   
  
  Number of boosting iterations: mstop = 100 
  Step size:  0.1 
  Offset:  -0.0242 
  Number of baselearners:  2 
  
  > mod <- mboost_fit(blg = b, response = y)
  > cf <- coef(mod, which = 1)[[1]]
  > print(length(cf) == ncol(X))
  [1] TRUE
  > 
  > 
  > ### check interface of buser
  > ### (K was fetched from global environment)
  > set.seed(1907)
  > x <- rnorm(100)
  > y <- rnorm(100, mean = x^2, sd = 0.1)
  > mod1 <- gamboost(y ~ bbs(x))
  > X1 <- extract(bbs(x))
  > K1 <- extract(bbs(x), "penalty")
  > mod2 <- gamboost(y ~ buser(X1, K1))
  > print(max(abs(predict(mod1) - predict(mod2))) < sqrt(.Machine$double.eps))
  [1] TRUE
  > 
  > 
  > ### check if mysolve works correctly
  > set.seed(1907)
  > X <- matrix(runif(1000), ncol = 10)
  > XM <- Matrix(X)
  > y <- rnorm(nrow(X))
  > # use interface for dense matrices from package Matrix
  > f1 <- fitted(gamboost(y ~ bols(XM)))
  > # use interface for matrices of class "matrix"
  > f2 <- fitted(gamboost(y ~ bols(X)))
  > print(max(abs(f1 - f2)) < sqrt(.Machine$double.eps))
  [1] TRUE
  > ## Now same with sparse matrix
  > X[X < .9] <- 0
  > XM <- Matrix(X)
  > # use interface for sparse matrices from package Matrix
  > f1 <- fitted(gamboost(y ~ bols(XM)))
  > # use interface for matrices of class "matrix"
  > f2 <- fitted(gamboost(y ~ bols(X)))
  > print(max(abs(f1 - f2)) < sqrt(.Machine$double.eps))
  [1] TRUE
  > 
  > ### check if bmrf works correctly
  > ## (if not all locations are observed)
  > if (require("BayesX")) {
  +     germany <- read.bnd(system.file("examples/germany.bnd", package="BayesX"))
  +     districts <- attr(germany, "regions")
  +     set.seed(1907)
  +     regions <- factor(sample(districts, 400, replace = TRUE))
  +     B <- bmrf(regions, bnd = germany)
  +     X <- extract(B)
  +     K <- extract(B, what = "pen")
  +     Xs <- colSums(as.matrix(X))
  +     names(Xs) <- rownames(K)
  +     print(all(Xs[Xs > 0] == table(regions)[names(Xs[Xs > 0])]))
  + 
  +     ## check against old, slower code:
  +     Xold <- matrix(0, nrow = length(regions), ncol = ncol(K))
  +     for (i in 1:length(regions))
  +         Xold[i, which(districts == regions[i])] <- 1
  +     print(all(X == Xold))
  + }
  Loading required package: BayesX
  Loading required package: shapefiles
  Loading required package: foreign
  
  Attaching package: 'shapefiles'
  
  The following objects are masked from 'package:foreign':
  
      read.dbf, write.dbf
  
  Read 8852 records
  Note: map consists of 310 polygons
  Note: map consists of 309 regions
  Reading map ... finished
  Start neighbor search ...
  progress: 50%
  progress: 100%
  Neighbor search finished.
  [1] TRUE
  [1] TRUE
  > 
  > ## check handling of missing values
  > y <- yNa <- rnorm(100)
  > x1 <- rnorm(100)
  > x2 <- rnorm(100)
  > z1 <- as.factor(sample(1:10, 100, replace = TRUE))
  > 
  > yNa[1] <- NA
  > coef(mboost(yNa ~ x1))
  $`bbs(x1)`
        1       2       3       4       5       6       7       8       9      10 
  -0.3320 -0.2530 -0.1682 -0.0573  0.0583  0.1448  0.1618  0.0766 -0.0863 -0.2359 
       11      12      13      14      15      16      17      18      19      20 
  -0.3031 -0.2786 -0.1788 -0.0553  0.0593  0.1709  0.2980  0.3981  0.4216  0.3843 
       21      22      23      24 
   0.3296  0.2811  0.2355  0.1901 
  
  attr(,"offset")
  [1] 0.086
  Warning message:
  In mboost_fit(bl, response = response, weights = weights, offset = offset,  :*** buffer overflow detected ***: terminated
  Aborted
Running the tests in ‘tests/regtest-baselearner.R’ failed.
Complete output:
  > 
  > options(digits = 3)
  > 
  > tol2 <- .Machine$double.eps^(1/3)
  > 
  > .all.equal <- function(...) isTRUE(all.equal(..., check.environment = FALSE))
  > 
  > library("mboost")
  Loading required package: parallel
  Loading required package: stabs
  > attach(asNamespace("mboost"), warn.conflicts = FALSE)
  > library("MASS")
  > library("Matrix")
  > 
  > set.seed(290875)
  > 
  > ### dgp
  > n <- 20000
  > xn <- round(runif(n), 3)
  > xn[sample(1:n)[1:(n / 100)]] <- NA
  > xf <- gl(4, n / 4)
  > xf[sample(1:n)[1:(n / 100)]] <- NA
  > z1 <- sample(gl(2, n / 2))
  > z1[sample(1:n)[1:(n / 100)]] <- NA
  > z2 <- round(runif(n), 3)
  > z2[sample(1:n)[1:(n / 100)]] <- NA
  > w <- rpois(n, lambda = 2)
  > y <- 2 * xn + rnorm(n)
  > y[is.na(y)] <- rnorm(sum(is.na(y)))
  > 
  > testfun <- function(m1, m2) {
  +     ret <- c(max(abs(coef(m1) - coef(m2))),
  +       max(abs(fitted(m1) - fitted(m2)()), na.rm = TRUE))
  +     if (any(ret > sqrt(.Machine$double.eps)))
  +         return(ret)
  + }
  > 
  > ### numeric x with intercept
  > m1 <- lm(y ~ xn, weights = w, na.action = na.exclude)
  > m2 <- fit(dpp(bols(xn), w), y)
  Warning message:
  In bols(xn) :*** buffer overflow detected ***: terminated
  Aborted