[Mboost-commits] r726 - in pkg/mboostPatch: R man tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Aug 27 18:51:46 CEST 2013
Author: hofner
Date: 2013-08-27 18:51:46 +0200 (Tue, 27 Aug 2013)
New Revision: 726
Modified:
pkg/mboostPatch/R/family.R
pkg/mboostPatch/R/methods.R
pkg/mboostPatch/man/methods.Rd
pkg/mboostPatch/tests/regtest-family.R
Log:
- fixed bug in Binomial("probit"): link name wasn't returned
- added variable.names to manual
- added extract(..., what = "variable.names")
- added experimental NOTE that coef() from Binomial models is only half the size of standard models
Modified: pkg/mboostPatch/R/family.R
===================================================================
--- pkg/mboostPatch/R/family.R 2013-08-16 11:09:50 UTC (rev 725)
+++ pkg/mboostPatch/R/family.R 2013-08-27 16:51:46 UTC (rev 726)
@@ -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 = ""))
Modified: pkg/mboostPatch/R/methods.R
===================================================================
--- pkg/mboostPatch/R/methods.R 2013-08-16 11:09:50 UTC (rev 725)
+++ pkg/mboostPatch/R/methods.R 2013-08-27 16:51:46 UTC (rev 726)
@@ -54,6 +54,11 @@
args <- list(...)
if (length(args) > 0)
warning("Arguments ", paste(names(args), sep = ", "), " unknown")
+ if (grepl("Negative Binomial Likelihood", Binomial("probit")@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)
}
@@ -265,6 +270,11 @@
if (length(args) > 0)
warning("Arguments ", paste(names(args), sep = ", "), " unknown")
+ if (grepl("Negative Binomial Likelihood", Binomial("probit")@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)
@@ -445,7 +455,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)
@@ -457,25 +468,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))
@@ -491,29 +497,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, ...)
Modified: pkg/mboostPatch/man/methods.Rd
===================================================================
--- pkg/mboostPatch/man/methods.Rd 2013-08-16 11:09:50 UTC (rev 725)
+++ pkg/mboostPatch/man/methods.Rd 2013-08-27 16:51:46 UTC (rev 726)
@@ -24,6 +24,9 @@
\alias{residuals.mboost}
\alias{resid.mboost}
+\alias{variable.names.glmboost}
+\alias{variable.names.mboost}
+
\alias{extract}
\alias{extract.mboost}
\alias{extract.gamboost}
@@ -58,7 +61,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, ...)
@@ -70,27 +73,31 @@
\method{mstop}{cvrisk}(object, ...)
\method{predict}{mboost}(object, newdata = NULL,
- type = c("link", "response", "class"), which = NULL,
- aggregate = c("sum", "cumsum", "none"), ...)
+ type = c("link", "response", "class"), which = NULL,
+ aggregate = c("sum", "cumsum", "none"), ...)
\method{predict}{glmboost}(object, newdata = NULL,
- type = c("link", "response", "class"), which = NULL,
- aggregate = c("sum", "cumsum", "none"), ...)
+ type = c("link", "response", "class"), which = NULL,
+ aggregate = c("sum", "cumsum", "none"), ...)
\method{fitted}{mboost}(object, ...)
\method{residuals}{mboost}(object, ...)
\method{resid}{mboost}(object, ...)
+\method{variable.names}{glmboost}(object, ...)
+\method{variable.names}{mboost}(object, ...)
+
\method{extract}{mboost}(object, what = c("design", "penalty", "lambda", "df",
- "coefficients", "residuals", "bnames", "offset",
- "nuisance", "weights", "index", "control"),
- which = NULL, ...)
+ "coefficients", "residuals",
+ "variable.names", "bnames", "offset",
+ "nuisance", "weights", "index", "control"),
+ which = NULL, ...)
\method{extract}{glmboost}(object, what = c("design", "coefficients", "residuals",
- "bnames", "offset", "nuisance",
- "weights", "control"),
- which = NULL, asmatrix = FALSE, ...)
+ "variable.names", "bnames", "offset",
+ "nuisance", "weights", "control"),
+ which = NULL, asmatrix = FALSE, ...)
\method{extract}{blg}(object, what = c("design", "penalty", "index"),
- asmatrix = FALSE, expand = FALSE, ...)
+ asmatrix = FALSE, expand = FALSE, ...)
\method{logLik}{mboost}(object, ...)
\method{hatvalues}{gamboost}(model, ...)
@@ -157,7 +164,8 @@
\code{"penalty"} (penalty matrix),
\code{"lambda"} (smoothing parameter), \code{"df"}
(degrees of freedom), \code{"coefficients"},
- \code{"residuals"}, \code{"bnames"} (names of the base-learners),
+ \code{"residuals"}, \code{"variable.names"},
+ \code{"bnames"} (names of the base-learners),
\code{"offset"}, \code{"nuisance"}, \code{"weights"},
\code{"index"} (index of ties used to expand the design
matrix) and \code{"control"}. In future versions additional
@@ -220,18 +228,24 @@
to the object via \code{attr(..., "offset")} as adding the offset to
one of the marginal predictions doesn't make much sense.
+ The \code{[.mboost} function can be used to enhance or restrict a
+ given boosting model to the specified boosting iteration \code{i}.
+ Note that in both cases the original \code{x} will be changed to
+ reduce the memory footprint (see also Note below). If the boosting
+ model is enhanced by specifying an index that is larger than the
+ initial \code{mstop}, only the missing \code{i - mstop} steps are
+ fitted. If the model is restricted, the spare steps are not dropped,
+ i.e., if we increase \code{i} again, these boosting steps are
+ immediately available.
+
The \code{residuals} function can be used to extract the residuals
(i.e., the negative gradient of the current iteration). \code{resid}
is is an alias for \code{residuals}.
- The \code{[.mboost} function can be used to enhance or restrict a given
- boosting model to the specified boosting iteration \code{i}. Note that
- in both cases the original \code{x} will be changed to reduce the
- memory footprint. If the boosting model is enhanced by specifying an
- index that is larger than the initial \code{mstop}, only the missing
- \code{i - mstop} steps are fitted. If the model is restricted, the
- spare steps are not dropped, i.e., if we increase \code{i} again,
- these boosting steps are immediately available.
+ Variable names (including those of interaction effects specified via
+ \code{by} in a base-learner) can be extracted using the generic
+ function \code{variable.names}, which has special methods for boosting
+ objects.
The generic \code{extract} function can be used to extract various
characteristics of a fitted model or a base-learner. Note that the
@@ -414,6 +428,10 @@
extract(model, what = "lambda", which = "x1") # df and corresponding lambda for x1
## note that bols(x1, intercept = FALSE) is unpenalized
+ extract(model, what = "bnames") ## name of complete base-learner
+ extract(model, what = "variable.names") ## only variable names
+ variable.names(model) ## the same
+
### extract from base-learners
extract(bbs(x1), what = "design")
extract(bbs(x1), what = "penalty")
Modified: pkg/mboostPatch/tests/regtest-family.R
===================================================================
--- pkg/mboostPatch/tests/regtest-family.R 2013-08-16 11:09:50 UTC (rev 725)
+++ pkg/mboostPatch/tests/regtest-family.R 2013-08-27 16:51:46 UTC (rev 726)
@@ -182,3 +182,16 @@
## different pre-processing? </FIXME>
round(coef(modWeighted) - coef(modSubset), 3)
}
+
+## Binomial
+y <- as.factor(sample(0:1, 100, replace = TRUE))
+x1 <- rnorm(100)
+x2 <- rnorm(100)
+
+mod <- glmboost(y ~ x1 + x2, family = Binomial())
+mod[500]
+coef(mod)
+
+glmMod <- glm(y ~ x1 + x2, family = 'binomial')
+coef(glmMod)
+stopifnot(all((coef(glmMod) - coef(mod, off2int = TRUE) * 2) < .Machine$double.eps))
More information about the Mboost-commits
mailing list