Như tiêu đề, tôi đang cố gắng sao chép các kết quả từ tuyến tính glmnet bằng trình tối ưu hóa LBFGS từ thư viện lbfgs. Trình tối ưu hóa này cho phép chúng ta thêm một thuật ngữ chính quy L1 mà không phải lo lắng về tính khác biệt, miễn là hàm mục tiêu của chúng ta (không có thuật ngữ chính quy L1) là lồi.
Vấn đề hồi quy tuyến tính mạng đàn hồi trong giấy glmnet được đưa ra bởi trong đó X \ in \ mathbb {R} ^ {n \ lần p} là ma trận thiết kế, y \ in \ mathbb {R} ^ p là vectơ quan sát, \ alpha \ in [0,1] là tham số mạng đàn hồi và \ lambda> 0 là tham số chính quy. Toán tử \ Vert x \ Vert_p biểu thị định mức Lp thông thường.
Đoạn mã dưới đây xác định hàm và sau đó bao gồm một bài kiểm tra để so sánh kết quả. Như bạn có thể thấy, kết quả có thể chấp nhận được khi nào alpha = 1, nhưng lại tắt cho các giá trị của alpha < 1.Lỗi trở nên tồi tệ hơn khi chúng ta đi alpha = 1đến alpha = 0, như biểu đồ sau đây cho thấy ("số liệu so sánh" là khoảng cách Euclide trung bình giữa các ước tính tham số của glmnet và lbfss cho một đường dẫn chính quy nhất định).
Được rồi, đây là mã. Tôi đã thêm ý kiến bất cứ nơi nào có thể. Câu hỏi của tôi là: Tại sao kết quả của tôi khác với kết quả của glmnetcác giá trị alpha < 1? Nó rõ ràng có liên quan đến thuật ngữ chính quy L2, nhưng theo như tôi có thể nói, tôi đã thực hiện thuật ngữ này chính xác theo giấy tờ. Bất kì sự trợ giúp nào đều được đánh giá cao!
library(lbfgs)
linreg_lbfgs <- function(X, y, alpha = 1, scale = TRUE, lambda) {
p <- ncol(X) + 1; n <- nrow(X); nlambda <- length(lambda)
# Scale design matrix
if (scale) {
means <- colMeans(X)
sds <- apply(X, 2, sd)
sX <- (X - tcrossprod(rep(1,n), means) ) / tcrossprod(rep(1,n), sds)
} else {
means <- rep(0,p-1)
sds <- rep(1,p-1)
sX <- X
}
X_ <- cbind(1, sX)
# loss function for ridge regression (Sum of squared errors plus l2 penalty)
SSE <- function(Beta, X, y, lambda0, alpha) {
1/2 * (sum((X%*%Beta - y)^2) / length(y)) +
1/2 * (1 - alpha) * lambda0 * sum(Beta[2:length(Beta)]^2)
# l2 regularization (note intercept is excluded)
}
# loss function gradient
SSE_gr <- function(Beta, X, y, lambda0, alpha) {
colSums(tcrossprod(X%*%Beta - y, rep(1,ncol(X))) *X) / length(y) + # SSE grad
(1-alpha) * lambda0 * c(0, Beta[2:length(Beta)]) # l2 reg grad
}
# matrix of parameters
Betamat_scaled <- matrix(nrow=p, ncol = nlambda)
# initial value for Beta
Beta_init <- c(mean(y), rep(0,p-1))
# parameter estimate for max lambda
Betamat_scaled[,1] <- lbfgs(call_eval = SSE, call_grad = SSE_gr, vars = Beta_init,
X = X_, y = y, lambda0 = lambda[2], alpha = alpha,
orthantwise_c = alpha*lambda[2], orthantwise_start = 1,
invisible = TRUE)$par
# parameter estimates for rest of lambdas (using warm starts)
if (nlambda > 1) {
for (j in 2:nlambda) {
Betamat_scaled[,j] <- lbfgs(call_eval = SSE, call_grad = SSE_gr, vars = Betamat_scaled[,j-1],
X = X_, y = y, lambda0 = lambda[j], alpha = alpha,
orthantwise_c = alpha*lambda[j], orthantwise_start = 1,
invisible = TRUE)$par
}
}
# rescale Betas if required
if (scale) {
Betamat <- rbind(Betamat_scaled[1,] -
colSums(Betamat_scaled[-1,]*tcrossprod(means, rep(1,nlambda)) / tcrossprod(sds, rep(1,nlambda)) ), Betamat_scaled[-1,] / tcrossprod(sds, rep(1,nlambda)) )
} else {
Betamat <- Betamat_scaled
}
colnames(Betamat) <- lambda
return (Betamat)
}
# CODE FOR TESTING
# simulate some linear regression data
n <- 100
p <- 5
X <- matrix(rnorm(n*p),n,p)
true_Beta <- sample(seq(0,9),p+1,replace = TRUE)
y <- drop(cbind(1,X) %*% true_Beta)
library(glmnet)
# function to compare glmnet vs lbfgs for a given alpha
glmnet_compare <- function(X, y, alpha) {
m_glmnet <- glmnet(X, y, nlambda = 5, lambda.min.ratio = 1e-4, alpha = alpha)
Beta1 <- coef(m_glmnet)
Beta2 <- linreg_lbfgs(X, y, alpha = alpha, scale = TRUE, lambda = m_glmnet$lambda)
# mean Euclidean distance between glmnet and lbfgs results
mean(apply (Beta1 - Beta2, 2, function(x) sqrt(sum(x^2))) )
}
# compare results
alpha_seq <- seq(0,1,0.2)
plot(alpha_seq, sapply(alpha_seq, function(alpha) glmnet_compare(X,y,alpha)), type = "l", ylab = "Comparison metric")
@ hxd1011 Tôi đã thử mã của bạn, đây là một số thử nghiệm (Tôi đã thực hiện một số điều chỉnh nhỏ để phù hợp với cấu trúc của glmnet - lưu ý chúng tôi không thường xuyên sử dụng thuật ngữ chặn và các chức năng mất phải được thu nhỏ). Đây là cho alpha = 0, nhưng bạn có thể thử bất kỳ alpha- kết quả không phù hợp.
rm(list=ls())
set.seed(0)
# simulate some linear regression data
n <- 1e3
p <- 20
x <- matrix(rnorm(n*p),n,p)
true_Beta <- sample(seq(0,9),p+1,replace = TRUE)
y <- drop(cbind(1,x) %*% true_Beta)
library(glmnet)
alpha = 0
m_glmnet = glmnet(x, y, alpha = alpha, nlambda = 5)
# linear regression loss and gradient
lr_loss<-function(w,lambda1,lambda2){
e=cbind(1,x) %*% w -y
v= 1/(2*n) * (t(e) %*% e) + lambda1 * sum(abs(w[2:(p+1)])) + lambda2/2 * crossprod(w[2:(p+1)])
return(as.numeric(v))
}
lr_loss_gr<-function(w,lambda1,lambda2){
e=cbind(1,x) %*% w -y
v= 1/n * (t(cbind(1,x)) %*% e) + c(0, lambda1*sign(w[2:(p+1)]) + lambda2*w[2:(p+1)])
return(as.numeric(v))
}
outmat <- do.call(cbind, lapply(m_glmnet$lambda, function(lambda)
optim(rnorm(p+1),lr_loss,lr_loss_gr,lambda1=alpha*lambda,lambda2=(1-alpha)*lambda,method="L-BFGS")$par
))
glmnet_coef <- coef(m_glmnet)
apply(outmat - glmnet_coef, 2, function(x) sqrt(sum(x^2)))
lbfgsvà orthantwise_c, khi nào alpha = 1, giải pháp gần như giống hệt với glmnet. Nó phải làm với mặt chính quy L2 của mọi thứ tức là khi nào alpha < 1. Tôi nghĩ rằng thực hiện một số sửa đổi cho định nghĩa SSEvà SSE_grnên sửa nó, nhưng tôi không chắc sửa đổi đó là gì - theo như tôi biết, các chức năng đó được định nghĩa chính xác như được mô tả trong bài báo glmnet.
lbfgsđưa ra quan điểm vềorthantwise_clập luận liên quanglmnet.