
> options(prompt = "R> ", continue = "+  ", width = 80)

> pd <- packageDescription("mboost")

> if (any(is.na(pd))) {
+     install.packages("mboost", repos = "https://CRAN.R-project.org")
+     pd <- packageDescription("mboost")
+ }

> if (compareVersion(pd$Version, "2.1-0") < 0) {
+     warning("Current version of mboost is installed!")
+     install.packages("mboost", repos = "ht ..." ... [TRUNCATED] 

> options(digits = 3)

> require("mboost")
Loading required package: mboost
Loading required package: parallel
Loading required package: stabs

> set.seed(190781)

> if (!file.exists("graphics")) dir.create("graphics")

> library("mboost")

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

> lm1 <- lm(DEXfat ~ hipcirc + kneebreadth + anthro3a, 
+     data = bodyfat)

> coef(lm1)
(Intercept)     hipcirc kneebreadth    anthro3a 
    -75.235       0.512       1.902       8.910 

> glm1 <- glmboost(DEXfat ~ hipcirc + kneebreadth + 
+     anthro3a, data = bodyfat)

> coef(glm1, off2int = TRUE)
(Intercept)     hipcirc kneebreadth    anthro3a 
    -75.207       0.511       1.901       8.907 

> glm2 <- glmboost(DEXfat ~ ., data = bodyfat)

> preds <- names(bodyfat[, names(bodyfat) != "DEXfat"])

> fm <- as.formula(paste("DEXfat ~", paste(preds, collapse = "+")))

> fm
DEXfat ~ age + waistcirc + hipcirc + elbowbreadth + kneebreadth + 
    anthro3a + anthro3b + anthro3c + anthro4

> coef(glm2, which = "")
 (Intercept)          age    waistcirc      hipcirc elbowbreadth  kneebreadth 
    -98.8166       0.0136       0.1897       0.3516      -0.3841       1.7366 
    anthro3a     anthro3b     anthro3c      anthro4 
      3.3269       3.6565       0.5954       0.0000 
attr(,"offset")
[1] 30.8

> plot(glm2, off2int = TRUE)

> plot(glm2, ylim = range(coef(glm2, which = preds)))

> par(mar = c(4, 4, 0, 6) + 0.1)

> plot(glm2, main = "", off2int = TRUE)

> par(mar = c(4, 4, 0, 6) + 0.1)

> plot(glm2, ylim = range(coef(glm2, which = preds)), 
+     main = "")

> gam1 <- gamboost(DEXfat ~ bbs(hipcirc) + bbs(kneebreadth) + 
+     bbs(anthro3a), data = bodyfat)

> par(mfrow = c(1, 3))

> plot(gam1)

> par(mfrow = c(1, 3))

> par(mar = c(4, 4, 0, 0) + 0.1)

> plot(gam1)

> gam2 <- gamboost(DEXfat ~ ., baselearner = "bbs", 
+     data = bodyfat, control = boost_control(trace = TRUE))
[   1] ...................................... -- risk: 544 
[  41] ...................................... -- risk: 479 
[  81] ..................
Final risk: 460 

> gam2 <- gamboost(DEXfat ~ ., baselearner = "bbs", 
+     data = bodyfat)

> set.seed(123)

> cvm <- cvrisk(gam2)

> cvm

	 Cross-validated Squared Error (Regression) 
	 gamboost(formula = DEXfat ~ ., data = bodyfat, baselearner = "bbs") 

    0     1     2     3     4     5     6     7     8     9    10    11    12 
128.8 109.4  93.9  80.6  69.6  60.1  52.6  46.1  40.8  36.3  32.7  29.7  27.1 
   13    14    15    16    17    18    19    20    21    22    23    24    25 
 25.0  23.1  21.6  20.4  19.2  18.3  17.6  17.0  16.5  16.1  15.8  15.5  15.2 
   26    27    28    29    30    31    32    33    34    35    36    37    38 
 15.1  15.0  14.9  14.8  14.7  14.7  14.7  14.6  14.7  14.7  14.7  14.8  14.8 
   39    40    41    42    43    44    45    46    47    48    49    50    51 
 14.8  14.9  14.9  14.9  15.0  15.0  15.1  15.1  15.2  15.2  15.2  15.3  15.3 
   52    53    54    55    56    57    58    59    60    61    62    63    64 
 15.4  15.4  15.5  15.5  15.5  15.6  15.6  15.7  15.7  15.7  15.8  15.8  15.8 
   65    66    67    68    69    70    71    72    73    74    75    76    77 
 15.9  15.9  15.9  16.0  16.0  16.0  16.1  16.1  16.1  16.2  16.2  16.2  16.3 
   78    79    80    81    82    83    84    85    86    87    88    89    90 
 16.3  16.3  16.3  16.4  16.4  16.4  16.4  16.4  16.5  16.5  16.5  16.5  16.6 
   91    92    93    94    95    96    97    98    99   100 
 16.6  16.6  16.6  16.6  16.6  16.7  16.7  16.7  16.7  16.8 

	 Optimal number of boosting iterations: 33 

> plot(cvm)

> par(mar = c(4, 4, 0, 0) + 0.1)

> plot(cvm, main = "")

> mstop(cvm)
[1] 33

> gam2[mstop(cvm)]

	 Model-based Boosting

Call:
gamboost(formula = DEXfat ~ ., data = bodyfat, baselearner = "bbs")


	 Squared Error (Regression) 

Loss function: (y - f)^2 
 

Number of boosting iterations: mstop = 33 
Step size:  0.1 
Offset:  30.8 
Number of baselearners:  9 


> m_cvm <- mstop(cvm)

> gam2 <- gamboost(DEXfat ~ ., baselearner = "bbs", 
+     data = bodyfat, control = boost_control(trace = TRUE))
[   1] ...................................... -- risk: 544 
[  41] ...................................... -- risk: 479 
[  81] ..................
Final risk: 460 

> gam2[mstop(cvm)]

	 Model-based Boosting

Call:
gamboost(formula = DEXfat ~ ., data = bodyfat, control = boost_control(trace = TRUE),     baselearner = "bbs")


	 Squared Error (Regression) 

Loss function: (y - f)^2 
 

Number of boosting iterations: mstop = 33 
Step size:  0.1 
Offset:  30.8 
Number of baselearners:  9 


> n_coef <- length(coef(gam2))

> coef_string <- paste(c("zero", "one", "two", "three", 
+     "four", "five", "six", "seven", "eight", "nine")[n_coef + 
+     1], if (n_coef == 1) " ..." ... [TRUNCATED] 

> names(coef(gam2))
[1] "bbs(waistcirc, df = dfbase)"   "bbs(hipcirc, df = dfbase)"    
[3] "bbs(kneebreadth, df = dfbase)" "bbs(anthro3a, df = dfbase)"   
[5] "bbs(anthro3b, df = dfbase)"    "bbs(anthro3c, df = dfbase)"   
[7] "bbs(anthro4, df = dfbase)"    

> gam2[1000, return = FALSE]
[ 101] ...................................... -- risk: 431 
[ 141] ...................................... -- risk: 409 
[ 181] ...................................... -- risk: 391 
[ 221] ...................................... -- risk: 376 
[ 261] ...................................... -- risk: 363 
[ 301] ...................................... -- risk: 352 
[ 341] ...................................... -- risk: 343 
[ 381] ...................................... -- risk: 335 
[ 421] ...................................... -- risk: 327 
[ 461] ...................................... -- risk: 320 
[ 501] ...................................... -- risk: 314 
[ 541] ...................................... -- risk: 308 
[ 581] ...................................... -- risk: 303 
[ 621] ...................................... -- risk: 298 
[ 661] ...................................... -- risk: 294 
[ 701] ...................................... -- risk: 289 
[ 741] ...................................... -- risk: 285 
[ 781] ...................................... -- risk: 282 
[ 821] ...................................... -- risk: 278 
[ 861] ...................................... -- risk: 275 
[ 901] ...................................... -- risk: 271 
[ 941] ...................................... -- risk: 268 
[ 981] ..................
Final risk: 267 
NULL

> names(coef(gam2))
[1] "bbs(age, df = dfbase)"          "bbs(waistcirc, df = dfbase)"   
[3] "bbs(hipcirc, df = dfbase)"      "bbs(elbowbreadth, df = dfbase)"
[5] "bbs(kneebreadth, df = dfbase)"  "bbs(anthro3a, df = dfbase)"    
[7] "bbs(anthro3b, df = dfbase)"     "bbs(anthro3c, df = dfbase)"    
[9] "bbs(anthro4, df = dfbase)"     

> glm3 <- glmboost(DEXfat ~ hipcirc + kneebreadth + 
+     anthro3a, data = bodyfat, family = QuantReg(tau = 0.5), control = boost_control(mstop = 500 .... [TRUNCATED] 

> coef(glm3, off2int = TRUE)
(Intercept)     hipcirc kneebreadth    anthro3a 
    -63.516       0.533       0.770       7.835 

> thisdir <- getwd()

> bibfile <- system.file("REFERENCES.bib", package = "mboost")

> if (file.copy(bibfile, to = thisdir, overwrite = TRUE)) {
+     bibfile <- "REFERENCES.bib"
+ } else {
+     bibfile <- file.path("..", "inst", "REF ..." ... [TRUNCATED] 

> library("bibtex")

> mboost <- citation(package = "mboost", auto = TRUE)

> x <- unclass(mboost)

> attr(x[[1]], "key") <- "mboost"

> class(x) <- class(mboost)

> x$doi <- "10.32614/CRAN.package.mboost"

> writeLines(toBibtex(x), con = "packages.bib")

> write.bib(c("lme4", "nlme", "gbm"), file = "packages.bib", 
+     append = TRUE)
Converted 3 of 3 package citations to BibTeX
Writing 4 Bibtex entries ... OK
Results written to file 'packages.bib'

> loss = function(y, f) tau * (y - f) * ((y - f) >= 
+     0) + (tau - 1) * (y - f) * ((y - f) < 0)

> ngradient = function(y, f, w = NULL) tau * ((y - f) >= 
+     0) + (tau - 1) * ((y - f) < 0)

> OurQuantReg <- function(tau = 0.5) {
+     Family(loss = function(y, f) tau * (y - f) * ((y - f) >= 
+         0) + (tau - 1) * (y - f) * ((y - f) < .... [TRUNCATED] 

> OurQuantReg()

	 Our new family for quantile regression 

Loss function: tau * (y - f) * ((y - f) >= 0) + (tau - 1) * (y - f) * ((y -  
     f) < 0) 
 

> glm3b <- glmboost(DEXfat ~ hipcirc + kneebreadth + 
+     anthro3a, data = bodyfat, family = OurQuantReg(tau = 0.5), 
+     control = boost_control( .... [TRUNCATED] 

> identical(coef(glm3b), coef(glm3))
[1] TRUE

> glm4a <- glmboost(DEXfat ~ hipcirc, family = OurQuantReg(tau = 0.05), 
+     data = bodyfat, control = boost_control(mstop = 2000))

> glm4b <- glmboost(DEXfat ~ hipcirc, family = OurQuantReg(tau = 0.5), 
+     data = bodyfat, control = boost_control(mstop = 2000))

> glm4c <- glmboost(DEXfat ~ hipcirc, family = OurQuantReg(tau = 0.95), 
+     data = bodyfat, control = boost_control(mstop = 2000))

> ord <- order(bodyfat$hipcirc)

> plot(bodyfat$hipcirc[ord], bodyfat$DEXfat[ord])

> lines(bodyfat$hipcirc[ord], fitted(glm4a)[ord], lty = 2, 
+     lwd = 2)

> lines(bodyfat$hipcirc[ord], fitted(glm4b)[ord], lty = 1, 
+     lwd = 2)

> lines(bodyfat$hipcirc[ord], fitted(glm4c)[ord], lty = 2, 
+     lwd = 2)

> par(mar = c(4, 4, 0, 0) + 0.1)

> plot(bodyfat$hipcirc[ord], bodyfat$DEXfat[ord])

> lines(bodyfat$hipcirc[ord], fitted(glm4a)[ord], lty = 2, 
+     lwd = 2)

> lines(bodyfat$hipcirc[ord], fitted(glm4b)[ord], lty = 1, 
+     lwd = 2)

> lines(bodyfat$hipcirc[ord], fitted(glm4c)[ord], lty = 2, 
+     lwd = 2)

> red <- rgb(103, 0, 31, max = 255)

> library("mboost")

> library("RColorBrewer")

> cols <- paste(brewer.pal(11, "RdBu")[c(10, 2)], "E6", 
+     sep = "")

> set.seed(1907)

> x <- rnorm(50, mean = 5)

> y <- rnorm(50, mean = x, sd = 0.3)

> y <- y - mean(y)

> par(ps = 8, cex = 1, cex.lab = 1, mar = c(3.1, 3, 
+     0.5, 0.1), mgp = c(2, 1, 0))

> xrange <- range(0, x)

> plot(y ~ x, xlim = xrange, cex = 1, xlab = "x", ylab = "negative gradient in step m = 1", 
+     pch = 20, col = rgb(0.5, 0.5, 0.5, alpha = 0.8))

> abline(h = 0, col = "gray", lwd = 0.5)

> abline(v = 0, col = "gray", lwd = 0.5)

> abline(lm(y ~ x - 1), col = cols[1], lwd = 1.5)

> points(0, 0, col = cols[2], lwd = 1.5)

> points(mean(x), mean(y), col = cols[2], pch = 3, lwd = 1.5)

> legend(0.1, 2.35, legend = c("origin", "center of data", 
+     "base-learner"), pch = c(21, 3, -1), lty = c(-1, -1, 1), 
+     col = c(cols[2], col .... [TRUNCATED] 

> set.seed(1907)

> x <- rnorm(50, mean = 5)

> y <- rnorm(50, mean = x, sd = 0.3)

> y <- y - mean(y)

> mx <- mean(x)

> xrange <- range(0, x)

> x <- x - mean(x)

> par(ps = 8, cex = 1, cex.lab = 1, mar = c(3.1, 3, 
+     0.5, 0.1), mgp = c(2, 1, 0))

> plot(y ~ x, xlim = xrange - mx, cex = 1, xlab = "x (centered)", 
+     ylab = "negative gradient in step m = 1", pch = 20, col = rgb(0.5, 
+         .... [TRUNCATED] 

> abline(h = 0, col = "gray", lwd = 0.5)

> abline(v = 0, col = "gray", lwd = 0.5)

> abline(lm(y ~ x - 1), col = cols[1], lwd = 1.5)

> points(0, 0, col = cols[2], lwd = 1.5)

> points(mean(x), mean(y), col = cols[2], pch = 3, lwd = 1.5)

> set.seed(1907)

> n <- 100

> x1 <- rnorm(n)

> x2 <- as.factor(sample(0:3, n, replace = TRUE))

> y <- 0.5 * x1 + rnorm(n)

> mod <- gamboost(y ~ bols(x1), control = boost_control(mstop = 25))

> par(mar = c(4, 4, 0, 0) + 0.1)

> plot(sort(x1), (0.5 * x1)[order(x1)], type = "l", 
+     lwd = 2, xlab = expression(x[1]), ylab = expression(f(x[1])))

> lines(sort(x1), fitted(mod, which = 1)[order(x1)], 
+     col = red, lwd = 2, type = "b", pch = 20)

> legend("topleft", c("true effect", "model"), lty = c(1, 
+     1), pch = c(-1, 20), merge = TRUE, lwd = 2, col = c("black", 
+     red), bty = "n")

> beta <- c(0, -1, 0.5, 3)

> y <- drop(model.matrix(~x2) %*% beta + rnorm(n, sd = 0.3))

> mod <- gamboost(y ~ bols(x2), control = boost_control(mstop = 50))

> par(mar = c(4, 4, 0, 0) + 0.1)

> betaPred <- coef(mod)[[1]]

> betaPred[1] <- betaPred[1] + attr(coef(mod), "offset")

> betaTrue <- c(0, -1, 0.5, 3)

> plot(1:4, betaPred, type = "n", xaxt = "n", xlab = expression(x[2]), 
+     ylab = expression(f(x[2])), xlim = c(0.5, 4.5), ylim = c(-1.5, 
+        .... [TRUNCATED] 

> axis(1, at = 1:4, labels = expression(x[2]^(1), x[2]^(2), 
+     x[2]^(3), x[2]^(4)))

> for (i in 1:4) lines(i + c(-0.38, 0, 0.38), rep(betaPred[i], 
+     each = 3), lwd = 2, col = red, type = "b", pch = 20)

> for (i in 1:4) lines(i + c(-0.4, 0.4), rep(betaTrue[i], 
+     each = 2), lwd = 2, col = "black")

> legend("topleft", c("true effect", "model"), pch = c(-1, 
+     20), lty = c(1, 1), lwd = 2, col = c("black", red), bty = "n")

> set.seed(1907)

> n <- 100

> x1 <- rnorm(n)

> x2 <- rnorm(n) + 0.25 * x1

> x3 <- as.factor(sample(0:1, n, replace = TRUE))

> x4 <- gl(4, 25)

> y <- 3 * sin(x1) + x2^2 + rnorm(n)

> knots.x2 <- quantile(x2, c(0.25, 0.5, 0.75))

> mod <- gamboost(y ~ bbs(x1, knots = 20, df = 4) + 
+     bbs(x2, knots = knots.x2, df = 5) + bols(x3) + bols(x4))

> par(mar = c(4, 4, 0, 0) + 0.1)

> plot(sort(x1), (3 * sin(x1))[order(x1)], type = "l", 
+     lwd = 2, xlab = expression(x[1]), ylab = expression(f[1](x[1])))

> lines(sort(x1), fitted(mod, which = 1)[order(x1)], 
+     col = red, lwd = 2, type = "b", pch = 20)

> legend("topleft", c("true effect", "model"), lty = c(1, 
+     1), pch = c(-1, 20), merge = TRUE, lwd = 2, col = c("black", 
+     red), bty = "n")

> par(mar = c(4, 4, 0, 0) + 0.1)

> plot(sort(x2), (x2^2)[order(x2)], type = "l", lwd = 2, 
+     xlab = expression(x[2]), ylab = expression(f[2](x[2])))

> lines(sort(x2), fitted(mod, which = 2)[order(x2)] + 
+     mod$offset, col = red, lwd = 2, type = "b", pch = 20)

> set.seed(1907)

> true_f <- function(x) cos(x) + 0.25 * sin(4 * x)

> x <- runif(150, 0, 2 * pi)

> y <- rnorm(150, mean = true_f(x), sd = 0.1)

> newX <- seq(0, 2 * pi, length = 200)

> mod <- gamboost(y ~ bbs(x, knots = 20, degree = 4))

> mod[3000]

	 Model-based Boosting

Call:
gamboost(formula = y ~ bbs(x, knots = 20, degree = 4))


	 Squared Error (Regression) 

Loss function: (y - f)^2 
 

Number of boosting iterations: mstop = 3000 
Step size:  0.1 
Offset:  0.0195 
Number of baselearners:  1 


> mod_cyclic <- gamboost(y ~ bbs(x, cyclic = TRUE, knots = 20, 
+     degree = 4, boundary.knots = c(0, 2 * pi)))

> mod_cyclic[3000]

	 Model-based Boosting

Call:
gamboost(formula = y ~ bbs(x, cyclic = TRUE, knots = 20, degree = 4,     boundary.knots = c(0, 2 * pi)))


	 Squared Error (Regression) 

Loss function: (y - f)^2 
 

Number of boosting iterations: mstop = 3000 
Step size:  0.1 
Offset:  0.0195 
Number of baselearners:  1 


> par(mar = c(4, 4, 0, 0) + 0.1)

> plot(x, y, ylab = "f(x)", pch = 20, xlim = c(0, 7), 
+     col = rgb(0.5, 0.5, 0.5, alpha = 0.8))

> lines(newX, predict(mod, data.frame(x = newX)), col = "black", 
+     lwd = 2)
Warning in bsplines(mf[[i]], knots = args$knots[[i]]$knots, boundary.knots = args$knots[[i]]$boundary.knots,  :
  Some ‘x’ values are beyond ‘boundary.knots’; Linear extrapolation used.

> lines(newX + 2 * pi, predict(mod, data.frame(x = newX)), 
+     col = "black", lwd = 2)
Warning in bsplines(mf[[i]], knots = args$knots[[i]]$knots, boundary.knots = args$knots[[i]]$boundary.knots,  :
  Some ‘x’ values are beyond ‘boundary.knots’; Linear extrapolation used.

> legend("bottomleft", c("cyclic = FALSE"), lty = c(1), 
+     col = c("black"), lwd = 2, bty = "n")

> par(mar = c(4, 4, 0, 0) + 0.1)

> plot(x, y, ylab = "f(x)", pch = 20, xlim = c(0, 7), 
+     col = rgb(0.5, 0.5, 0.5, alpha = 0.8))

> lines(newX, predict(mod_cyclic, data.frame(x = newX)), 
+     col = red, lwd = 2)

> lines(newX + 2 * pi, predict(mod_cyclic, data.frame(x = newX)), 
+     col = red, lwd = 2)

> abline(v = 2 * pi, col = "gray", lty = "dashed", lwd = 2)

> legend("bottomleft", c("cyclic = TRUE"), lty = c(1), 
+     col = c(red), lwd = 2, bty = "n")

> set.seed(1907)

> x1 <- runif(250, -pi, pi)

> x2 <- runif(250, -pi, pi)

> y <- sin(x1) * sin(x2) + rnorm(250, sd = 0.4)

> modspa <- gamboost(y ~ bspatial(x1, x2, knots = list(x1 = 12, 
+     x2 = 12)))

> library(lattice)

> library(RColorBrewer)

> nCols <- 50

> cols <- colorRampPalette(rev(brewer.pal(11, "RdBu")), 
+     space = "Lab", interpolate = "spline")(nCols)

> nd <- expand.grid(x1 = seq(-pi, pi, length = 100), 
+     x2 = seq(-pi, pi, length = 100))

> preds <- predict(modspa, newdata = nd)
Warning in bsplines(mf[[i]], knots = args$knots[[i]]$knots, boundary.knots = args$knots[[i]]$boundary.knots,  :
  Some ‘x’ values are beyond ‘boundary.knots’; Linear extrapolation used.
Warning in bsplines(mf[[i]], knots = args$knots[[i]]$knots, boundary.knots = args$knots[[i]]$boundary.knots,  :
  Some ‘x’ values are beyond ‘boundary.knots’; Linear extrapolation used.

> breaks <- seq(min(preds), max(preds), length = nCols + 
+     1)

> print(levelplot(preds ~ nd$x1 + nd$x2, xlab = expression(x[1]), 
+     ylab = expression(x[2]), at = breaks, col.regions = cols, 
+     cex = 0.7, c .... [TRUNCATED] 

> x1 <- x2 <- seq(-pi, pi, length = 50)

> nd <- expand.grid(x1 = x1, x2 = x2)

> preds <- predict(modspa, newdata = nd)
Warning in bsplines(mf[[i]], knots = args$knots[[i]]$knots, boundary.knots = args$knots[[i]]$boundary.knots,  :
  Some ‘x’ values are beyond ‘boundary.knots’; Linear extrapolation used.
Warning in bsplines(mf[[i]], knots = args$knots[[i]]$knots, boundary.knots = args$knots[[i]]$boundary.knots,  :
  Some ‘x’ values are beyond ‘boundary.knots’; Linear extrapolation used.

> z <- matrix(preds, ncol = length(x1))

> nrz <- nrow(z)

> ncz <- ncol(z)

> jet.colors <- colorRampPalette(paste(brewer.pal(11, 
+     "RdBu")[c(10, 2)], "E6", sep = ""))

> nbcol <- 10

> color <- jet.colors(nbcol)

> zfacet <- z[-1, -1] + z[-1, -ncz] + z[-nrz, -1] + 
+     z[-nrz, -ncz]

> facetcol <- cut(zfacet, nbcol)

> par(mar = c(1, 0.1, 0.1, 0.1), mgp = c(1.8, 1, 0))

> persp(x1, x2, z, theta = 45, phi = 30, expand = 0.5, 
+     col = color[facetcol], ticktype = "detailed", nticks = 3, 
+     xlab = "x1", ylab = "x2 ..." ... [TRUNCATED] 

> pdf("./graphics/fig-family.pdf", width = 5, height = 4)

> par(mar = c(4, 4, 0, 0) + 0.1)

> x <- seq(-2, 2, length = 200)

> plot(x, x^2, type = "l", ylab = expression(rho), xlab = expression(y - 
+     f))

> x <- seq(-2, 2, length = 200)

> lossL1 <- function(x, param) abs(x)

> mp <- 0.5

> dat <- data.frame(x = rep(x, length(mp)), y = as.numeric(sapply(mp, 
+     function(z) lossL1(x, param = z))), param = rep(mp, each = length(x)))

> dat$tau <- factor(dat$param)

> plot(x, dat$y, type = "l", ylab = expression(rho), 
+     xlab = expression(y - f))

> x <- seq(-2, 2, length = 200)

> lossH <- function(x, param) ifelse(abs(x) <= param, 
+     (1/2) * x^2, param * (abs(x) - param/2))

> mp <- c(0.2, 0.5, 1, 2, 10)

> dat <- data.frame(x = x, sapply(mp, function(z) lossH(x, 
+     param = z)))

> plot(x, dat$X1, type = "l", ylim = c(0, 2), ylab = expression(rho), 
+     xlab = expression(y - f))

> legend(0, 2, xjust = 0.5, legend = paste(mp), title = expression(delta), 
+     lty = 1, col = c(1, 3, 4, 5, 6), cex = 0.6, box.col = "gray")

> for (i in 1:(length(mp) - 1)) {
+     lines(x, dat[, i + 2], col = i + 2)
+ }

> x <- seq(-2, 2, length = 200)

> lossL1 <- function(x, param) ifelse(x >= 0, param * 
+     x, (param - 1) * x)

> mp <- c(5:9/10)

> dat <- data.frame(x = x, sapply(mp, function(z) lossL1(x, 
+     param = z)))

> plot(x, dat$X1, type = "l", ylab = expression(rho), 
+     ylim = c(0, 2), xlab = expression(y - f))

> legend(0, 2, xjust = 0.5, legend = paste(mp), title = expression(tau), 
+     lty = 1, col = c(1, 3, 4, 5, 6), cex = 0.6, box.col = "gray")

> for (i in 1:(length(mp) - 1)) {
+     lines(x, dat[, i + 2], col = i + 2)
+ }

> x <- seq(-2, 2, length = 200)

> dat <- data.frame(x = x, Binomial = log(1 + exp(-2 * 
+     x), base = 2), AdaExp = exp(-x))

> plot(x, dat$Binomial, type = "l", lty = 1, col = 1, 
+     xlab = expression(tilde(y) * f), ylab = expression(rho), 
+     ylim = c(0, 7.5))

> lines(x, dat$AdaExp, lty = 2, col = 2)

> legend("topright", legend = c("Binomial", "AdaExp"), 
+     xjust = 0.5, title = "loss", lty = 1:2, col = 1:2, cex = 0.8, 
+     bty = "n")

> dev.off()
pdf 
  2 

 *** Run successfully completed ***
> proc.time()
   user  system elapsed 
  3.122   0.674   3.045 
