From b856d08c351f7c4607bb4af65a7ee48c30405413 Mon Sep 17 00:00:00 2001 From: Patrick Breheny Date: Wed, 5 Jul 2017 16:40:18 -0500 Subject: [PATCH] 3.1-2: Fixed bug with screening rules + user specified lambda --- DESCRIPTION | 4 ++-- NEWS | 5 +++++ inst/tests/basic-functionality.R | 12 ++++++------ inst/tests/extra-features.R | 20 ++++++++++++++++++++ src/gdfit_gaussian.c | 3 +-- 5 files changed, 34 insertions(+), 10 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4e9eece..f52970f 100644 --- a/DESCRIPTION +++ b/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 Depends: R (>= 3.1.0), Matrix diff --git a/NEWS b/NEWS index 13aab49..ef35854 100644 --- a/NEWS +++ b/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) diff --git a/inst/tests/basic-functionality.R b/inst/tests/basic-functionality.R index 2f48f88..4ed75c2 100644 --- a/inst/tests/basic-functionality.R +++ b/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")) diff --git a/inst/tests/extra-features.R b/inst/tests/extra-features.R index b432572..2ccd38b 100644 --- a/inst/tests/extra-features.R +++ b/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) diff --git a/src/gdfit_gaussian.c b/src/gdfit_gaussian.c index 908f2ce..58298af 100644 --- a/src/gdfit_gaussian.c +++ b/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); }