শিরোনাম অনুসারে, আমি লাইব্রেরি থেকে LBFGS অপ্টিমাইজার ব্যবহার করে গ্ল্যামনেট লিনিয়ার থেকে ফলাফলগুলি প্রতিলিপি করার চেষ্টা করছি lbfgs। এই অপটিমাইজারটি ততক্ষণ আমাদের বিচ্ছিন্নতা সম্পর্কে চিন্তা না করে একটি এল 1 নিয়ন্ত্রক পদ যুক্ত করতে দেয়, যতক্ষণ না আমাদের উদ্দেশ্যমূলক ফাংশন (এল 1 নিয়ন্ত্রক শব্দটি ব্যতীত) উত্তল থাকে।
মধ্যে ইলাস্টিক নেট রৈখিক রিগ্রেশনের সমস্যা glmnet কাগজ দেওয়া হয় যেখানে এক্স \ {আর} ^ {n \ বার p the হ'ল নকশা ম্যাট্রিক্স, y \ in th mathbb {R ^ ^ p পর্যবেক্ষণের ভেক্টর, [0,1] এর মধ্যে the আলফা the ইলাস্টিক নেট প্যারামিটার এবং \ ল্যাম্বদা> 0 হ'ল নিয়মিতকরণ প্যারামিটার। অপারেটর \ ভার্ট এক্স \ ভার্ট_পি সাধারণ এলপি আদর্শকে বোঝায়।
নীচের কোডটি ফাংশনটি সংজ্ঞায়িত করে এবং তারপরে ফলাফলগুলি তুলনা করার জন্য একটি পরীক্ষা অন্তর্ভুক্ত করে। যেমন আপনি দেখতে পাচ্ছেন, ফলাফলগুলি গ্রহণযোগ্য হয় alpha = 1তবে এর মানগুলি যখন বন্ধ হয় ততই নিম্নরূপ প্লট দেখায় alpha < 1.ত্রুটি আরও খারাপ হয় ("তুলনা মেট্রিক" গ্ল্যামনেটের প্যারামিটার অনুমানগুলির মধ্যে গড় ইউক্লিডিয়ান দূরত্ব এবং প্রদত্ত নিয়মিতকরণের পথে lbfgs)।alpha = 1alpha = 0
ঠিক আছে, তাই এখানে কোড। আমি যেখানেই সম্ভব মন্তব্যগুলি যুক্ত করেছি। আমার প্রশ্ন হ'ল কেন আমার ফলাফলগুলির 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 আমি আপনার কোডটি চেষ্টা করেছিলাম, এখানে কয়েকটি পরীক্ষা রয়েছে (গ্ল্যামনেটের কাঠামোর সাথে মেলে আমি কিছু ছোটখাটো টুইট করেছি - দ্রষ্টব্য যে আমরা বিরতি শর্তটি নিয়মিত করি না, এবং ক্ষতির ফাংশনগুলি অবশ্যই মাপা উচিত)। এটি এর জন্য 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। এটি জিনিসগুলির এল 2 নিয়মিতকরণের সাথে সম্পর্কিত হয় যখন কখন alpha < 1। আমি সংজ্ঞা পরিবর্তনের কোন ধরণের উপার্জন মনে SSEএবং SSE_grএটা ঠিক করা উচিত, কিন্তু আমি নিশ্চিত কি পরিবর্তন হওয়া উচিত নই - যতদূর আমি জানি, যারা ফাংশন ঠিক glmnet কাগজ বর্ণনা অনুযায়ী সংজ্ঞায়িত করা হয়।
lbfgsসম্পর্কে একটি বিষয় উত্থাপন করি ।orthantwise_cglmnet