Adaptive LASSO is used for consistent variable selection. The problems we encounter when using the LASSO for variable selection are:
- The shrinkage parameter must be larger for selection than prediction
- Large nonzero parameters will be too small so that the bias is too large
- Small nonzero parameters cannot be detected consistently
- High correlations between predictors leads to poor selection performance
Thus the LASSO is only consistent for variable selection under some conditions on the shrinkage parameter, parameters (beta-min condition) and correlations (irrepresentable condition). See pages 101-106 of my masters dissertation for a detailed explanation.
The LASSO often includes too many variables when selecting the tuning parameter for prediction but the true model is very likely a subset of these variables. This suggests using a secondary stage of estimation like the adaptive LASSO which controls the bias of the LASSO estimate using the prediction-optimal tuning parameter. This leads to consistent selection (or oracle property) without the conditions mentioned above.
You can use glmnet for adaptive LASSO. First you need an initial estimate, either least squares, ridge or even LASSO estimates, to calculate weights. Then you can implement adaptive LASSO by scaling the X matrix. Here's an example using least squares initial estimates on training data:
# get data
y <- train[, 11]
x <- train[, -11]
x <- as.matrix(x)
n <- nrow(x)
# standardize data
ymean <- mean(y)
y <- y-mean(y)
xmean <- colMeans(x)
xnorm <- sqrt(n-1)*apply(x,2,sd)
x <- scale(x, center = xmean, scale = xnorm)
# fit ols
lm.fit <- lm(y ~ x)
beta.init <- coef(lm.fit)[-1] # exclude 0 intercept
# calculate weights
w <- abs(beta.init)
x2 <- scale(x, center=FALSE, scale=1/w)
# fit adaptive lasso
require(glmnet)
lasso.fit <- cv.glmnet(x2, y, family = "gaussian", alpha = 1, standardize = FALSE, nfolds = 10)
beta <- predict(lasso.fit, x2, type="coefficients", s="lambda.min")[-1]
# calculate estimates
beta <- beta * w / xnorm # back to original scale
beta <- matrix(beta, nrow=1)
xmean <- matrix(xmean, nrow=10)
b0 <- apply(beta, 1, function(a) ymean - a %*% xmean) # intercept
coef <- cbind(b0, beta)