[Mboost-commits] r746 - in pkg/mboostDevel: R man tests

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Oct 8 15:29:02 CEST 2013


Author: hofner
Date: 2013-10-08 15:29:01 +0200 (Tue, 08 Oct 2013)
New Revision: 746

Modified:
   pkg/mboostDevel/R/bl.R
   pkg/mboostDevel/man/baselearners.Rd
   pkg/mboostDevel/tests/bugfixes.R
   pkg/mboostDevel/tests/regtest-baselearner.R
Log:
- added further arguments to brandom() which were currently only available via ...
- added check to brandom() that covariates are factors
- added according tests


Modified: pkg/mboostDevel/R/bl.R
===================================================================
--- pkg/mboostDevel/R/bl.R	2013-10-02 11:06:13 UTC (rev 745)
+++ pkg/mboostDevel/R/bl.R	2013-10-08 13:29:01 UTC (rev 746)
@@ -278,13 +278,13 @@
         }
         if (!identical(args$center, FALSE)) {
             tmp <- attributes(X)[c("degree", "knots", "Boundary.knots")]
-            center <- match.arg(as.character(args$center), 
+            center <- match.arg(as.character(args$center),
                                 choices = c("TRUE", "differenceMatrix", "spectralDecomp"))
             if (center == "TRUE") center <- "differenceMatrix"
-            X <- switch(center, 
+            X <- switch(center,
                 ### L = t(D) in Section 2.3. of Fahrmeir et al. (2004, Stat Sinica)
                 "differenceMatrix" = tcrossprod(X, K) %*% solve(tcrossprod(K)),
-                ### L = \Gamma \Omega^1/2 in Section 2.3. of 
+                ### L = \Gamma \Omega^1/2 in Section 2.3. of
                 ### Fahrmeir et al. (2004, Stat Sinica)
                 "spectralDecomp" = {
                     SVD <- eigen(crossprod(K), symmetric = TRUE, EISPACK = FALSE)
@@ -358,7 +358,7 @@
             suppressMessages(K <- kronecker(diag(ncol(by)), K))
         }
         if (!identical(args$center, FALSE)) {
-            ### L = \Gamma \Omega^1/2 in Section 2.3. of Fahrmeir et al. 
+            ### L = \Gamma \Omega^1/2 in Section 2.3. of Fahrmeir et al.
             ### (2004, Stat Sinica), always
             L <- eigen(K, symmetric = TRUE, EISPACK = FALSE)
             L$vectors <- L$vectors[,1:(ncol(X) - args$differences^2), drop = FALSE]
@@ -580,7 +580,7 @@
     X <- splineDesign(knots, x, ord, derivs = rep(deriv, length(x)), outer.ok = TRUE)
     x[ind] <- x[ind] - boundary.knots[2] + boundary.knots[1]
     if (sum(ind)) {
-        Xtmp <- splineDesign(knots, x[ind], ord, derivs = rep(deriv, length(x[ind])), 
+        Xtmp <- splineDesign(knots, x[ind], ord, derivs = rep(deriv, length(x[ind])),
                              outer.ok = TRUE)
         X[ind, ] <- X[ind, ] + Xtmp
     }
@@ -616,7 +616,7 @@
     ## complete knot mesh
     k <- c(bk_lower, knots, bk_upper)
     ## construct design matrix
-    X <- splineDesign(k, x, degree + 1, derivs = rep(deriv, length(x)), 
+    X <- splineDesign(k, x, degree + 1, derivs = rep(deriv, length(x)),
                       outer.ok = TRUE)
     ## handling of NAs
     if (nas) {
@@ -787,8 +787,20 @@
 }
 
 ### random-effects (Ridge-penalized ANOVA) baselearner
-brandom <- function(..., contrasts.arg = "contr.dummy", df = 4) {
+brandom <- function(..., by = NULL, index = NULL, df = 4,
+                    contrasts.arg = "contr.dummy") {
     cl <- cltmp <- match.call()
+    x <- list(...)
+    ## drop further arguments to be passed to bols
+    if (!is.null(names(x)))
+        x <- x[names(x) == ""]
+
+    if (!all(sapply(x, is.factor) |
+             sapply(x, is.matrix) |
+             sapply(x, is.data.frame)))
+        stop(sQuote("..."), " must be a factor or design matrix in ",
+             sQuote("brandom"))
+
     if (is.null(cl$df))
         cl$df <- df
     if (is.null(cl$contrasts.arg))

Modified: pkg/mboostDevel/man/baselearners.Rd
===================================================================
--- pkg/mboostDevel/man/baselearners.Rd	2013-10-02 11:06:13 UTC (rev 745)
+++ pkg/mboostDevel/man/baselearners.Rd	2013-10-08 13:29:01 UTC (rev 746)
@@ -19,20 +19,33 @@
   component-wise gradient boosting in function \code{mboost}.
 }
 \usage{
+## linear base-learner
 bols(..., by = NULL, index = NULL, intercept = TRUE, df = NULL,
      lambda = 0, contrasts.arg = "contr.treatment")
+
+## smooth P-spline base-learner
 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"),
     deriv = 0)
+
+## bivariate P-spline base-learner
 bspatial(..., df = 6)
+
+## radial basis functions base-learner
 brad(..., by = NULL, index = NULL, knots = 100, df = 4, lambda = NULL,
      covFun = stationary.cov,
      args = list(Covariance="Matern", smoothness = 1.5, theta=NULL))
-brandom(..., contrasts.arg = "contr.dummy", df = 4)
+
+## random effects base-learner
+brandom(..., by = NULL, index = NULL, df = 4, contrasts.arg = "contr.dummy")
+
+## tree based base-learner
 btree(..., tree_controls = ctree_control(stump = TRUE,
                                          mincriterion = 0,
                                          savesplitstats = FALSE))
+
+## constrained effects base-learner
 bmono(...,
       constraint = c("increasing", "decreasing", "convex", "concave",
                      "none", "positive", "negative"),
@@ -42,9 +55,16 @@
       contrasts.arg = "contr.treatment",
       boundary.constraints = FALSE,
       cons.arg = list(lambda = 1e+06, n = NULL, diff_order = NULL))
+
+## Markov random field base-learner
 bmrf(..., by = NULL, index = NULL, bnd = NULL, df = 4, lambda = NULL,
     center = FALSE)
+
+## user-specified base-learner
 buser(X, K = NULL, by = NULL, index = NULL, df = 4, lambda = NULL)
+
+## combining single base-learners to form new,
+## more complex base-learners
 bl1 \%+\% bl2
 bl1 \%X\% bl2
 bl1 \%O\% bl2
@@ -54,12 +74,12 @@
               frame of predictor variables. For smooth base-learners,
 	      the number of predictor variables and the number of
 	      columns in the data frame / matrix must be less than or
-	      equal to 2. If a data frame or matrix (with at least 2
-	      columns) is given to \code{bols} or \code{brandom}, it
-	      is directly used as the design matrix. Especially, no
-	      intercept term is added reagrdless of argument
-	      \code{intercept}. If the argument has only one column, it
-	      is simplified to a vector and an intercept is added or not
+	      equal to 2. If a matrix (with at least 2 columns) is
+	      given to \code{bols} or \code{brandom}, it is directly
+	      used as the design matrix. Especially, no intercept term
+	      is added regardless of argument \code{intercept}.
+	      If the argument has only one column, it is simplified
+	      to a vector and an intercept is added or not
 	      according to the argmuent \code{intercept}.}
   \item{by}{ an optional variable defining varying coefficients,
              either a factor or numeric variable.
@@ -204,7 +224,9 @@
   corresponding design matrix (which can be omitted using
   \code{intercept = FALSE}). It is \emph{strongly} advised to (mean-)
   center continuous covariates, if no intercept is used in \code{bols}
-  (see Hofner et al., 2011a). When \code{df} (or \code{lambda}) is
+  (see Hofner et al., 2011a). If \code{x} is a matrix, it is directly used
+  as the design matrix and no further preprocessing (such as addition of
+  an intercept) is conducted. When \code{df} (or \code{lambda}) is
   given, a ridge estimator with \code{df} degrees of freedom (see
   section \sQuote{Global Options}) is used as base-learner. Note that
   all variables are treated as a group, i.e., they enter the model
@@ -243,9 +265,9 @@
   fitted, where the random effects variance is governed by the
   specification of the degrees of freedom \code{df} or \code{lambda}
   (see section \sQuote{Global Options}). Note that \code{brandom(...)}
-  is essentially a wrapper to \code{bols(..., df = 4)}, i.e., a wrapper
-  that utilizes ridge-penalized categorical effects. For possible
-  arguments and defaults see \code{bols}.
+  is essentially a wrapper to \code{bols(..., df = 4, contrasts.arg =
+  "contr.dummy")}, i.e., a wrapper that utilizes ridge-penalized
+  categorical effects. For possible arguments and defaults see \code{bols}.
 
   For all linear base-learners the amount of smoothing is determined by
   the trace of the hat matrix, as indicated by \code{df}.
@@ -333,7 +355,7 @@
 
   For a categorical covariate with non-observed categories
   \code{bols(x)} and \code{brandom(x)} both assign a zero effect
-  these categories. However, the non-observed categories must be
+  to these categories. However, the non-observed categories must be
   listed in \code{levels(x)}. Thus, predictions are possible
   for new observations if they correspond to this category.
 

Modified: pkg/mboostDevel/tests/bugfixes.R
===================================================================
--- pkg/mboostDevel/tests/bugfixes.R	2013-10-02 11:06:13 UTC (rev 745)
+++ pkg/mboostDevel/tests/bugfixes.R	2013-10-08 13:29:01 UTC (rev 746)
@@ -444,6 +444,7 @@
 y <- yNa <- rnorm(100)
 x1 <- rnorm(100)
 x2 <- rnorm(100)
+z1 <- as.factor(sample(1:10, 100, replace = TRUE))
 
 yNa[1] <- NA
 coef(mboost(yNa ~ x1))
@@ -453,6 +454,7 @@
 coef(mboost(yNa ~ x1))
 
 x1[1] <- NA
-mod <- mboost(y ~ bols(x1) + bbs(x1) + brandom(x1) +
+z1[1] <- NA
+mod <- mboost(y ~ bols(x1) + bbs(x1) + brandom(z1) +
                   bspatial(x1, x2) + brad(x1, x2, knots = 20) +
                   bmono(x1) +  buser(x1, K = 1, lambda = 0) + x2)

Modified: pkg/mboostDevel/tests/regtest-baselearner.R
===================================================================
--- pkg/mboostDevel/tests/regtest-baselearner.R	2013-10-02 11:06:13 UTC (rev 745)
+++ pkg/mboostDevel/tests/regtest-baselearner.R	2013-10-08 13:29:01 UTC (rev 746)
@@ -452,3 +452,22 @@
 m3 <- mboost(I(-y) ~ bbs(x1, constraint = "decreasing", df = 10) %O% bbs(x2))
 x$p3 <- fitted(m3)
 wireframe(p3 ~ x1 + x2, data = x)
+
+
+### check brandom
+x1 <- rnorm(100)
+x2 <- rnorm(100)
+z1 <- as.factor(sample(1:10, 100, TRUE))
+z2 <- as.factor(sample(1:10, 100, TRUE))
+Zm <- model.matrix(~ z1 - 1)
+Z <- as.data.frame(Zm)
+
+extract(brandom(z1))
+extract(brandom(z1, by = x2))
+extract(brandom(Zm))
+## probably non-sense but ok...
+extract(brandom(Z))
+## not really useful but might be ok
+extract(brandom(z1, z2))
+## should throw an error
+try(extract(brandom(x1, by = x2, intercept = FALSE)))



More information about the Mboost-commits mailing list