R/gaussianfit_lasso.R

In SOIL: Sparsity Oriented Importance Learning

gaussianfit_lasso <- function(x, y) {
  m1 <- glmnet(x = x, y = y, family = "gaussian", alpha = 1, maxit = 1e+06)
  #############################			   
  ## adaptive lasso routine  ##			   
  ## The adaptive lasso needs a first stage that is consistent. 
  ## Zou (2006) recommends OLS or ridge
  thelasso.cv<-cv.glmnet(x,y,family = "gaussian",alpha=1) ## first stage ridge
  ## Second stage weights from the coefficients of the first stage
  bhat<-as.matrix(coef(thelasso.cv,s="lambda.1se"))[-1,1] ## coef() is a sparseMatrix
  if(all(bhat==0)){
    ## if bhat is all zero then assign very close to zero weight to all.
    ## Amounts to penalizing all of the second stage to zero.
    bhat<-rep(.Machine$double.eps*2,length(bhat))
  }
  adpen<-(1/pmax(abs(bhat),.Machine$double.eps)) ## the adaptive lasso weight
  ## Second stage lasso (the adaptive lasso)
  m2 <- glmnet(x,y,family = "gaussian",alpha=1,exclude=which(bhat==0),penalty.factor=adpen)
  #############################					 				   
  m1.path <- as.matrix(m1$beta)
  m2.path <- as.matrix(m2$beta)
  beta.path <- t(cbind(m1.path, m2.path))
  candidate_models <- (1 - (beta.path == 0))
  candidate_models
}