[Mboost-commits] r727 - in pkg: mboostDevel mboostDevel/R mboostDevel/inst mboostDevel/man mboostDevel/tests mboostPatch/R mboostPatch/man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Mon Sep 2 17:59:45 CEST 2013


Author: hofner
Date: 2013-09-02 17:59:45 +0200 (Mon, 02 Sep 2013)
New Revision: 727

Modified:
   pkg/mboostDevel/.Rbuildignore
   pkg/mboostDevel/NAMESPACE
   pkg/mboostDevel/R/bl.R
   pkg/mboostDevel/R/bmrf.R
   pkg/mboostDevel/R/brad.R
   pkg/mboostDevel/R/crossvalidation.R
   pkg/mboostDevel/R/family.R
   pkg/mboostDevel/R/inference.R
   pkg/mboostDevel/R/methods.R
   pkg/mboostDevel/R/plot.R
   pkg/mboostDevel/inst/CHANGES
   pkg/mboostDevel/man/baselearners.Rd
   pkg/mboostDevel/man/cvrisk.Rd
   pkg/mboostDevel/man/glmboost.Rd
   pkg/mboostDevel/man/mboost_package.Rd
   pkg/mboostDevel/man/methods.Rd
   pkg/mboostDevel/man/stabsel.Rd
   pkg/mboostDevel/tests/regtest-baselearner.R
   pkg/mboostDevel/tests/regtest-family.R
   pkg/mboostDevel/tests/regtest-glmboost.R
   pkg/mboostPatch/R/methods.R
   pkg/mboostPatch/man/baselearners.Rd
   pkg/mboostPatch/man/mboost_package.Rd
Log:
- merge of mboostPatch > mboostDevel (first go)
- bugfix in experimental warning for coef() with family == Binomial()


Modified: pkg/mboostDevel/.Rbuildignore
===================================================================
--- pkg/mboostDevel/.Rbuildignore	2013-08-27 16:51:46 UTC (rev 726)
+++ pkg/mboostDevel/.Rbuildignore	2013-09-02 15:59:45 UTC (rev 727)
@@ -1,3 +1,3 @@
 demo
 to_do_list.txt
-
+^\..*
\ No newline at end of file

Modified: pkg/mboostDevel/NAMESPACE
===================================================================
--- pkg/mboostDevel/NAMESPACE	2013-08-27 16:51:46 UTC (rev 726)
+++ pkg/mboostDevel/NAMESPACE	2013-09-02 15:59:45 UTC (rev 727)
@@ -64,6 +64,7 @@
 S3method(coef, bm_lin)
 S3method(coef, bm_cwlin)
 S3method(selected, mboost)
+S3method(cvrisk, mboost)
 # S3method(selected, glmboost)
 S3method(update, mboost)
 S3method(print, stabsel)

Modified: pkg/mboostDevel/R/bl.R
===================================================================
--- pkg/mboostDevel/R/bl.R	2013-08-27 16:51:46 UTC (rev 726)
+++ pkg/mboostDevel/R/bl.R	2013-09-02 15:59:45 UTC (rev 727)
@@ -789,8 +789,10 @@
 ### random-effects (Ridge-penalized ANOVA) baselearner
 brandom <- function(..., contrasts.arg = "contr.dummy", df = 4) {
     cl <- cltmp <- match.call()
-    if (is.null(cl$df)) cl$df <- df
-    cl$intercept <- FALSE
+    if (is.null(cl$df))
+        cl$df <- df
+    if (is.null(cl$contrasts.arg))
+        cl$contrasts.arg <- contrasts.arg
     cl[[1L]] <- as.name("bols")
     ret <- eval(cl, parent.frame())
     cltmp[[1]] <- as.name("brandom")

Modified: pkg/mboostDevel/R/bmrf.R
===================================================================
--- pkg/mboostDevel/R/bmrf.R	2013-08-27 16:51:46 UTC (rev 726)
+++ pkg/mboostDevel/R/bmrf.R	2013-09-02 15:59:45 UTC (rev 727)
@@ -97,7 +97,7 @@
             data = mf)[, 2]
         X <- X * by
     }
-    if (!identical(args$center, FALSE)) {
+    if (isTRUE(args$center)) {
         ### L = \Gamma \Omega^1/2 in Section 2.3. of Fahrmeir et al. 
         ### (2004, Stat Sinica)
         SVD <- eigen(K, EISPACK = FALSE)

Modified: pkg/mboostDevel/R/brad.R
===================================================================
--- pkg/mboostDevel/R/brad.R	2013-08-27 16:51:46 UTC (rev 726)
+++ pkg/mboostDevel/R/brad.R	2013-09-02 15:59:45 UTC (rev 727)
@@ -105,6 +105,7 @@
         X <- X * by
     }
     ### </FIXME>
+    attr(X, "knots") <- args$knots
     return(list(X = X, K = K))
 }
 

Modified: pkg/mboostDevel/R/crossvalidation.R
===================================================================
--- pkg/mboostDevel/R/crossvalidation.R	2013-08-27 16:51:46 UTC (rev 726)
+++ pkg/mboostDevel/R/crossvalidation.R	2013-09-02 15:59:45 UTC (rev 727)
@@ -4,7 +4,10 @@
 ## for boosting algorithms
 ##
 
-cvrisk <- function (object, folds = cv(model.weights(object)), grid = 1:mstop(object),
+cvrisk <- function(object, ...)
+    UseMethod("cvrisk")
+
+cvrisk.mboost <- function (object, folds = cv(model.weights(object)), grid = 1:mstop(object),
                     papply = mclapply, fun = NULL, ...){
     weights <- model.weights(object)
     if (any(weights == 0))

Modified: pkg/mboostDevel/R/family.R
===================================================================
--- pkg/mboostDevel/R/family.R	2013-08-27 16:51:46 UTC (rev 726)
+++ pkg/mboostDevel/R/family.R	2013-09-02 15:59:45 UTC (rev 727)
@@ -100,7 +100,11 @@
 link2dist <- function(link, choices = c("logit", "probit"), ...) {
     i <- pmatch(link, choices, nomatch = 0L, duplicates.ok = TRUE)
     if (i[1] == 1) return("logit")
-    if (i[1] == 2) return(list(p = pnorm, d = dnorm, q = qnorm))
+    if (i[1] == 2) {
+        ret <- list(p = pnorm, d = dnorm, q = qnorm)
+        attr(ret, "link") <- link
+        return(ret)
+    }
     p <- get(paste("p", link, sep = ""))
     d <- get(paste("d", link, sep = ""))
     q <- get(paste("q", link, sep = ""))
@@ -281,9 +285,9 @@
                .Call("ngradientCoxPLik", time, event, f, w, package = "mboostDevel")
            },
            risk = risk <- function(y, f, w = 1) -sum(plloss(y, f, w), na.rm = TRUE),
-           offset = function(y, w)
-               optimize(risk, interval = c(0, max(y[,1], na.rm = TRUE)),
-                        y = y, w = w)$minimum,
+           offset = function(y, w = 1) 0, ## perhaps use something different
+                       ## Note: offset cannot be computed from Cox Partial LH as
+                       ## PLH doesn't depend on constant
            check_y = function(y) {
                if (!inherits(y, "Surv"))
                    stop("response is not an object of class ", sQuote("Surv"),
@@ -460,7 +464,7 @@
 
     Family(ngradient = ngradient, risk = risk,
            offset = function(y, w)
-               optimize(risk, interval = c(0, max(y[,1], na.rm = TRUE)),
+               optimize(risk, interval = c(0, max(log(y[,1]), na.rm = TRUE)),
                         y = y, w = w)$minimum,
            check_y = function(y) {
                if (!inherits(y, "Surv"))
@@ -513,7 +517,7 @@
 
     Family(ngradient = ngradient, risk = risk,
            offset = function(y, w)
-               optimize(risk, interval = c(0, max(y[,1], na.rm = TRUE)),
+               optimize(risk, interval = c(0, max(log(y[,1]), na.rm = TRUE)),
                         y = y, w = w)$minimum,
            check_y = function(y) {
                if (!inherits(y, "Surv"))
@@ -564,7 +568,7 @@
 
     Family(ngradient = ngradient, risk = risk,
            offset = function(y, w)
-               optimize(risk, interval = c(0, max(y[,1], na.rm = TRUE)),
+               optimize(risk, interval = c(0, max(log(y[,1]), na.rm = TRUE)),
                         y = y, w = w)$minimum,
            check_y = function(y) {
                if (!inherits(y, "Surv"))
@@ -816,7 +820,7 @@
            weights = "case",
            offset = function(y,w){
                optimize(risk,
-                        interval = c(0, max(y[,1], na.rm=TRUE)), y = y, w = w)$minimum
+                        interval = c(0, max(log(y[,1]), na.rm=TRUE)), y = y, w = w)$minimum
            },
            check_y = function(y) {
                if (!inherits(y,"Surv"))

Modified: pkg/mboostDevel/R/inference.R
===================================================================
--- pkg/mboostDevel/R/inference.R	2013-08-27 16:51:46 UTC (rev 726)
+++ pkg/mboostDevel/R/inference.R	2013-09-02 15:59:45 UTC (rev 727)
@@ -1,56 +1,103 @@
 
-stabsel <- function(object, FWER = 0.05, cutoff, q,
+stabsel <- function(object, cutoff, q, PFER,
                     folds = cv(model.weights(object), type = "subsampling", B = 100),
-                    papply = mclapply, ...) {
+                    papply = mclapply, verbose = TRUE, FWER, ...) {
 
     p <- length(variable.names(object))
     ibase <- 1:p
 
-    if (!missing(q) && p < q)
-        stop("Average number of selected base-learners ", sQuote("q"),
-             " must be smaller \n  than the number of base-learners",
-             " specified in the model ", sQuote("object"))
+    ## only two of the four arguments can be specified
+    if ((nmiss <- sum(missing(PFER), missing(cutoff),
+                      missing(q), missing(FWER))) != 2) {
+        if (nmiss > 2)
+            stop("Two of the three argumnets ",
+                 sQuote("PFER"), ", ", sQuote("cutoff"), " and ", sQuote("q"),
+                 " must be specifed")
+        if (nmiss < 2)
+            stop("Only two of the three argumnets ",
+                 sQuote("PFER"), ", ", sQuote("cutoff"), " and ", sQuote("q"),
+                 " can be specifed at the same time")
+    }
 
-    if (!(FWER > 0 && FWER < 0.5))
-        stop(sQuote("FWER"), " must be between 0 and 0.5")
+    if (!missing(FWER)) {
+        if (!missing(PFER))
+            stop(sQuote("FWER"), " and ", sQuote("PFER"),
+                 " cannot be spefified at the same time")
+        PFER <- FWER
+        warning(sQuote("FWER"), " is deprecated. Use ", sQuote("PFER"),
+                " instead.")
+    }
 
-    if (! xor(missing(cutoff), missing(q)))
-        stop(" Either ", sQuote("cutoff"), " or ", sQuote("q"),
-             "must be specified (but not both).")
+    if ((!missing(PFER) || !missing(FWER)) && PFER < 0)
+        stop(sQuote("PFER"), " must be greater 0")
 
+    if (!missing(cutoff) && (cutoff < 0.5 | cutoff > 1))
+        stop(sQuote("cutoff"), " must be between 0.5 and 1")
+
+    if (!missing(q)) {
+        if (p < q)
+            stop("Average number of selected base-learners ", sQuote("q"),
+                 " must be smaller \n  than the number of base-learners",
+                 " specified in the model ", sQuote("object"))
+        if (q < 0)
+            stop("Average number of selected base-learners ", sQuote("q"),
+                 " must be greater 0")
+    }
+
     if (missing(cutoff)) {
-        cutoff <- min(0.9, tmp <- (q^2 / (FWER * p) + 1) / 2)
+        cutoff <- min(0.9, tmp <- (q^2 / (PFER * p) + 1) / 2)
         upperbound <- q^2 / p / (2 * cutoff - 1)
-        if (tmp > 0.9 && upperbound - FWER > FWER/2) {
-            warning("Upper bound for FWER >> ", FWER,
+        if (verbose && tmp > 0.9 && upperbound - PFER > PFER/2) {
+            warning("Upper bound for PFER > ", PFER,
                     " for the given value of ", sQuote("q"),
-                    " (true upper bound = ", upperbound, ")")
+                    " (true upper bound = ", round(upperbound, 2), ")")
         }
     }
-    if (missing(q)){
-        stopifnot(cutoff >= 0.5)
-        q <- ceiling(sqrt(FWER * (2 * cutoff - 1) * p))
+
+    if (missing(q)) {
+        q <- ceiling(sqrt(PFER * (2 * cutoff - 1) * p))
         upperbound <- q^2 / p / (2 * cutoff - 1)
-        if (upperbound - FWER > FWER/2)
-            warning("Upper bound for FWER >> ", FWER,
+        if (verbose && upperbound - PFER > PFER/2)
+            warning("Upper bound for PFER > ", PFER,
                     " for the given value of ", sQuote("cutoff"),
                     " (true upper bound = ", upperbound, ")")
     }
 
+    if (missing(PFER)) {
+        upperbound <- PFER <- q^2 / p / (2 * cutoff - 1)
+    }
+    if (verbose && PFER >= p)
+        warning("Upper bound for PFER larger than the number of base-learners.")
+
     fun <- function(model) {
         xs <- selected(model)
         qq <- sapply(1:length(xs), function(x) length(unique(xs[1:x])))
-        if (qq[length(xs)] < q)
-            warning(sQuote("mstop"), " too small to select ", sQuote("q"),
-                    " base-learners; Increase ", sQuote("mstop"),
-                    " bevor applying ", sQuote("stabsel"))
         xs[qq > q] <- xs[1]
         xs
     }
     ss <- cvrisk(object, fun  = fun,
                  folds = folds,
                  papply = papply, ...)
-    ret <- matrix(0, nrow = length(ibase), ncol = m <- mstop(object))
+
+    if (verbose){
+        qq <- sapply(ss, function(x) length(unique(x)))
+        sum_of_violations <- sum(qq < q)
+        if (sum_of_violations > 0)
+            warning(sQuote("mstop"), " too small in ",
+                    sum_of_violations, " of the ", ncol(folds),
+                    " subsampling replicates to select ", sQuote("q"),
+                    " base-learners; Increase ", sQuote("mstop"),
+                    " bevor applying ", sQuote("stabsel"))
+    }
+
+
+    ## if grid specified in '...'
+    if (length(list(...)) >= 1 && "grid" %in% names(list(...))) {
+        m <- max(list(...)$grid)
+    } else {
+        m <- mstop(object)
+    }
+    ret <- matrix(0, nrow = length(ibase), ncol = m)
     for (i in 1:length(ss)) {
         tmp <- sapply(ibase, function(x)
             ifelse(x %in% ss[[i]], which(ss[[i]] == x)[1], m + 1))
@@ -62,12 +109,12 @@
     if (extends(class(object), "glmboost"))
         rownames(phat) <- variable.names(object)
     ret <- list(phat = phat, selected = which((mm <- apply(phat, 1, max)) >= cutoff),
-                max = mm, cutoff = cutoff, q = q)
+                max = mm, cutoff = cutoff, q = q, PFER = upperbound)
     class(ret) <- "stabsel"
     ret
 }
 
-print.stabsel <- function(x, ...) {
+print.stabsel <- function(x, decreasing = FALSE, ...) {
 
     cat("\tStability Selection\n")
     if (length(x$selected) > 0) {
@@ -77,9 +124,10 @@
         cat("\nNo base-learner selected\n")
     }
     cat("\nSelection probabilities:\n")
-    print(x$max[x$max > 0])
+    print(sort(x$max[x$max > 0], decreasing = decreasing))
     cat("\nCutoff: ", x$cutoff, "; ", sep = "")
-    cat("q: ", x$q, "\n\n")
+    cat("q: ", x$q, "; ", sep = "")
+    cat("PFER: ", x$PFER, "\n\n")
     invisible(x)
 }
 

Modified: pkg/mboostDevel/R/methods.R
===================================================================
--- pkg/mboostDevel/R/methods.R	2013-08-27 16:51:46 UTC (rev 726)
+++ pkg/mboostDevel/R/methods.R	2013-09-02 15:59:45 UTC (rev 727)
@@ -54,6 +54,11 @@
     args <- list(...)
     if (length(args) > 0)
         warning("Arguments ", paste(names(args), sep = ", "), " unknown")
+    if (grepl("Negative Binomial Likelihood", object$family at name))
+        message("\nNOTE: Coefficients from a Binomial model are half the size of ",
+                "coefficients\n from a model fitted via ",
+                "glm(... , family = 'binomial').\n",
+                "See Warning section in ?coef.mboost\n")
     object$coef(which = which, aggregate = aggregate)
 }
 
@@ -269,6 +274,11 @@
     if (length(args) > 0)
         warning("Arguments ", paste(names(args), sep = ", "), " unknown")
 
+    if (grepl("Negative Binomial Likelihood", object$family at name))
+        message("\nNOTE: Coefficients from a Binomial model are half the size of ",
+                "coefficients\n from a model fitted via ",
+                "glm(... , family = 'binomial').\n",
+                "See Warning section in ?coef.mboost\n")
 
     aggregate <- match.arg(aggregate)
     cf <- object$coef(which = which, aggregate = aggregate)
@@ -449,7 +459,8 @@
     UseMethod("extract")
 
 extract.mboost <- function(object, what = c("design", "penalty", "lambda", "df",
-                                   "coefficients", "residuals", "bnames", "offset",
+                                   "coefficients", "residuals",
+                                   "variable.names", "bnames", "offset",
                                    "nuisance", "weights", "index", "control"),
                            which = NULL, ...){
     what <- match.arg(what)
@@ -461,25 +472,20 @@
         names(ret) <- extract(object, what = "bnames", which = which)
         return(ret)
     }
-    if (what == "coefficients")
-        return(coef(object, which = which))
-    if (what == "residuals")
-        return(residuals(object))
-    if (what == "bnames")
-        return(get("bnames", envir = environment(object$update))[which])
-    if (what == "offset")
-        return(object$offset)
-    if (what == "nuisance")
-        return(nuisance(object))
-    if (what == "weights")
-        return(model.weights(object))
-    if (what == "control")
-        return(object$control)
+    switch(what,
+           "coefficients" = return(coef(object, which = which)),
+           "residuals" = return(residuals(object)),
+           "variable.names" = return(variable.names(object)),
+           "bnames" = return(get("bnames", envir = environment(object$update))[which]),
+           "offset" = return(object$offset),
+           "nuisance" = return(nuisance(object)),
+           "weights" = return(model.weights(object)),
+           "control" = return(object$control))
 }
 
 extract.glmboost <- function(object, what = c("design", "coefficients", "residuals",
-                                     "bnames", "offset", "nuisance", "weights",
-                                     "control"),
+                                     "variable.names", "bnames", "offset",
+                                     "nuisance", "weights", "control"),
                              which = NULL, asmatrix = FALSE, ...){
     what <- match.arg(what)
     center <- get("center", envir = environment(object$newX))
@@ -495,29 +501,23 @@
     } else {
         which <- object$which(which)
     }
+
     if (what == "design"){
         mat <- object$baselearner[[1]]$get_data()[,which]
         if (asmatrix)
             mat <- as.matrix(mat)
         return(mat)
     }
-    if (what == "coefficients")
-        return(coef(object, which = which))
-    if (what == "residuals")
-        return(residuals(object))
-    if (what == "bnames")
-        return(get("bnames", envir = environment(object$update))[which])
-    if (what == "offset")
-        return(object$offset)
-    if (what == "nuisance")
-        return(nuisance(object))
-    if (what == "weights")
-        return(model.weights(object))
-    ## index doensn't store the index as base-learners in gamboost do
-    #if (what == "index")
-    #    return(object$baselearner[[1]]$get_index())
-    if (what == "control")
-        return(object$control)
+
+    switch(what,
+           "coefficients" = return(coef(object, which = which)),
+           "residuals" = return(residuals(object)),
+           "variable.names" = return(variable.names(object)),
+           "bnames" = return(get("bnames", envir = environment(object$update))[which]),
+           "offset" = return(object$offset),
+           "nuisance" = return(nuisance(object)),
+           "weights" = return(model.weights(object)),
+           "control" = return(object$control))
 }
 
 extract.blackboost <- function(object, ...)
@@ -526,7 +526,7 @@
 extract.blg <- function(object, what = c("design", "penalty", "index"),
                         asmatrix = FALSE, expand = FALSE, ...){
     what <- match.arg(what)
-    object <- object$dpp(rep(1, nrow(object$model.frame())))
+    object <- object$dpp(rep(1, NROW(object$model.frame())))
     return(extract(object, what = what,
                    asmatrix = asmatrix, expand = expand))
 }

Modified: pkg/mboostDevel/R/plot.R
===================================================================
--- pkg/mboostDevel/R/plot.R	2013-08-27 16:51:46 UTC (rev 726)
+++ pkg/mboostDevel/R/plot.R	2013-09-02 15:59:45 UTC (rev 727)
@@ -11,7 +11,7 @@
     which <- x$which(which, usedonly = is.null(which))
 
     pr <- predict(x, which = which, newdata = newdata)
-    if (is.null(ylim)) ylim <- range(pr)
+    if (is.null(ylim)) ylim <- range(pr, na.rm = TRUE)
     ## <FIXME> default ylim not suitable for plotting varying coefficient
     ##         base-learners; Users need to specify suitable values themselves
 
@@ -64,15 +64,15 @@
 
             if (ncol(data) == 1) {
                 if (!add){
-                    plot(sort(data[[1]]), pr[order(data[[1]])], type = type,
+                    plot(sort(data[[1]]), pr[order(data[[1]], na.last = NA)], type = type,
                          xlab = xl, ylab = yl, ylim = ylim, ...)
                     if (rug) rug(data[[1]], col = rugcol)
                 } else {
                     if (is.factor(data[[1]])){
-                        boxplot(pr[order(data[[1]])] ~ sort(data[[1]]),
+                        boxplot(pr[order(data[[1]], na.last = NA)] ~ sort(data[[1]]),
                                 add = TRUE, ...)
                     } else {
-                        lines(sort(data[[1]]), pr[order(data[[1]])], type =
+                        lines(sort(data[[1]]), pr[order(data[[1]], na.last = NA)], type =
                               type, ...)
                         if (rug){
                             rug(data[[1]], col = rugcol)
@@ -106,7 +106,7 @@
                         tmp[[v]] <- vv
                         mean(predict(x, newdata = tmp, which = w))
                     })
-                    plot(sort(data[[v]]), pardep[order(data[[v]])], type = type,
+                    plot(sort(data[[v]]), pardep[order(data[[v]], na.last = NA)], type = type,
                          xlab = v, ylab = "Partial Dependency", ylim = ylim, ...)
                 }
             }

Modified: pkg/mboostDevel/inst/CHANGES
===================================================================
--- pkg/mboostDevel/inst/CHANGES	2013-08-27 16:51:46 UTC (rev 726)
+++ pkg/mboostDevel/inst/CHANGES	2013-09-02 15:59:45 UTC (rev 727)
@@ -8,9 +8,11 @@
 
   o  new argument deriv to bbs for computing derivatives of B-splines
 
+  o  new constraints added for positive and negative spline estimates
 
-                CHANGES in `mboost' VERSION 2.2-2 (2013-xx-yy, rzzz)
 
+                CHANGES in `mboost' VERSION 2.2-2 (2013-02-08, r703)
+
   o  bbs(..., center = "spectralDecomp") computes the spectral decomposition
      of the penalty matrix and the penalized part of the design matrix is
      defined by this decomposition. Experiments show that
@@ -22,9 +24,15 @@
      For bbs(x, y, center = TRUE) or bmrf(x, center = TRUE), the spectral
      decomposition is (and was) always used.
 
-  o  fixed bug in stabsel: '...' was not passed to cvrisk and thus one could 
+  o  fixed bug in stabsel: '...' was not passed to cvrisk and thus one could
      not specify options for mclapply
 
+  o  fixed bug in brandom: now really use contrasts.arg = "contr.dummy" per
+     default.
+
+  o  removed tests/ folder and .Rout.save files for vignettes from the CRAN
+     release
+
   o  small improvements in manual
 
 
@@ -46,7 +54,7 @@
 
   o  updated vignette mboost_tutorial
 
-  o  updated mboost_package.Rd: 
+  o  updated mboost_package.Rd:
      now all important changes since mboost 2.0 are documented there
 
   o  changed roles of contributers to ctb
@@ -58,17 +66,17 @@
 
                 CHANGES in `mboost' VERSION 2.2-0 (2012-11-21, r680)
 
-  o  switch from packages `multicore' and `snow' to `parallel'
+  o  switch from packages `multicore' and`snow' to `parallel'
 
   o  changed behavior of bols(x, intercept = FALSE) when x is a factor:
-     now the intercept is simply dropped from the design matrix; 
+     now the intercept is simply dropped from the design matrix;
      coding can be specified as usually for factors.
 
-  o  changed default for options("mboost_dftraceS") to FALSE, i.e., 
-     degrees of freedom are now computed from smoothing parameter 
+  o  changed default for options("mboost_dftraceS") to FALSE, i.e.,
+     degrees of freedom are now computed from smoothing parameter
      as described in B. Hofner, T. Hothorn, T. Kneib, M. Schmid (2011).
 
-  o  changed computation of B-spline basis at the boundaries: 
+  o  changed computation of B-spline basis at the boundaries:
      now also use equidistant knots in the boundaries (per default)
 
   o  improved plot function when dealing with spatial plots
@@ -76,11 +84,11 @@
 
   o  increased default number of subsampling replicates in stabsel to 100
 
-  o  [experimental] bmono() now implements constraints at the boundaries of 
+  o  [experimental] bmono() now implements constraints at the boundaries of
      (monotonic) P-splines
 
   o  [experimental] added family Gehan() for rank-based estimation of survival models
-	   in an accelerated failure time framework (contributed by Brent Johnson 
+	   in an accelerated failure time framework (contributed by Brent Johnson
        <bajohn3 at emory.edu>)
 
 

Modified: pkg/mboostDevel/man/baselearners.Rd
===================================================================
--- pkg/mboostDevel/man/baselearners.Rd	2013-08-27 16:51:46 UTC (rev 726)
+++ pkg/mboostDevel/man/baselearners.Rd	2013-09-02 15:59:45 UTC (rev 727)
@@ -23,7 +23,7 @@
      lambda = 0, contrasts.arg = "contr.treatment")
 bbs(..., by = NULL, index = NULL, knots = 20, boundary.knots = NULL,
     degree = 3, differences = 2, df = 4, lambda = NULL, center = FALSE,
-    cyclic = FALSE, constraint = c("none", "increasing", "decreasing"), 
+    cyclic = FALSE, constraint = c("none", "increasing", "decreasing"),
     deriv = 0)
 bspatial(..., df = 6)
 brad(..., by = NULL, index = NULL, knots = 100, df = 4, lambda = NULL,
@@ -34,7 +34,8 @@
                                          mincriterion = 0,
                                          savesplitstats = FALSE))
 bmono(...,
-      constraint = c("increasing", "decreasing", "convex", "concave", "none"),
+      constraint = c("increasing", "decreasing", "convex", "concave",
+                     "none", "positive", "negative"),
       by = NULL, index = NULL, knots = 20, boundary.knots = NULL,
       degree = 3, differences = 2, df = 4, lambda = NULL,
       lambda2 = 1e6, niter=10, intercept = TRUE,
@@ -111,10 +112,10 @@
                  re-parameterized such that the unpenalized part of the fit is subtracted and
                  only the deviation effect is fitted. The unpenalized, parametric part has then
                  to be included in separate base-learners using \code{bols} (see the examples below).
-                 There are two possible ways to re-parameterization; 
-                 \code{center = "differenceMatrix"} is based on the difference matrix 
-                 (the default for \code{bbs} with one covariate only) 
-                 and \code{center = "spectralDecomp"} uses a spectral decomposition 
+                 There are two possible ways to re-parameterization;
+                 \code{center = "differenceMatrix"} is based on the difference matrix
+                 (the default for \code{bbs} with one covariate only)
+                 and \code{center = "spectralDecomp"} uses a spectral decomposition
                  of the penalty matrix (see Fahrmeir et al., 2004, Section 2.3 for details).
                  The latter option is the default (and currently only option) for \code{bbs}
                  with multiple covariates or \code{bmrf}.}
@@ -345,7 +346,7 @@
   with an additional asymmetric penalty enforcing monotonicity or
   convexity/concavity (see and Eilers, 2005). For more details in the
   boosting context and monotonic effects of ordinal factors see Hofner,
-  Mueller and Hothorn (2011b). Alternative monotonicity constraints 
+  Mueller and Hothorn (2011b). Alternative monotonicity constraints
   are implemented via T-splines in \code{bbs()} (Beliakov, 2000).
 
   Two or more linear base-learners can be joined using \code{\%+\%}. A
@@ -449,7 +450,7 @@
   Benjamin Hofner (2010), Model-based Boosting 2.0, \emph{Journal of
     Machine Learning Research}, \bold{11}, 2109--2113.
 
-  G. M. Beliakov (2000), Shape Preserving Approximation using Least Squares 
+  G. M. Beliakov (2000), Shape Preserving Approximation using Least Squares
     Splines, \emph{Approximation Theory and its Applications}, bold{16}(4), 80-98.
 
 }

Modified: pkg/mboostDevel/man/cvrisk.Rd
===================================================================
--- pkg/mboostDevel/man/cvrisk.Rd	2013-08-27 16:51:46 UTC (rev 726)
+++ pkg/mboostDevel/man/cvrisk.Rd	2013-09-02 15:59:45 UTC (rev 727)
@@ -1,12 +1,13 @@
 \name{cvrisk}
 \alias{cvrisk}
+\alias{cvrisk.mboost}
 \alias{cv}
 \title{ Cross-Validation }
 \description{
   Cross-validated estimation of the empirical risk for hyper-parameter selection.
 }
 \usage{
-cvrisk(object, folds = cv(model.weights(object)),
+\method{cvrisk}{mboost}(object, folds = cv(model.weights(object)),
        grid = 1:mstop(object),
        papply = mclapply,
        fun = NULL, ...)
@@ -21,9 +22,13 @@
                 using function \code{cv} and defaults to 25 bootstrap samples.}
   \item{grid}{ a vector of stopping parameters the empirical risk
                 is to be evaluated for. }
-  \item{papply}{ (parallel) apply function, defaults to  \code{\link[parallel]{mclapply}}.
-    Alternatively, \code{parLapply} can be used. In the
-    latter case, usually more setup is needed (see example for some details).}
+  \item{papply}{
+    (parallel) apply function, defaults to  \code{\link[parallel]{mclapply}}.
+    Alternatively, \code{\link[parallel]{parLapply}} can be used. In the
+    latter case, usually more setup is needed (see example for some
+    details). To run \code{cvrisk} sequentially (i.e. not in parallel),
+    one can use \code{\link{lapply}}.
+  }
   \item{fun}{ if \code{fun} is NULL, the out-of-sample risk is returned. \code{fun},
               as a function of \code{object}, may extract any other characteristic
               of the cross-validated models. These are returned as is.}
@@ -36,8 +41,7 @@
   \item{prob}{ percentage of observations to be included in the learning samples
                for subsampling.}
   \item{strata}{ a factor of the same length as \code{weights} for stratification.}
-  \item{...}{additional arguments passed to \code{\link[parallel]{mclapply}}
-             eventually.}
+  \item{...}{additional arguments passed to \code{\link[parallel]{mclapply}}.}
 }
 \details{
 

Modified: pkg/mboostDevel/man/glmboost.Rd
===================================================================
--- pkg/mboostDevel/man/glmboost.Rd	2013-08-27 16:51:46 UTC (rev 726)
+++ pkg/mboostDevel/man/glmboost.Rd	2013-09-02 15:59:45 UTC (rev 727)
@@ -93,51 +93,53 @@
 
     ### a simple two-dimensional example: cars data
     cars.gb <- glmboost(dist ~ speed, data = cars,
-                        control = boost_control(mstop = 5000),
+                        control = boost_control(mstop = 2000),
                         center = FALSE)
     cars.gb
 
     ### coefficients should coincide
-    coef(cars.gb) + c(cars.gb$offset, 0)
-    coef(lm(dist ~ speed, data = cars))
-
-    ### plot fit
-    layout(matrix(1:2, ncol = 2))
-    plot(dist ~ speed, data = cars)
-    lines(cars$speed, predict(cars.gb), col = "red")
-
+    cf <- coef(cars.gb, off2int = TRUE)     ## add offset to intercept
+    coef(cars.gb) + c(cars.gb$offset, 0)    ## add offset to intercept (by hand)
+    signif(cf, 3)
+    signif(coef(lm(dist ~ speed, data = cars)), 3)
+    ## almost converged. With higher mstop the results get even better
+ 
     ### now we center the design matrix for
     ### much quicker "convergence"
     cars.gb_centered <- glmboost(dist ~ speed, data = cars,
                                  control = boost_control(mstop = 2000),
                                  center = TRUE)
-    par(mfrow=c(1,2))
+
+    ## plot coefficient paths oth glmboost
+    par(mfrow=c(1,2), mai = par("mai") * c(1, 1, 1, 2.5))
     plot(cars.gb, main="without centering")
     plot(cars.gb_centered, main="with centering")
 
     ### alternative loss function: absolute loss
     cars.gbl <- glmboost(dist ~ speed, data = cars,
-                         control = boost_control(mstop = 5000),
+                         control = boost_control(mstop = 1000),
                          family = Laplace())
     cars.gbl
+    coef(cars.gbl, off2int = TRUE)
 
-    coef(cars.gbl) + c(cars.gbl$offset, 0)
-    lines(cars$speed, predict(cars.gbl), col = "green")
+    ### plot fit
+    par(mfrow = c(1,1))
+    plot(dist ~ speed, data = cars)
+    lines(cars$speed, predict(cars.gb), col = "red")     ## quadratic loss
+    lines(cars$speed, predict(cars.gbl), col = "green")  ## absolute loss
 
     ### Huber loss with adaptive choice of delta
     cars.gbh <- glmboost(dist ~ speed, data = cars,
-                         control = boost_control(mstop = 5000),
+                         control = boost_control(mstop = 1000),
                          family = Huber())
 
-    lines(cars$speed, predict(cars.gbh), col = "blue")
+    lines(cars$speed, predict(cars.gbh), col = "blue")   ## Huber loss
     legend("topleft", col = c("red", "green", "blue"), lty = 1,
            legend = c("Gaussian", "Laplace", "Huber"), bty = "n")
 
-    ### plot coefficient path of glmboost
-    par(mai = par("mai") * c(1, 1, 1, 2.5))
-    plot(cars.gb)
-
-    ### sparse high-dimensional example
+    ### sparse high-dimensional example that makes use of the matrix
+    ### interface of glmboost and uses the matrix representation from
+    ### package Matrix
     library("Matrix")
     n <- 100
     p <- 10000

Modified: pkg/mboostDevel/man/mboost_package.Rd
===================================================================
--- pkg/mboostDevel/man/mboost_package.Rd	2013-08-27 16:51:46 UTC (rev 726)
+++ pkg/mboostDevel/man/mboost_package.Rd	2013-09-02 15:59:45 UTC (rev 727)
@@ -134,6 +134,10 @@
   Benjamin Hofner (2010), Model-based Boosting 2.0. \emph{Journal of
   Machine Learning Research}, \bold{11}, 2109--2113.
 
+  Benjamin Hofner, Torsten Hothorn, Thomas Kneib, and Matthias Schmid (2011),
+  A framework for unbiased model selection based on boosting.
+  \emph{Journal of Computational and Graphical Statistics}, \bold{20}, 956--971.
+
   Benjamin Hofner, Andreas Mayr, Nikolay Robinzonov and Matthias Schmid
   (2012). Model-based Boosting in R: A Hands-on Tutorial Using the R
   Package mboost. \emph{Department of Statistics, Technical Report No. 120}.\cr

Modified: pkg/mboostDevel/man/methods.Rd
===================================================================
--- pkg/mboostDevel/man/methods.Rd	2013-08-27 16:51:46 UTC (rev 726)
+++ pkg/mboostDevel/man/methods.Rd	2013-09-02 15:59:45 UTC (rev 727)
@@ -25,6 +25,9 @@
 \alias{residuals.mboost}
 \alias{resid.mboost}
 
+\alias{variable.names.glmboost}
+\alias{variable.names.mboost}
+
 \alias{extract}
 \alias{extract.mboost}
 \alias{extract.gamboost}
@@ -59,7 +62,7 @@
 \method{coef}{mboost}(object, which = NULL,
     aggregate = c("sum", "cumsum", "none"), ...)
 \method{coef}{glmboost}(object, which = NULL,
-    aggregate = c("sum", "cumsum", "none"), off2int = FALSE, ...)
+     aggregate = c("sum", "cumsum", "none"), off2int = FALSE, ...)
 
 \method{[}{mboost}(x, i, return = TRUE, ...)
 mstop(x) <- value
@@ -72,27 +75,31 @@
[TRUNCATED]

To get the complete diff run:
    svnlook diff /svnroot/mboost -r 727


More information about the Mboost-commits mailing list