From 406f8985dc110b0f92a2c1d3cb3460a7866d4f37 Mon Sep 17 00:00:00 2001
From: Patrick Breheny <patrick-breheny@uiowa.edu>
Date: Fri, 15 Jun 2018 15:26:13 -0500
Subject: [PATCH] Version 3.1-4

---
 DESCRIPTION            |  2 +-
 NEWS                   |  6 ++++++
 R/grpreg.R             | 14 +++++++-------
 R/plot.cv.R            |  2 +-
 inst/tests/torture.R   |  4 ++++
 man/grpreg-internal.Rd | 25 -------------------------
 6 files changed, 19 insertions(+), 34 deletions(-)
 delete mode 100644 man/grpreg-internal.Rd

diff --git a/DESCRIPTION b/DESCRIPTION
index 4bd7b7f..0b5fed4 100644
--- a/DESCRIPTION
+++ b/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 <patrick-breheny@uiowa.edu>
 Depends: R (>= 3.1.0), Matrix
diff --git a/NEWS b/NEWS
index cfad9f9..64299cf 100644
--- a/NEWS
+++ b/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 |
 
diff --git a/R/grpreg.R b/R/grpreg.R
index fad2873..80df31b 100644
--- a/R/grpreg.R
+++ b/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,10 +88,11 @@ 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))
@@ -100,7 +100,7 @@ grpreg <- function(X, y, group=1:ncol(X), penalty=c("grLasso", "grMCP", "grSCAD"
 
   val <- structure(list(beta = beta,
                         family = family,
-                        group = group,
+                        group = factor(group),
                         lambda = lambda,
                         alpha = alpha,
                         loss = loss,
diff --git a/R/plot.cv.R b/R/plot.cv.R
index ec08f21..c09be19 100644
--- a/R/plot.cv.R
+++ b/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")
diff --git a/inst/tests/torture.R b/inst/tests/torture.R
index 1f9143f..05ffbd1 100644
--- a/inst/tests/torture.R
+++ b/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)
diff --git a/man/grpreg-internal.Rd b/man/grpreg-internal.Rd
deleted file mode 100644
index ea0d2b5..0000000
--- a/man/grpreg-internal.Rd
+++ /dev/null
@@ -1,25 +0,0 @@
-\name{grpreg-internal}
-\title{Internal grpreg functions}
-\alias{calcL}
-\alias{criteria.grpreg}
-\alias{setupLambda}
-\alias{unstandardize}
-\description{Internal grpreg functions}
-\usage{
-setupLambda(X, y, group, family, penalty, alpha, lambda.min, log.lambda, nlambda,
-group.multiplier) 
-setupLambda.gBridge(X, y, group, family, alpha, lambda.min, lambda.max,
-nlambda, gamma, group.multiplier) 
-standardize(X)
-unstandardize(b, center, scale)
-orthogonalize(X, group)
-unorthogonalize(b, XX, group, intercept = TRUE)
-}
-\author{Patrick Breheny <patrick-breheny@uiowa.edu>}
-\details{These are not intended for use by users. \code{setupLambda} and
-  \code{setupLambda.gBridge} create appropriate vectors of
-  regularization parameter values. The functions of \code{standardize},
-  \code{unstandardize}, \code{orthogonalize}, and \code{unorthogonalize}
-  are self-explanatory.
-  }
-\keyword{internal}