3.1-2: Fixed bug with screening rules + user specified lambda

DESCRIPTION

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

NEWS

@@ -1,3 +1,8 @@
+3.1-2 (2017-07-05)
+  * Fixed: Bug in applying screening rules with group lasso for linear
+    regression with user-specified lambda sequence (thank you very much to
+    Natasha Sahr for pointing this out)
+
 3.1-1 (2017-06-07)
   * Fixed: Cross-validation no longer fails when constant columns are present
     (thank you to Matthew Rosenberg for pointing this out)

inst/tests/basic-functionality.R

@@ -95,22 +95,22 @@ reg <- coef(fit.mle)
 par(mfcol=c(3,2))
 gel <- coef(fit <- grpreg(X, y, group, penalty="gel", family="binomial", eps=1e-10, lambda.min=0))[,100]
 plot(fit, main=fit$penalty)
-check(gel, reg)
+check(gel, reg, tol=1e-6)
 cMCP <- coef(fit <- grpreg(X, y, group, penalty="cMCP", family="binomial", eps=1e-10, lambda.min=0))[,100]
 plot(fit, main=fit$penalty)
-check(cMCP, reg)
+check(cMCP, reg, tol=1e-6)
 bridge <- coef(fit <- gBridge(X, y, group, family="binomial", eps=1e-10, lambda.min=0))[,1]
 plot(fit, main=fit$penalty)
-check(bridge, reg)
+check(bridge, reg, tol=1e-6)
 grLasso <- coef(fit <- grpreg(X, y, group, penalty="grLasso", family="binomial", eps=1e-10, lambda.min=0))[,100]
 plot(fit, main=fit$penalty)
-check(grLasso, reg)
+check(grLasso, reg, tol=1e-6)
 grMCP <- coef(fit <- grpreg(X, y, group, penalty="grMCP", family="binomial", gamma=2, eps=1e-10, lambda.min=0))[,100]
 plot(fit, main=fit$penalty)
-check(grMCP, reg)
+check(grMCP, reg, tol=1e-6)
 grSCAD <- coef(fit <- grpreg(X, y, group, penalty="grSCAD", family="binomial", gamma=2.1, eps=1e-10, lambda.min=0))[,100]
 plot(fit, main=fit$penalty)
-check(grSCAD, reg)
+check(grSCAD, reg, tol=1e-6)
 check(predict(fit, X)[,100], predict(fit.mle))
 check(predict(fit, X, type="response")[,100], predict(fit.mle, type="response"))
 

inst/tests/extra-features.R

@@ -27,6 +27,26 @@ fit <- grpreg(X, yy, group, penalty="gMCP", lambda.min=0, family="poisson")
 check(logLik(fit)[100], logLik(fit.mle)[1], tol=.001)
 check(AIC(fit)[100], AIC(fit.mle), tol=.001)
 
+.test = "grpreg handles user-specified lambda"
+n <- 50
+group <- rep(0:3,4:1)
+p <- length(group)
+X <- matrix(rnorm(n*p),ncol=p)
+y <- rnorm(n)
+yy <- y > 0
+fit1 <- grpreg(X, y, group, penalty="grLasso")
+fit2 <- grpreg(X, y, group, penalty="grLasso", lambda=fit1$lambda)
+check(fit1$beta, fit2$beta)
+fit1 <- grpreg(X, y, group, penalty="gel")
+fit2 <- grpreg(X, y, group, penalty="gel", lambda=fit1$lambda)
+check(fit1$beta, fit2$beta)
+fit1 <- grpreg(X, yy, group, penalty="grLasso", family="binomial")
+fit2 <- grpreg(X, yy, group, penalty="grLasso", family="binomial", lambda=fit1$lambda)
+check(fit1$beta, fit2$beta)
+fit1 <- grpreg(X, yy, group, penalty="gel", family="binomial")
+fit2 <- grpreg(X, yy, group, penalty="gel", family="binomial", lambda=fit1$lambda)
+check(fit1$beta, fit2$beta)
+
 .test = "grpreg handles constant columns"
 n <- 50
 group <- rep(0:3,4:1)

src/gdfit_gaussian.c

@@ -175,7 +175,6 @@ void bedpp_glasso(int *e3, double *yTxxTv1, double *xTv1_sq, double *xTy_sq,
     } else {
       e3[g] = 0; // reject
     }
-
   }
 }
 
@@ -311,7 +310,7 @@ SEXP gdfit_gaussian(SEXP X_, SEXP y_, SEXP penalty_, SEXP K1_, SEXP K0_,
   int *K_star_ptr = &K_star;
   double y_norm_sq = pow(norm(y, n), 2);
   int bedpp_flag;
-  if (strcmp(penalty, "grLasso")==0) {
+  if ((strcmp(penalty, "grLasso")==0) & !user) {
     bedpp_flag = 1;
     bedpp_init(yTxxTv1, xTv1_sq, xTy_sq, xTr, X, y, K1, K, g_star_ptr, K_star_ptr, K1_len, n, J);
   }