[Mboost-commits] r762 - in pkg/mboostDevel: R man tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Feb 20 19:48:44 CET 2014
Author: hofner
Date: 2014-02-20 19:48:44 +0100 (Thu, 20 Feb 2014)
New Revision: 762
Modified:
pkg/mboostDevel/R/inference.R
pkg/mboostDevel/R/mboost.R
pkg/mboostDevel/R/methods.R
pkg/mboostDevel/man/stabsel.Rd
pkg/mboostDevel/tests/regtest-inference.R
Log:
- stabsel:
* implemented "unimodal" error bound
* added new option assumption = c("unimodal", "r-concave", "none")
* renamed error.bound to sampling.type
- Bugfix: mod$which() returned not all base-learners
Modified: pkg/mboostDevel/R/inference.R
===================================================================
--- pkg/mboostDevel/R/inference.R 2014-02-13 11:00:34 UTC (rev 761)
+++ pkg/mboostDevel/R/inference.R 2014-02-20 18:48:44 UTC (rev 762)
@@ -1,20 +1,27 @@
stabsel <- function(object, cutoff, q, PFER,
folds = cv(model.weights(object), type = "subsampling",
- B = ifelse(error.bound == "MB", 100, 50)),
- papply = mclapply, verbose = TRUE, FWER,
- error.bound = c("MB", "SS"), ...) {
+ B = ifelse(sampling.type == "MB", 100, 50)),
+ assumption = c("unimodal", "r-concave", "none"),
+ sampling.type = c("SS", "MB"),
+ papply = mclapply, verbose = TRUE, FWER, ...) {
call <- match.call()
p <- length(variable.names(object))
ibase <- 1:p
- error.bound <- match.arg(error.bound)
+ sampling.type <- match.arg(sampling.type)
+ if (sampling.type == "MB")
+ assumption <- "none"
+ else
+ assumption <- match.arg(assumption)
+
B <- ncol(folds)
pars <- stabsel_parameters(cutoff = cutoff, q = q,
PFER = PFER, p = p, B = B,
- verbose = verbose, error.bound = error.bound)
+ verbose = verbose, sampling.type = sampling.type,
+ assumption = assumption)
cutoff <- pars$cutoff
q <- pars$q
PFER <- pars$PFER
@@ -25,7 +32,7 @@
xs[qq > q] <- xs[1]
xs
}
- if (error.bound == "SS") {
+ if (sampling.type == "SS") {
## use complementary pairs
folds <- cbind(folds, model.weights(object) - folds)
}
@@ -63,19 +70,26 @@
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 = PFER, error.bound = error.bound,
+ max = mm, cutoff = cutoff, q = q, PFER = PFER,
+ sampling.type = sampling.type, assumption = assumption,
call = call)
class(ret) <- "stabsel"
ret
}
stabsel_parameters <- function(cutoff, q, PFER, p,
- B = ifelse(error.bound == "MB", 100, 50),
- verbose = FALSE, error.bound = c("MB", "SS"),
- FWER) {
+ B = ifelse(sampling.type == "MB", 100, 50),
+ assumption = c("unimodal", "r-concave", "none"),
+ sampling.type = c("SS", "MB"),
+ verbose = FALSE, FWER) {
- error.bound <- match.arg(error.bound)
+ sampling.type <- match.arg(sampling.type)
+ if (sampling.type == "MB")
+ assumption <- "none"
+ else
+ assumption <- match.arg(assumption)
+
## only two of the four arguments can be specified
if ((nmiss <- sum(missing(PFER), missing(cutoff),
missing(q), missing(FWER))) != 2) {
@@ -115,12 +129,19 @@
}
if (missing(cutoff)) {
- if (error.bound == "MB") {
+ if (assumption == "none") {
cutoff <- min(1, tmp <- (q^2 / (PFER * p) + 1) / 2)
upperbound <- q^2 / p / (2 * cutoff - 1)
} else {
- cutoff <- optimal_cutoff(p, q, PFER, B)
- upperbound <- tmp <- minD(q, p, cutoff, B) * p
+ if (assumption == "unimodal") {
+ cutoff <- tmp <- optimal_cutoff(p, q, PFER, B,
+ assumption = assumption)
+ upperbound <- q^2 / p / um_const(cutoff, B, theta = q/p)
+ } else {
+ cutoff <- tmp <- optimal_cutoff(p, q, PFER, B,
+ assumption = assumption)
+ upperbound <- minD(q, p, cutoff, B) * p
+ }
}
upperbound <- signif(upperbound, 3)
if (verbose && tmp > 0.9 && upperbound - PFER > PFER/2) {
@@ -131,12 +152,17 @@
}
if (missing(q)) {
- if (error.bound == "MB") {
+ if (assumption == "none") {
q <- floor(sqrt(PFER * (2 * cutoff - 1) * p))
upperbound <- q^2 / p / (2 * cutoff - 1)
} else {
- q <- optimal_q(p, cutoff, PFER, B)
- upperbound <- minD(q, p, cutoff, B) * p
+ if (assumption == "unimodal") {
+ q <- optimal_q(p, cutoff, PFER, B, assumption = assumption)
+ upperbound <- q^2 / p / um_const(cutoff, B, theta = q/p)
+ } else {
+ q <- optimal_q(p, cutoff, PFER, B, assumption = assumption)
+ upperbound <- minD(q, p, cutoff, B) * p
+ }
}
upperbound <- signif(upperbound, 3)
if (verbose && upperbound - PFER > PFER/2)
@@ -146,10 +172,14 @@
}
if (missing(PFER)) {
- if (error.bound == "MB") {
+ if (assumption == "none") {
upperbound <- PFER <- q^2 / p / (2 * cutoff - 1)
} else {
- upperbound <- PFER <- minD(q, p, cutoff, B) * p
+ if (assumption == "unimodal") {
+ upperbound <- PFER <- q^2 / p / um_const(cutoff, B, theta = q/p)
+ } else {
+ upperbound <- PFER <- minD(q, p, cutoff, B) * p
+ }
}
upperbound <- signif(upperbound, 3)
}
@@ -158,14 +188,20 @@
warning("Upper bound for PFER larger than the number of base-learners.")
res <- list(cutoff = cutoff, q = q, PFER = upperbound,
- error.bound = error.bound)
+ sampling.type = sampling.type, assumption = assumption)
class(res) <- "stabsel_parameters"
res
}
print.stabsel <- function(x, decreasing = FALSE, ...) {
- cat("\tStability Selection\n")
+ cat("\tStability Selection")
+ if (x$assumption == "none")
+ cat(" without further assumptions\n")
+ if (x$assumption == "unimodal")
+ cat(" with unimodality assumption\n")
+ if (x$assumption == "r-concave")
+ cat(" with r-concavity assumption\n")
if (length(x$selected) > 0) {
cat("\nSelected base-learners:\n")
print(x$selected)
@@ -175,15 +211,24 @@
cat("\nSelection probabilities:\n")
print(sort(x$max[x$max > 0], decreasing = decreasing))
cat("\n")
- print.stabsel_parameters(x)
+ print.stabsel_parameters(x, heading = FALSE)
cat("\n")
invisible(x)
}
-print.stabsel_parameters <- function(x, ...) {
+print.stabsel_parameters <- function(x, heading = TRUE, ...) {
+ if (heading) {
+ cat("Stability Selection")
+ if (x$assumption == "none")
+ cat(" without further assumptions\n")
+ if (x$assumption == "unimodal")
+ cat(" with unimodality assumption\n")
+ if (x$assumption == "r-concave")
+ cat(" with r-concavity assumption\n")
+ }
cat("Cutoff: ", x$cutoff, "; ", sep = "")
cat("q: ", x$q, "; ", sep = "")
- if (x$error.bound == "MB")
+ if (x$sampling.type == "MB")
cat("PFER: ", x$PFER, "\n")
else
cat("PFER(*): ", x$PFER,
@@ -290,32 +335,59 @@
min(c(1, D(q^2 / p^2, which - B, B, r[1]), D(q / p, which , 2*B, r[2])))
}
-## function to find optimal cutoff in stabsel (when error.bound = "SS")
-optimal_cutoff <- function(p, q, PFER, B) {
- ## cutoff values can only be multiples of 1/(2B)
- cutoff <- (2*B):1/(2*B)
- cutoff <- cutoff[cutoff >= 0.5]
- for (i in 1:length(cutoff)) {
- if (minD(q, p, cutoff[i], B) * p > PFER) {
- if (i == 1)
- cutoff <- cutoff[i]
- else
- cutoff <- cutoff[i - 1]
- break
+## function to find optimal cutoff in stabsel (when sampling.type = "SS")
+optimal_cutoff <- function(p, q, PFER, B, assumption = "unimodal") {
+ if (assumption == "unimodal") {
+ ## cutoff values can only be multiples of 1/(2B)
+ cutoffgrid <- 1/2 + (2:B)/(2*B)
+ c_min <- min(0.5 + (q/p)^2, 0.5 + 1/(2*B) + 0.75 * (q/p)^2)
+ cutoffgrid <- cutoffgrid[cutoffgrid > c_min]
+ upperbound <- rep(NA, length(cutoffgrid))
+ for (i in 1:length(cutoffgrid))
+ upperbound[i] <- q^2 / p / um_const(cutoffgrid[i], B, theta = q/p)
+ cutoff <- cutoffgrid[upperbound < PFER][1]
+ return(cutoff)
+ } else {
+ ## cutoff values can only be multiples of 1/(2B)
+ cutoff <- (2*B):1/(2*B)
+ cutoff <- cutoff[cutoff >= 0.5]
+ for (i in 1:length(cutoff)) {
+ if (minD(q, p, cutoff[i], B) * p > PFER) {
+ if (i == 1)
+ cutoff <- cutoff[i]
+ else
+ cutoff <- cutoff[i - 1]
+ break
+ }
}
+ return(tail(cutoff, 1))
}
- cutoff[length(cutoff)]
}
-## function to find optimal q in stabsel (when error.bound = "SS")
-optimal_q <- function(p, cutoff, PFER, B) {
- for (q in 1:maxQ(p, B)) {
- if (minD(q, p, cutoff, B) * p > PFER) {
- q <- q - 1
- break
+## function to find optimal q in stabsel (when sampling.type = "SS")
+optimal_q <- function(p, cutoff, PFER, B, assumption = "unimodal") {
+ if (assumption == "unimodal") {
+ if (cutoff <= 0.75) {
+ upper_q <- max(p * sqrt(cutoff - 0.5),
+ p * sqrt(4/3 * (cutoff - 0.5 - 1/(2*B))))
+ ## q must be an integer < upper_q
+ upper_q <- ceiling(upper_q - 1)
+ } else {
+ upper_q <- p
}
+ q <- uniroot(function(q)
+ q^2 / p / um_const(cutoff, B, theta = q/p) - PFER,
+ lower = 1, upper = upper_q)$root
+ return(floor(q))
+ } else {
+ for (q in 1:maxQ(p, B)) {
+ if (minD(q, p, cutoff, B) * p > PFER) {
+ q <- q - 1
+ break
+ }
+ }
+ return(max(1, q))
}
- max(1, q)
}
## obtain maximal value possible for q
@@ -330,3 +402,16 @@
res <- tmpfct(1:p)
length(res[res < 0])
}
+
+## obtain constant for unimodal bound
+um_const <- function(cutoff, B, theta) {
+ if (cutoff <= 3/4) {
+ if (cutoff < 1/2 + min(theta^2, 1 / (2*B) + 3/4 * theta^2))
+ stop ("cutoff out of bounds")
+ return( 2 * (2 * cutoff - 1 - 1/(2*B)) )
+ } else {
+ if (cutoff > 1)
+ stop ("cutoff out of bounds")
+ return( (1 + 1/B)/(4 * (1 - cutoff + 1 / (2*B))) )
+ }
+}
Modified: pkg/mboostDevel/R/mboost.R
===================================================================
--- pkg/mboostDevel/R/mboost.R 2014-02-13 11:00:34 UTC (rev 761)
+++ pkg/mboostDevel/R/mboost.R 2014-02-20 18:48:44 UTC (rev 762)
@@ -200,7 +200,7 @@
### figure out which baselearners are requested
thiswhich <- function(which = NULL, usedonly = FALSE) {
- if (is.null(which)) which <- 1:max(RET$xselect())
+ if (is.null(which)) which <- 1:length(bnames)
if (is.character(which)) {
i <- sapply(which, function(w) {
wi <- grep(w, bnames, fixed = TRUE)
Modified: pkg/mboostDevel/R/methods.R
===================================================================
--- pkg/mboostDevel/R/methods.R 2014-02-13 11:00:34 UTC (rev 761)
+++ pkg/mboostDevel/R/methods.R 2014-02-20 18:48:44 UTC (rev 762)
@@ -424,7 +424,7 @@
which <- c(intercept, which)
}
} else {
- which <- object$which(which)
+ which <- object$which(which, usedonly = usedonly)
}
args <- list(...)
Modified: pkg/mboostDevel/man/stabsel.Rd
===================================================================
--- pkg/mboostDevel/man/stabsel.Rd 2014-02-13 11:00:34 UTC (rev 761)
+++ pkg/mboostDevel/man/stabsel.Rd 2014-02-20 18:48:44 UTC (rev 762)
@@ -10,16 +10,18 @@
\usage{
stabsel(object, cutoff, q, PFER,
folds = cv(model.weights(object), type = "subsampling",
- B = ifelse(error.bound == "MB", 100, 50)),
- papply = mclapply, verbose = TRUE, FWER,
- error.bound = c("MB", "SS"), ...)
+ B = ifelse(sampling.type == "MB", 100, 50)),
+ assumption = c("unimodal", "r-concave", "none"),
+ sampling.type = c("SS", "MB"),
+ papply = mclapply, verbose = TRUE, FWER, ...)
## function to compute missing parameter from the other two parameters
## (internally used within stabsel)
stabsel_parameters(cutoff, q, PFER, p,
- B = ifelse(error.bound == "MB", 100, 50),
- verbose = FALSE, error.bound = c("MB", "SS"),
- FWER)
+ B = ifelse(sampling.type == "MB", 100, 50),
+ assumption = c("unimodal", "r-concave", "none"),
+ sampling.type = c("SS", "MB"),
+ verbose = FALSE, FWER)
}
\arguments{
\item{object}{an \code{mboost} object.}
@@ -31,33 +33,43 @@
tolerated. See details.}
\item{folds}{ a weight matrix with number of rows equal to the number
of observations, see \code{\link{cvrisk}}.}
- \item{B}{ number of subsampling replicates. Per default, this is 100
- for the error bound derived in Meinshausen & Buehlmann (2010) and
- 50 for the error bound of Shah & Samworth (2013). In the latter
- case, complementray pairs are used, thus leading to \eqn{2B}
- subsamples.}
+ \item{assumption}{ Defines the type of assumptions on the
+ distributions of the selection probabilities and simultaneous
+ selection probabilities. Only applicable for
+ \code{sampling.type = "SS"}. For \code{sampling.type = "MB"} we
+ always use code{"none"}.}
+ \item{sampling.type}{ use sampling scheme of of Shah & Samworth
+ (2013), i.e., with complementarty pairs (\code{sampling.type = "SS"}),
+ or the original sampling scheme of Meinshausen & Buehlmann (2010).}
\item{p}{ number of possible predictors (including intercept if
- applicable) }.
- \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).}
+ applicable).}
+ \item{B}{ number of subsampling replicates. Per default, we use 50
+ complementary pairs for the error bounds of Shah & Samworth (2013)
+ and 100 for the error bound derived in Meinshausen & Buehlmann
+ (2010). As we use \eqn{B} complementray pairs in the former case
+ this leads to \eqn{2B} subsamples.}
+ \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 of \code{\link{cvrisk}} for some 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{error.bound}{ use error bound of Meinshausen & Buehlmann (2010)
- ("MB") or of Shah & Samworth (2013) ("SS"). }
- \item{\dots}{additional arguments to \code{\link{cvrisk}}.}
+ \item{\dots}{additional arguments to \code{\link{cvrisk}} and
+ further arguments to parallel apply methods such as
+ \code{\link{mclapply}}.}
}
\details{
- This function implements the "stability selection" procedure
- by Meinshausen and Buehlmann (2010).
+ This function implements the stability selection procedure
+ by Meinshausen and Buehlmann (2010) and the improved error bounds by
+ Shah and Samworth (2013).
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}.
+ \emph{must} be specified. The per-family error rate (PFER), i.e., the
+ expected number of false positives \eqn{E(V)}, where \eqn{V} is the
+ number of false positives, is bounded by the argument \code{PFER}.
As controlling the PFER is more conservative as controlling the
family-wise error rate (FWER), the procedure also controlls the FWER,
@@ -66,18 +78,23 @@
}
\value{
- An object of class \code{stabsel} with elements
- \item{phat }{selection probabilities.}
- \item{selected }{elements with maximal selection probability greater \code{cutoff}.}
- \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.
+ An object of class \code{stabsel} with a special \code{print} method.
+ The object has the following elements:
+ \item{phat}{selection probabilities.}
+ \item{selected}{elements with maximal selection probability greater
+ \code{cutoff}.}
+ \item{max}{maximum of selection probabilities.}
+ \item{cutoff}{cutoff used.}
+ \item{q}{average number of selected variables used.}
+ \item{PFER}{per-family error rate.}
+ \item{sampling.type}{the sampling type used for stability selection.}
+ \item{assumption}{the assumptions made on the selection
+ probabilities.}
+ \item{call}{the call.}
}
\references{
+
N. Meinshausen and P. Buehlmann (2010), Stability selection.
\emph{Journal of the Royal Statistical Society, Series B},
\bold{72}:417--473.
@@ -97,11 +114,12 @@
## compute cutoff ahead of running stabsel to see if it is a sensible
## parameter choice.
## p = ncol(bodyfat) - 1 (= Outcome) + 1 ( = Intercept)
- stabsel_parameters(q = 3, PFER = 1, p = ncol(bodyfat) - 1 + 1)
+ stabsel_parameters(q = 3, PFER = 1, p = ncol(bodyfat) - 1 + 1,
+ sampling.type = "MB")
## now run stability selection; to make results reproducible
set.seed(1234)
- (sbody <- stabsel(mod, q = 3, PFER = 1))
+ (sbody <- stabsel(mod, q = 3, PFER = 1, sampling.type = "MB"))
opar <- par(mai = par("mai") * c(1, 1, 1, 2.7))
plot(sbody)
par(opar)
Modified: pkg/mboostDevel/tests/regtest-inference.R
===================================================================
--- pkg/mboostDevel/tests/regtest-inference.R 2014-02-13 11:00:34 UTC (rev 761)
+++ pkg/mboostDevel/tests/regtest-inference.R 2014-02-20 18:48:44 UTC (rev 762)
@@ -120,39 +120,52 @@
PFER <- 0.2
B <- 50
p <- 200
-(q <- optimal_q(p = p, cutoff = cutoff, PFER = PFER, B = B))
+(q <- optimal_q(p = p, cutoff = cutoff, PFER = PFER, B = B,
+ assumption = "r-concave"))
# check:
-round(minD(q, p, cutoff, B) * p, 3)
-round(minD(q + 1, p, cutoff, B) * p, 3)
+(a <- round(minD(q, p, cutoff, B) * p, 3))
+(b <- round(minD(q + 1, p, cutoff, B) * p, 3))
+stopifnot(a < PFER && b > PFER)
+## same for unimodal bound
+(q <- optimal_q(p = p, cutoff = cutoff, PFER = PFER, B = B,
+ assumption = "unimodal"))
### computation of cutoff from other values
PFER <- 0.2
B <- 50
p <- 200
q <- 7
-(cutoff <- optimal_cutoff(p = p, q = q, PFER = PFER, B = B))
+(cutoff <- optimal_cutoff(p = p, q = q, PFER = PFER, B = B,
+ assumption = "r-concave"))
# check:
-round(minD(q, p, cutoff, B) * p, 3)
-round(minD(q, p, cutoff - 1e-2, B) * p, 3)
+(a <- round(minD(q, p, cutoff, B) * p, 3))
+(b <- round(minD(q, p, cutoff - 1e-2, B) * p, 3))
+stopifnot(a < PFER && b > PFER)
+## same for unimodal bound
+(cutoff <- optimal_cutoff(p = p, q = q, PFER = PFER, B = B,
+ assumption = "unimodal"))
### check stabsel interface
data("bodyfat", package = "TH.data")
mod <- glmboost(DEXfat ~ ., data = bodyfat)
-(sbody <- stabsel(mod, q = 3, PFER = 0.2))
+(sbody <- stabsel(mod, q = 3, PFER = 0.2, sampling.type = "MB"))
dim(sbody$phat)
-(sbody <- stabsel(mod, q = 3, PFER = 0.2, error.bound = "SS"))
+(sbody <- stabsel(mod, q = 3, PFER = 0.2, sampling.type = "SS"))
dim(sbody$phat)
## check stabsel_parameters and (theoretical) error control
cutoff <- 0.6
for (i in 1:10) {
- print(stabsel_parameters(cutoff = cutoff, q = i, p = 100, error.bound = "MB"))
+ print(stabsel_parameters(cutoff = cutoff, q = i, p = 100, sampling.type = "MB"))
}
for (i in 1:10) {
- print(stabsel_parameters(cutoff = cutoff, q = i, p = 100, error.bound = "SS"))
+ print(stabsel_parameters(cutoff = cutoff, q = i, p = 100, sampling.type = "SS",
+ assumption = "unimodal"))
+ print(stabsel_parameters(cutoff = cutoff, q = i, p = 100, sampling.type = "SS",
+ assumption = "r-concave"))
}
## check if missing values are determined correctly (especially at the extreme values)
@@ -161,30 +174,44 @@
cutoff <- 0.6
# low PFER
PFER <- 0.001
-(res <- stabsel_parameters(p = p, cutoff = cutoff, PFER = PFER, B = B, error.bound = "SS"))
-stabsel_parameters(p = p, cutoff = cutoff, q = res$q, B = B, error.bound = "SS")
+(res <- stabsel_parameters(p = p, cutoff = cutoff, PFER = PFER, B = B,
+ sampling.type = "SS", assumption = "r-concave"))
+stabsel_parameters(p = p, cutoff = cutoff, q = res$q, B = B,
+ sampling.type = "SS", assumption = "r-concave")
# high PFER
PFER <- 50
-(res <- stabsel_parameters(p = p, cutoff = cutoff, PFER = PFER, B = B, error.bound = "SS"))
-stabsel_parameters(p = p, cutoff = cutoff, q = res$q, B = B, error.bound = "SS")
+(res <- stabsel_parameters(p = p, cutoff = cutoff, PFER = PFER, B = B,
+ sampling.type = "SS", assumption = "r-concave"))
+stabsel_parameters(p = p, cutoff = cutoff, q = res$q, B = B,
+ sampling.type = "SS", assumption = "r-concave")
# medium PFER
PFER <- 1
-(res <- stabsel_parameters(p = p, cutoff = cutoff, PFER = PFER, B = B, error.bound = "SS"))
-stabsel_parameters(p = p, cutoff = cutoff, q = res$q, B = B, error.bound = "SS")
-stabsel_parameters(p = p, cutoff = cutoff, q = res$q + 1, B = B, error.bound = "SS")
+(res <- stabsel_parameters(p = p, cutoff = cutoff, PFER = PFER, B = B,
+ sampling.type = "SS", assumption = "r-concave"))
+stabsel_parameters(p = p, cutoff = cutoff, q = res$q, B = B,
+ sampling.type = "SS", assumption = "r-concave")
+stabsel_parameters(p = p, cutoff = cutoff, q = res$q + 1, B = B,
+ sampling.type = "SS", assumption = "r-concave")
q <- 10
# high PFER
PFER <- 5
-(res <- stabsel_parameters(p = p, q = q, PFER = PFER, B = B, error.bound = "SS"))
-stabsel_parameters(p = p, cutoff = res$cutoff, q = q, B = B, error.bound = "SS")
+(res <- stabsel_parameters(p = p, q = q, PFER = PFER, B = B,
+ sampling.type = "SS", assumption = "r-concave"))
+stabsel_parameters(p = p, cutoff = res$cutoff, q = q, B = B,
+ sampling.type = "SS", assumption = "r-concave")
# low PFER
PFER <- 0.001
-(res <- stabsel_parameters(p = p, q = q, PFER = PFER, B = B, error.bound = "SS"))
-stabsel_parameters(p = p, cutoff = res$cutoff, q = q, B = B, error.bound = "SS")
+(res <- stabsel_parameters(p = p, q = q, PFER = PFER, B = B,
+ sampling.type = "SS", assumption = "r-concave"))
+stabsel_parameters(p = p, cutoff = res$cutoff, q = q, B = B,
+ sampling.type = "SS", assumption = "r-concave")
# medium PFER
PFER <- 1
-(res <- stabsel_parameters(p = p, q = q, PFER = PFER, B = B, error.bound = "SS"))
-stabsel_parameters(p = p, cutoff = res$cutoff, q = q, B = B, error.bound = "SS")
-stabsel_parameters(p = p, cutoff = res$cutoff - 0.01, q = q, B = B, error.bound = "SS")
+(res <- stabsel_parameters(p = p, q = q, PFER = PFER, B = B,
+ sampling.type = "SS", assumption = "r-concave"))
+stabsel_parameters(p = p, cutoff = res$cutoff, q = q, B = B,
+ sampling.type = "SS", assumption = "r-concave")
+stabsel_parameters(p = p, cutoff = res$cutoff - 0.01, q = q, B = B,
+ sampling.type = "SS", assumption = "r-concave")
More information about the Mboost-commits
mailing list