अनुकूली LASSO का उपयोग लगातार परिवर्तनशील चयन के लिए किया जाता है। वेरिएबल सेलेक्शन के लिए LASSO का इस्तेमाल करते समय जो समस्याएं आती हैं, वे हैं:
- भविष्यवाणी की तुलना में चयन के लिए संकोचन पैरामीटर बड़ा होना चाहिए
- बड़े नॉनजरो पैरामीटर बहुत छोटे होंगे ताकि पूर्वाग्रह बहुत बड़ा हो
- छोटे नॉनज़रो मापदंडों का लगातार पता नहीं लगाया जा सकता है
- भविष्यवक्ताओं के बीच उच्च सहसंबंध खराब चयन प्रदर्शन की ओर जाता है
इस प्रकार LASSO केवल सिकुड़न पैरामीटर, मापदंडों (बीटा-मिन स्थिति) और सहसंबंध (अपरिवर्तनीय स्थिति) पर कुछ शर्तों के तहत चर चयन के लिए सुसंगत है। विस्तृत विवरण के लिए मेरे स्वामी निबंध के पृष्ठ १०१-१०६ देखें ।
LASSO अक्सर भविष्यवाणी के लिए ट्यूनिंग पैरामीटर का चयन करते समय बहुत अधिक चर शामिल करता है, लेकिन सही मॉडल बहुत संभव है कि इन चर का एक सबसेट है। यह अनुकूली LASSO जैसे अनुमान के एक द्वितीयक चरण का उपयोग करने का सुझाव देता है जो भविष्यवाणी-इष्टतम ट्यूनिंग पैरामीटर का उपयोग करके LASSO अनुमान के पूर्वाग्रह को नियंत्रित करता है। यह ऊपर वर्णित शर्तों के बिना लगातार चयन (या ओरेकल संपत्ति) की ओर जाता है।
आप अनुकूली LASSO के लिए glmnet का उपयोग कर सकते हैं। पहले आपको वजन की गणना करने के लिए प्रारंभिक अनुमान, कम से कम वर्ग, रिज या यहां तक कि LASSO अनुमान की आवश्यकता होती है। फिर आप एक्स मैट्रिक्स को स्केल करके अनुकूली LASSO को लागू कर सकते हैं। प्रशिक्षण डेटा पर प्रारंभिक अनुमानों का उपयोग करके यहां एक उदाहरण दिया गया है:
# 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)