Bug fix for gBridge group multiplier

R/newXG.R

@@ -26,12 +26,19 @@ newXG <- function(X, g, m, ncolY, bilevel) {
   XX <- std[[1]]
   center <- std[[2]]
   scale <- std[[3]]
-  nz <- which(scale > 1e-6)                        # non-constant columns
+  nz <- which(scale > 1e-6)                # non-constant columns
   zg <- setdiff(unique(g), unique(g[nz]))  # constant groups
-  if (length(zg)) m <- m[-zg]
+  if (length(zg)) {
+    gf <- factor(g[!(g %in% zg)])
+    if (any(levels(gf)=="0")) {
+      g <- as.numeric(gf) - 1
+    } else {
+      g <- as.numeric(gf)
+    }
+    m <- m[-zg]
+  }
   if (length(nz) != ncol(X)) {
     XX <- XX[ ,nz, drop=FALSE]
-    g <- g[nz]
   }
   if (!bilevel) {
     XX <- orthogonalize(XX, g)

R/setupLambda.R

@@ -58,7 +58,7 @@ setupLambda.gBridge <- function(X, y, group, family, alpha, lambda.min, lambda.m
       z <- crossprod(X[,ind], fit$weights * residuals(fit, "working")) / n
       a <- .2
     }
-    lambda.max <- max(abs(z)/group.multiplier)*a^(1-gamma)/(gamma*alpha)
+    lambda.max <- max(abs(z)/group.multiplier[group])*a^(1-gamma)/(gamma*alpha)
   }
   if (lambda.min==0) {
     lambda <- c(exp(seq(log(lambda.max), log(.001*lambda.max), len=nlambda-1)),0)

inst/tests/extra-features.R

@@ -131,10 +131,10 @@ cvfit <- cv.grpreg(X, y, group, penalty="grLasso")
 
 .test = "group.multiplier works"
 n <- 50
-p <- 10
+p <- 11
 X <- matrix(rnorm(n*p),ncol=p)
 y <- rnorm(n)
-group <- rep(0:3,1:4)
+group <- rep(0:3,c(1, 2, 3, 5))
 gm <- 1:3
 plot(fit <- grpreg(X, y, group, penalty="cMCP", lambda.min=0, group.multiplier=gm), main=fit$penalty)
 plot(fit <- gBridge(X, y, group, lambda.min=0, group.multiplier=gm), main=fit$penalty)