Version 3.1-4

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: grpreg
 Title: Regularization Paths for Regression Models with Grouped Covariates
 Version: 3.1-4
-Date: 2018-04-07
+Date: 2018-06-15
 Author: Patrick Breheny [aut, cre], Yaohui Zeng [ctb]
 Maintainer: Patrick Breheny <[email protected]>
 Depends: R (>= 3.1.0), Matrix

NEWS

@@ -1,3 +1,9 @@
+3.1-4 (2018-06-15)
+  * Fixed: Works with arbitrarily "messy" group structures now (constant
+    columns, out of order groups, etc.) due to restructuring of standardization/
+    orthogonalization
+  * Internal: SSR-BEDPP rule turned off due to bug
+
 3.1-3 (2018-04-07)
   * Internal: C code now uses || instead of |
 

R/grpreg.R

@@ -27,8 +27,7 @@ grpreg <- function(X, y, group=1:ncol(X), penalty=c("grLasso", "grMCP", "grSCAD"
   # Construct XG, yy
   bilevel <- strtrim(penalty,2) != "gr"
   yy <- newY(y, family)
-  m <- attr(yy, "m")
-  XG <- newXG(X, group, group.multiplier, m, bilevel)
+  XG <- newXG(X, group, group.multiplier, attr(yy, 'm'), bilevel)
   if (nrow(XG$X) != length(yy)) stop("X and y do not have the same number of observations")
 
   # Setup lambda
@@ -89,18 +88,19 @@ grpreg <- function(X, y, group=1:ncol(X), penalty=c("grLasso", "grMCP", "grSCAD"
 
   # Names
   varnames <- c("(Intercept)", XG$names)
-  if (m > 1) {
-    beta[2:m,] <- sweep(beta[2:m,,drop=FALSE], 2, beta[1,], FUN="+")
-    beta <- array(beta, dim=c(m, nrow(beta)/m, ncol(beta)))
-    group <- group[-(1:(m-1))]
+  ncolY <- attr(yy, 'm')
+  if (ncolY > 1) {
+    beta[2:ncolY,] <- sweep(beta[2:ncolY,,drop=FALSE], 2, beta[1,], FUN="+")
+    beta <- array(beta, dim=c(ncolY, nrow(beta)/ncolY, ncol(beta)))
+    group <- group[-(1:(ncolY-1))]
     dimnames(beta) <- list(colnames(yy), varnames, round(lambda,digits=4))
   } else {
     dimnames(beta) <- list(varnames, round(lambda,digits=4))
   }
 
   val <- structure(list(beta = beta,
                         family = family,
-                        group = group,
+                        group = factor(group),
                         lambda = lambda,
                         alpha = alpha,
                         loss = loss,

R/plot.cv.R

@@ -51,7 +51,7 @@ plot.cv.grpreg <- function(x, log.l=TRUE, type=c("cve", "rsq", "scale", "snr", "
     ylab <- "Prediction error"
   }
 
-  ind <- if (type=="pred") which(is.finite(l[1:length(x$pe)])) else which(is.finite(l[1:length(x$cve)]))
+  ind <- if (type=="pred") is.finite(l[1:length(x$pe)]) else is.finite(l[1:length(x$cve)])
   ylim <- if (class(x)[1]=='cv.grpsurv') range(y[ind]) else range(c(L[ind], U[ind]))
   aind <- ((U-L)/diff(ylim) > 1e-3) & ind
   plot.args = list(x=l[ind], y=y[ind], ylim=ylim, xlab=xlab, ylab=ylab, type="n", xlim=rev(range(l[ind])), las=1, bty="n")

inst/tests/torture.R

@@ -102,3 +102,7 @@ fit3 <- grpreg(X[,nz], y, group[nz], penalty="grLasso", lambda.min=0)
 b3 <- coef(fit3, 0)[-1]
 check(b1[nz], b3, tol=0.01)  # Checking dropped group/var
 check(coef(fit1)["V6",], coef(fit1)["V7",], tol=0.01)  # Checking rank handled correctly
+cvfit <- cv.grpreg(X[,perm], y, group[perm], penalty="grLasso", lambda.min=0)
+plot(cvfit)
+summary(cvfit)
+plot(cvfit$fit)