[Mboost-commits] r730 - / pkg/mboostPatch pkg/mboostPatch/R pkg/mboostPatch/man pkg/mboostPatch/tests

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Sep 5 16:16:14 CEST 2013


Author: hofner
Date: 2013-09-05 16:16:13 +0200 (Thu, 05 Sep 2013)
New Revision: 730

Modified:
   pkg/mboostPatch/DESCRIPTION
   pkg/mboostPatch/R/inference.R
   pkg/mboostPatch/man/stabsel.Rd
   pkg/mboostPatch/tests/regtest-gamboost.R
   svn_release.txt
Log:
- reverted stabsel (newest code only in mboostDevel)
- added survival to Suggests in DESCRIPTION to make checks happy
- improved svn release SOPs


Modified: pkg/mboostPatch/DESCRIPTION
===================================================================
--- pkg/mboostPatch/DESCRIPTION	2013-09-03 18:59:14 UTC (rev 729)
+++ pkg/mboostPatch/DESCRIPTION	2013-09-05 14:16:13 UTC (rev 730)
@@ -15,8 +15,8 @@
   component-wise (penalised) least squares estimates or regression
   trees as base-learners for fitting generalized linear, additive
   and interaction models to potentially high-dimensional data.
-Depends: R (>= 2.14.0), methods, stats, parallel
-Imports: Matrix, survival, splines, lattice
+Depends: R (>= 2.14.0), methods, stats, parallel, survival
+Imports: Matrix, splines, lattice
 Suggests: party (>= 1.0-3), TH.data, MASS, fields,
   BayesX, gbm, mlbench, RColorBrewer, rpart (>= 4.0-3)
 LazyData: yes

Modified: pkg/mboostPatch/R/inference.R
===================================================================
--- pkg/mboostPatch/R/inference.R	2013-09-03 18:59:14 UTC (rev 729)
+++ pkg/mboostPatch/R/inference.R	2013-09-05 14:16:13 UTC (rev 730)
@@ -1,74 +1,42 @@
 
-stabsel <- function(object, cutoff, q, PFER,
+stabsel <- function(object, FWER = 0.05, cutoff, q,
                     folds = cv(model.weights(object), type = "subsampling", B = 100),
-                    papply = mclapply, verbose = TRUE, FWER, ...) {
+                    papply = mclapply, verbose = TRUE, ...) {
 
     p <- length(variable.names(object))
     ibase <- 1:p
 
-    ## 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 (!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"))
 
-    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 (!(FWER > 0 && FWER < 0.5))
+        stop(sQuote("FWER"), " must be between 0 and 0.5")
 
-    if ((!missing(PFER) || !missing(FWER)) && PFER < 0)
-        stop(sQuote("PFER"), " must be greater 0")
+    if (! xor(missing(cutoff), missing(q)))
+        stop(" Either ", sQuote("cutoff"), " or ", sQuote("q"),
+             "must be specified (but not both).")
 
-    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 / (PFER * p) + 1) / 2)
+        cutoff <- min(0.9, tmp <- (q^2 / (FWER * p) + 1) / 2)
         upperbound <- q^2 / p / (2 * cutoff - 1)
-        if (verbose && tmp > 0.9 && upperbound - PFER > PFER/2) {
-            warning("Upper bound for PFER > ", PFER,
+        if (verbose && tmp > 0.9 && upperbound - FWER > FWER/2) {
+            warning("Upper bound for FWER >> ", FWER,
                     " for the given value of ", sQuote("q"),
-                    " (true upper bound = ", round(upperbound, 2), ")")
+                    " (true upper bound = ", min(1, round(upperbound, 2)), ")")
         }
     }
-
-    if (missing(q)) {
-        q <- ceiling(sqrt(PFER * (2 * cutoff - 1) * p))
+    if (missing(q)){
+        stopifnot(cutoff >= 0.5)
+        q <- ceiling(sqrt(FWER * (2 * cutoff - 1) * p))
         upperbound <- q^2 / p / (2 * cutoff - 1)
-        if (verbose && upperbound - PFER > PFER/2)
-            warning("Upper bound for PFER > ", PFER,
+        if (verbose && upperbound - FWER > FWER/2)
+            warning("Upper bound for FWER >> ", FWER,
                     " 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])))
@@ -109,12 +77,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, PFER = upperbound)
+                max = mm, cutoff = cutoff, q = q)
     class(ret) <- "stabsel"
     ret
 }
 
-print.stabsel <- function(x, decreasing = FALSE, ...) {
+print.stabsel <- function(x, ...) {
 
     cat("\tStability Selection\n")
     if (length(x$selected) > 0) {
@@ -124,10 +92,9 @@
         cat("\nNo base-learner selected\n")
     }
     cat("\nSelection probabilities:\n")
-    print(sort(x$max[x$max > 0], decreasing = decreasing))
+    print(x$max[x$max > 0])
     cat("\nCutoff: ", x$cutoff, "; ", sep = "")
-    cat("q: ", x$q, "; ", sep = "")
-    cat("PFER: ", x$PFER, "\n\n")
+    cat("q: ", x$q, "\n\n")
     invisible(x)
 }
 

Modified: pkg/mboostPatch/man/stabsel.Rd
===================================================================
--- pkg/mboostPatch/man/stabsel.Rd	2013-09-03 18:59:14 UTC (rev 729)
+++ pkg/mboostPatch/man/stabsel.Rd	2013-09-05 14:16:13 UTC (rev 730)
@@ -7,18 +7,15 @@
     Selection of influential variables or model components with error control.
 }
 \usage{
-stabsel(object, cutoff, q, PFER,
+stabsel(object, FWER = 0.05, cutoff, q,
         folds = cv(model.weights(object), type = "subsampling", B = 100),
-        papply = mclapply, verbose = TRUE, FWER, ...)
+        papply = mclapply, verbose = TRUE, ...)
 }
 \arguments{
   \item{object}{an \code{mboost} object.}
-  \item{cutoff}{cutoff between 0.5 and 1. Preferably a value between 0.6
-    and 0.9 should be used.}
-  \item{q}{number of (unique) selected base-learners per boosting run.}
-  \item{PFER}{upper bound for the per-family error rate. This
-    specifies the amount of falsely selected base-learners, which is
-    tolerated. See details.}
+  \item{FWER}{family-wise error rate to be controlled by the selection procedure.}
+  \item{cutoff}{cutoff between 0.5 and 1.}
+  \item{q}{average number of selected base-learners.}
   \item{folds}{ a weight matrix with number of rows equal to the number
                 of observations, see \code{\link{cvrisk}}.}
   \item{papply}{ (parallel) apply function, defaults to  \code{\link[parallel]{mclapply}}.
@@ -27,8 +24,6 @@
     details).}
   \item{verbose}{ logical (default: \code{TRUE}) that determines wether
     \code{warnings} should be issued. }
-  \item{FWER}{ deprecated. Only for compatibility with older versions,
-    use PFER instead.}
   \item{\dots}{additional arguments to \code{\link{cvrisk}}.}
 }
 \details{
@@ -36,15 +31,10 @@
   This function implements the "stability selection" procedure
   by Meinshausen and Buehlmann (2010).
 
-  Two of the three arguments \code{cutoff}, \code{q} and \code{PFER}
-  \emph{must} be specified. The expected number of false positives E(V), where
-  V is the number of false positives, is controlled by \code{PFER}.
+  Either \code{cutoff} or \code{q} must be specified. The probability
+  of selecting at least one non-influential variable (or model component)
+  is less than \code{FWER}.
 
-  As controlling the PFER is more conservative as controlling the
-  family-wise error rate (FWER), the procedure also controlls the FWER,
-  i.e., the probability of selecting at least one non-influential
-  variable (or model component) is less than \code{PFER}.
-
 }
 \value{
   An object of class \code{stabsel} with elements
@@ -53,9 +43,7 @@
   \item{max }{maximum of selection probabilities.}
   \item{cutoff }{cutoff used.}
   \item{q }{average number of selected variables used.}
-  \item{PFER }{per-family error rate.}
-
-  A special print method for objects of class exists.
+  \item{FWER }{family-wise error rate.}
 }
 \references{
 
@@ -68,10 +56,10 @@
 
   data(bodyfat)
 
-  ### low-dimensional example
+  ### (too) low-dimensional example
   mod <- glmboost(DEXfat ~ ., data = bodyfat)
-  (sbody <- stabsel(mod, q = 3, PFER = 1,
-                    folds = cv(model.weights(mod), type = "subsampling", B = 100)))
+  (sbody <- stabsel(mod, q = 3,
+                    folds = cv(model.weights(mod), type = "subsampling", B = 25)))
   opar <- par(mai = par("mai") * c(1, 1, 1, 2.7))
   plot(sbody)
   par(opar)

Modified: pkg/mboostPatch/tests/regtest-gamboost.R
===================================================================
--- pkg/mboostPatch/tests/regtest-gamboost.R	2013-09-03 18:59:14 UTC (rev 729)
+++ pkg/mboostPatch/tests/regtest-gamboost.R	2013-09-05 14:16:13 UTC (rev 730)
@@ -1,5 +1,6 @@
 
 require("mboost")
+require("survival")
 
 set.seed(290875)
 
@@ -138,7 +139,6 @@
 stopifnot(max(abs(predict(mod1, newdata = tmp) - predict(mod2, newdata = tmp)))  < sqrt(.Machine$double.eps))
 
 ## Cox model
-
 fit2 <- gamboost(Surv(futime, fustat) ~ bbs(age) +
     bols(resid.ds) + bols(rx) + bols(ecog.ps), data = ovarian,
     family = CoxPH(), control = boost_control(mstop = 1000))

Modified: svn_release.txt
===================================================================
--- svn_release.txt	2013-09-03 18:59:14 UTC (rev 729)
+++ svn_release.txt	2013-09-05 14:16:13 UTC (rev 730)
@@ -1,7 +1,7 @@
 
   ############################################################
   #  Standard operating procedures for `mboost' development  #
-  ############################################################ 
+  ############################################################
 
 
   Structure of the repository
@@ -31,12 +31,15 @@
     R CMD build --resave-data --compact-vignettes pkg/mboostPatch
     R CMD check --as-cran mboost_XXX.tar.gz
 
+    Run check with R-devel
+    (see section "Checking the package with latest development verstion of R")
+
     If differences to .Rout.save occure:
        - Manually check differences. You might want to use something like:
-            
+
         cd mboost.Rcheck/tests
 	    meld Examples/mboost-Ex.Rout.save ../mboost-Ex.Rout &
-	or 
+	or
 	    meld regtest-XXX.Rout.save regtest-XXX.Rout &
 
        - If ok, copy new .Rout files to .Rout.save:
@@ -47,9 +50,9 @@
 
             Rscript copy_Rout_to_Routsave.R "which='mboostPatch'" "vignettes=TRUE"
 
-	 For details see 
+	 For details see
          http://r.789695.n4.nabble.com/Generate-Rout-save-files-for-vignettes-td4652752.html
-    
+
     Gives no warnings / errors.
 
     Commit changes to pkg/mboostPatch/
@@ -87,6 +90,9 @@
     R CMD build --resave-data --compact-vignettes pkg/mboostDevel
     R CMD check --as-cran mboostDevel_XXX.tar.gz
 
+    Run check with R-devel
+    (see section "Checking the package with latest development verstion of R")
+
     If differences to .Rout.save occure:
        - Manually check differences
        - If ok, copy new .Rout files to .Rout.save:
@@ -97,7 +103,7 @@
 
             Rscript copy_Rout_to_Routsave.R "which='mboostDevel'" "vignettes=TRUE"
 
-	 For details see 
+	 For details see
          http://r.789695.n4.nabble.com/Generate-Rout-save-files-for-vignettes-td4652752.html
 
     Gives no warnings / errors.
@@ -108,8 +114,11 @@
         - Replace all occurences of mboostDevel with mboost:
 	     R CMD BATCH change_mboostDevel_to_mboost.R
 	     cat change_mboostDevel_to_mboost.Rout
-	- Run build and check again on mboost_XXX
-	  (*not* mboostDevel this time!)
+	- Run build and check again on mboost_XXX (*not* mboostDevel this time!)
+	  Build package without test folder to be submitted to CRAN
+	     R CMD buildCRAN --resave-data --compact-vignettes pkg/mboostPatch
+       	     R CMD check --as-cran mboost_XXX.tar.gz
+
 	- ATTENTION: Do NOT commit the new, modified files to mboostDevel
 	  	     (only to mboostPatch and CRAN)
 
@@ -133,3 +142,21 @@
     cd mboost
     svn copy pkg/mboostDevel ng/mboost_XXX
 
+
+  Checking the package with latest development verstion of R
+  ----------------------------------------------------------
+
+  Get source from
+    ftp://ftp.stat.math.ethz.ch/Software/R/
+
+  UnTar and install according to guide in INSTALL (source directory).
+
+  Go to mboost directory and call
+    ../relative/path/to/R-devel/bin/R
+
+  Run
+    install.packages(c("party", "TH.data", "fields", "BayesX", "gbm", "mlbench", "RColorBrewer"))
+
+  Quite R and run
+   ../relative/path/to/R-devel/bin/R CMD check --as-cran mboost_XXX.tar.gz
+



More information about the Mboost-commits mailing list