[Mboost-commits] r765 - in pkg/mboostDevel: . R man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Fri Mar 28 13:52:26 CET 2014


Author: hofner
Date: 2014-03-28 13:52:25 +0100 (Fri, 28 Mar 2014)
New Revision: 765

Modified:
   pkg/mboostDevel/NAMESPACE
   pkg/mboostDevel/R/inference.R
   pkg/mboostDevel/R/methods.R
   pkg/mboostDevel/man/methods.Rd
   pkg/mboostDevel/man/stabsel.Rd
Log:
- added new plot method for stabsel objects (and documentation thereof)
- added new method risk


Modified: pkg/mboostDevel/NAMESPACE
===================================================================
--- pkg/mboostDevel/NAMESPACE	2014-03-24 15:33:40 UTC (rev 764)
+++ pkg/mboostDevel/NAMESPACE	2014-03-28 12:52:25 UTC (rev 765)
@@ -20,7 +20,7 @@
        Huber, AdaExp, Gehan, CoxPH, Hurdle, Multinomial, FP, IPCweights,
        cvrisk, cv, bbs, stabsel, stabsel_parameters,
        bols, bspatial, brandom, btree, bss, bns, brad, bmono, bmrf, buser, survFit, selected,
-       nuisance, "%+%", "%X%", "%O%", extract, "mstop<-")
+       nuisance, "%+%", "%X%", "%O%", extract, risk, "mstop<-")
        ###, basesel, fitsel)
 exportClasses("boost_family")
 exportMethods("show")
@@ -81,5 +81,6 @@
 S3method(extract, bl_lin)
 S3method(extract, bl_tree)
 S3method(residuals, mboost)
+S3method(risk, mboost)
 
 useDynLib(mboostDevel)

Modified: pkg/mboostDevel/R/inference.R
===================================================================
--- pkg/mboostDevel/R/inference.R	2014-03-24 15:33:40 UTC (rev 764)
+++ pkg/mboostDevel/R/inference.R	2014-03-28 12:52:25 UTC (rev 765)
@@ -240,20 +240,57 @@
     invisible(x)
 }
 
-plot.stabsel <- function(x, main = deparse(x$call), col = NULL, ...) {
+plot.stabsel <- function(x, main = deparse(x$call), type = c("paths", "maxsel"),
+                         col = NULL, ymargin = 10, np = sum(x$max > 0),
+                         labels = NULL, ...) {
 
-    h <- x$phat
-    h <- h[rowSums(h) > 0, , drop = FALSE]
+    type <- match.arg(type)
+
+
     if (is.null(col))
-        col <- hcl(h = 40, l = 50, c = h[,ncol(h)] / max(h) * 490)
-    matplot(t(h), type = "l", lty = 1, xlab = "Number of boosting iterations",
-            ylab = "Selection Probability", main = main, col = col, ylim = c(0, 1), ...)
-    abline(h = x$cutoff, lty = 1, col = "lightgray")
-    axis(4, at = x$phat[rowSums(x$phat) > 0, ncol(x$phat)],
-         labels = rownames(x$phat)[rowSums(x$phat) > 0], las = 1)
+        col <- hcl(h = 40, l = 50, c = x$max / max(x$max) * 490)
+
+    if (type == "paths") {
+        ## if par(mar) not set by user ahead of plotting
+        if (all(par()[["mar"]] == c(5, 4, 4, 2) + 0.1))
+            ..old.par <- par(mar = c(5, 4, 4, ymargin) + 0.1)
+        h <- x$phat
+        h <- h[rowSums(h) > 0, , drop = FALSE]
+        matplot(t(h), type = "l", lty = 1,
+                xlab = "Number of boosting iterations",
+                ylab = "Selection probability",
+                main = main, col = col[x$max > 0], ylim = c(0, 1), ...)
+        abline(h = x$cutoff, lty = 1, col = "lightgray")
+        if (is.null(labels))
+            rownames(x$phat)
+        axis(4, at = x$phat[rowSums(x$phat) > 0, ncol(x$phat)],
+             labels = labels[rowSums(x$phat) > 0], las = 1)
+    } else {
+        ## if par(mar) not set by user ahead of plotting
+        if (all(par()[["mar"]] == c(5, 4, 4, 2) + 0.1))
+            ..old.par <- par(mar = c(5, ymargin, 4, 2) + 0.1)
+        if (np > length(x$max))
+            stop(sQuote("np"), "is set too large")
+        inc_freq <- x$max  ## inclusion frequency
+        plot(tail(sort(inc_freq), np), 1:np,
+             type = "n", yaxt = "n", xlim = c(0, 1),
+             ylab = "", xlab = expression(hat(pi)),
+             main = main, ...)
+        abline(h = 1:np, lty = "dotted", col = "grey")
+        points(tail(sort(inc_freq), np), 1:np, pch = 19,
+               col = col[tail(order(inc_freq), np)])
+        if (is.null(labels))
+            labels <- names(x$max)
+        axis(2, at = 1:np, labels[tail(order(inc_freq), np)], las = 2)
+        ## add cutoff
+        abline(v = x$cutoff, col = "grey")
+    }
+    if (exists("..old.par"))
+        par(..old.par) # reset plotting settings
 }
 
 
+
 fitsel <- function(object, newdata = NULL, which = NULL, ...) {
     fun <- function(model) {
         tmp <- predict(model, newdata = newdata,

Modified: pkg/mboostDevel/R/methods.R
===================================================================
--- pkg/mboostDevel/R/methods.R	2014-03-24 15:33:40 UTC (rev 764)
+++ pkg/mboostDevel/R/methods.R	2014-03-28 12:52:25 UTC (rev 765)
@@ -611,3 +611,10 @@
     stop(sQuote("residuals()"), " only implemented for ",
          sQuote("family = Gaussian()"))
 }
+
+risk <- function(object, ...)
+    UseMethod("risk")
+
+risk.mboost <- function(object, ...) {
+    object$risk()
+}

Modified: pkg/mboostDevel/man/methods.Rd
===================================================================
--- pkg/mboostDevel/man/methods.Rd	2014-03-24 15:33:40 UTC (rev 764)
+++ pkg/mboostDevel/man/methods.Rd	2014-03-28 12:52:25 UTC (rev 765)
@@ -28,6 +28,9 @@
 \alias{variable.names.glmboost}
 \alias{variable.names.mboost}
 
+\alias{risk}
+\alias{risk.mboost}
+
 \alias{extract}
 \alias{extract.mboost}
 \alias{extract.gamboost}
@@ -107,6 +110,8 @@
 
 \method{selected}{mboost}(object, ...)
 
+\method{risk}{mboost}(object, ...)
+
 \method{nuisance}{mboost}(object)
 }
 \arguments{
@@ -269,7 +274,10 @@
   extracted using \code{selected()}. The \code{nuisance()} method
   extracts nuisance parameters from the fit that are handled internally
   by the corresponding family object, see
-  \code{"\linkS4class{boost_family}"}.
+  \code{"\linkS4class{boost_family}"}. The \code{risk()} function can be
+  used to extract the computed risk (either the \code{"inbag"} risk or
+  the \code{"oobag"} risk, depending on the control argument; see
+  \code{\link{boost_control}}).
 
   For (generalized) linear and additive models, the \code{AIC} function
   can be used to compute both the classical AIC (only available for

Modified: pkg/mboostDevel/man/stabsel.Rd
===================================================================
--- pkg/mboostDevel/man/stabsel.Rd	2014-03-24 15:33:40 UTC (rev 764)
+++ pkg/mboostDevel/man/stabsel.Rd	2014-03-28 12:52:25 UTC (rev 765)
@@ -3,6 +3,7 @@
 \alias{stabsel_parameters}
 \alias{stabsel_parameters.default}
 \alias{stabsel_parameters.mboost}
+\alias{plot.stabsel}
 \title{
     Stability Selection
 }
@@ -24,6 +25,10 @@
                    assumption = c("unimodal", "r-concave", "none"),
                    sampling.type = c("SS", "MB"),
                    verbose = FALSE, FWER)
+
+\method{plot}{stabsel}(x, main = deparse(x$call), type = c("paths", "maxsel"),
+     col = NULL, ymargin = 10, np = sum(x$max > 0),
+     labels = NULL, ...)
 }
 \arguments{
   \item{object}{an \code{mboost} object.}
@@ -61,8 +66,28 @@
   \item{eval}{ logical. Determines whether stability selection is
     evaluated (\code{eval = TRUE}; default) or if only the parameter
     combination is returned.}
+  \item{x}{object of class \code{stabsel}.}
+  \item{main}{main title for the plot.}
+  \item{type}{plot type; either stability paths (\code{"paths"}) or a
+    plot of the maximum selection frequency (\code{"maxsel"}).}
+  \item{col}{a vector of colors; Typically, one can specify a single
+     color or one color for each variable. Per default, colors depend on
+     the maximal selection frequency of the variable and range from grey
+     to red.}
+  \item{ymargin}{(temporarily) specifies the y margin of of the plot in
+    lines (see argument \code{"mar"} of function \code{\link{par}}).
+    This only affects the right margin for \code{type = "paths"} and
+    the left margin for \code{type = "maxsel"}. Explicit user specified
+    margins are kept and are not overwritten.}
+  \item{np}{number of variables to plot for the maximum selection
+    frequency plot (\code{type = "maxsel"}); the first \code{np}
+    variables with highest selection frequency are plotted.}
+  \item{labels}{variable labels for the plot; one label per base-learner
+    must be specified. Per default, names of base-learners are used.}
   \item{\dots}{additional arguments to \code{\link{cvrisk}} and further
-    arguments to parallel apply methods such as \code{\link{mclapply}}.}
+    arguments to parallel apply methods such as \code{\link{mclapply}}
+    or additional arguments to plot functions.}
+
 }
 \details{
 
@@ -130,5 +155,6 @@
   plot(sbody)
   par(opar)
 
+  plot(sbody, type = "maxsel", ymargin = 6)
 }
 \keyword{nonparametric}



More information about the Mboost-commits mailing list