Adaptive LASSO ใช้สำหรับการเลือกตัวแปรที่สอดคล้องกัน ปัญหาที่เราพบเมื่อใช้ LASSO สำหรับการเลือกตัวแปรคือ:
- พารามิเตอร์การหดตัวจะต้องใหญ่กว่าการเลือกมากกว่าการทำนาย
- พารามิเตอร์ที่ไม่ใช่ศูนย์ขนาดใหญ่จะเล็กเกินไปดังนั้นอคตินั้นใหญ่เกินไป
- พารามิเตอร์ที่ไม่ใช่ศูนย์ขนาดเล็กไม่สามารถตรวจพบได้อย่างสม่ำเสมอ
- สหสัมพันธ์สูงระหว่างตัวทำนายนำไปสู่ประสิทธิภาพการเลือกที่ไม่ดี
ดังนั้น LASSO จึงมีความสอดคล้องกันสำหรับการเลือกตัวแปรภายใต้เงื่อนไขบางประการเกี่ยวกับพารามิเตอร์การหดตัวพารามิเตอร์ (เงื่อนไขเบต้า - นาที) และสหสัมพันธ์ (เงื่อนไขที่ไม่สามารถอธิบายได้) ดูหน้า 101-106 ของวิทยานิพนธ์ปริญญาโทของฉันสำหรับคำอธิบายรายละเอียด
LASSO มักจะมีตัวแปรมากเกินไปเมื่อเลือกพารามิเตอร์การปรับแต่งสำหรับการคาดการณ์ แต่โมเดลที่แท้จริงน่าจะเป็นชุดย่อยของตัวแปรเหล่านี้ สิ่งนี้แนะนำให้ใช้ขั้นตอนที่สองของการประมาณค่าเช่น LASSO ที่ปรับได้ซึ่งควบคุมความเอนเอียงของการประมาณ LASSO โดยใช้พารามิเตอร์การปรับที่เหมาะสมที่สุดในการทำนาย สิ่งนี้นำไปสู่การเลือกที่สอดคล้องกัน (หรือคุณสมบัติ oracle) โดยไม่มีเงื่อนไขที่กล่าวถึงข้างต้น
คุณสามารถใช้ glmnet เพื่อการปรับตัว LASSO ขั้นแรกคุณต้องมีการประมาณค่าเริ่มต้นไม่ว่าจะเป็นสี่เหลี่ยมจัตุรัสริดจ์หรือแม้แต่ LASSO ประมาณอย่างน้อยที่สุดเพื่อคำนวณน้ำหนัก จากนั้นคุณสามารถปรับใช้ LASSO แบบปรับตัวได้โดยการปรับเมทริกซ์ X นี่คือตัวอย่างโดยใช้การประมาณค่าเริ่มต้นกำลังสองน้อยที่สุดสำหรับข้อมูลการฝึกอบรม:
# 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)