जैसा कि शीर्षक में कहा गया है, मैं लाइब्रेरी से LBFGS ऑप्टिमाइज़र का उपयोग करके glmnet रैखिक से परिणाम दोहराने की कोशिश कर रहा हूँ lbfgs। यह ऑप्टिमाइज़र हमें एल 1 रेगुलराइज़र शब्द जोड़ने की अनुमति देता है, बिना भिन्नता के बारे में चिंता किए बिना, जब तक कि हमारा उद्देश्य फ़ंक्शन (एल 1 रेग्युलर टर्म के बिना) उत्तल नहीं होता है।
नीचे दिए गए कोड फ़ंक्शन को परिभाषित करते हैं, और फिर परिणामों की तुलना करने के लिए एक परीक्षण शामिल करते हैं। जैसा कि आप देख सकते हैं, जब परिणाम स्वीकार्य होते हैं alpha = 1, लेकिन alpha < 1.त्रुटि के मानों के लिए रास्ता बंद हो जाता alpha = 1है alpha = 0, जैसा कि हम से जाना जाता है , जैसा कि निम्नलिखित कथानक से पता चलता है ("तुलना मीट्रिक" का मतलब है ग्लूनेट के पैरामीटर अनुमानों के बीच यूक्लिडियन दूरी और दिए गए नियमितीकरण पथ के लिए lbfgs)।
ठीक है, तो यहाँ कोड है। मैंने जहाँ भी संभव हो टिप्पणी जोड़ दी है। मेरा प्रश्न है: मेरे परिणाम उन glmnetमूल्यों से भिन्न क्यों हैं alpha < 1? यह स्पष्ट रूप से एल 2 नियमितीकरण शब्द के साथ करना है, लेकिन जहां तक मैं बता सकता हूं, मैंने इस शब्द को कागज के अनुसार बिल्कुल लागू किया है। कोई भी सहायताकाफी प्रशंसनीय होगी!
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 मैंने आपके कोड की कोशिश की, यहाँ कुछ परीक्षण हैं (मैंने glmnet की संरचना से मेल खाने के लिए कुछ मामूली मोड़ दिए - ध्यान दें कि हम अवरोधन अवधि को नियमित नहीं करते हैं, और नुकसान कार्यों को कम किया जाना चाहिए)। यह के लिए है alpha = 0, लेकिन आप किसी भी कोशिश कर सकते हैं alpha- परिणाम मेल नहीं खाते।
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)))lbfgsऔर orthantwise_c, जब alpha = 1, समाधान बिल्कुल उसी के पास है glmnet। यह चीजों के L2 नियमितीकरण पक्ष के साथ करना है, जब कि alpha < 1। मैं की परिभाषा के लिए संशोधन के कुछ प्रकार बनाने लगता है SSEऔर SSE_grइसे ठीक करना चाहिए, लेकिन मुझे यकीन है कि क्या संशोधन किया जाना चाहिए नहीं कर रहा हूँ - जहाँ तक मुझे पता है, उन कार्यों वास्तव में glmnet पत्र में वर्णित के रूप में परिभाषित कर रहे हैं।
lbfgsबारे मेंorthantwise_cतर्क के बारे में एक बिंदु उठाता हूंglmnet।