Một ví dụ: Hồi quy LASSO bằng glmnet cho kết quả nhị phân

Tôi bắt đầu say mê với việc sử dụng glmnetvới LASSO Regression trong đó kết quả quan tâm của tôi là phân đôi. Tôi đã tạo một khung dữ liệu giả nhỏ bên dưới:

age     <- c(4, 8, 7, 12, 6, 9, 10, 14, 7) 
gender  <- c(1, 0, 1, 1, 1, 0, 1, 0, 0)
bmi_p   <- c(0.86, 0.45, 0.99, 0.84, 0.85, 0.67, 0.91, 0.29, 0.88)
m_edu   <- c(0, 1, 1, 2, 2, 3, 2, 0, 1)
p_edu   <- c(0, 2, 2, 2, 2, 3, 2, 0, 0)
f_color <- c("blue", "blue", "yellow", "red", "red", "yellow", "yellow", 
             "red", "yellow")
asthma  <- c(1, 1, 0, 1, 0, 0, 0, 1, 1)
# df is a data frame for further use!
df <- data.frame(age, gender, bmi_p, m_edu, p_edu, f_color, asthma)

Các cột (biến) trong bộ dữ liệu trên như sau:

• age (tuổi của trẻ trong năm) - liên tục
• gender - nhị phân (1 = nam; 0 = nữ)
• bmi_p (Phân vị BMI) - liên tục
• m_edu (trình độ học vấn cao nhất của mẹ) - thứ tự (0 = ít hơn trường trung học; 1 = bằng tốt nghiệp trung học; 2 = bằng cử nhân; 3 = bằng sau tú tài)
• p_edu (trình độ học vấn cao nhất của cha) - thứ tự (giống như m_edu)
• f_color (màu chính yêu thích) - danh nghĩa ("xanh", "đỏ" hoặc "vàng")
• asthma (tình trạng hen suyễn ở trẻ em) - nhị phân (1 = hen; 0 = không hen)

Mục đích của ví dụ này là tận dụng Lasso để tạo ra một mô hình dự đoán tình trạng hen suyễn trẻ từ danh sách 6 biến dự báo tiềm năng ( age, gender, bmi_p, m_edu, p_edu, và f_color). Rõ ràng kích thước mẫu là một vấn đề ở đây, nhưng tôi hy vọng sẽ hiểu rõ hơn về cách xử lý các loại biến khác nhau (nghĩa là liên tục, thứ tự, danh nghĩa và nhị phân) trong glmnetkhung khi kết quả là nhị phân (1 = hen ; 0 = không hen suyễn).

Như vậy, liệu có ai sẵn sàng cung cấp một Rtập lệnh mẫu cùng với các giải thích cho ví dụ giả này bằng cách sử dụng LASSO với dữ liệu trên để dự đoán tình trạng hen suyễn không? Mặc dù rất cơ bản, tôi biết tôi, và có thể nhiều người khác trong CV, sẽ đánh giá rất cao điều này!

library(glmnet)

age     <- c(4, 8, 7, 12, 6, 9, 10, 14, 7) 
gender  <- as.factor(c(1, 0, 1, 1, 1, 0, 1, 0, 0))
bmi_p   <- c(0.86, 0.45, 0.99, 0.84, 0.85, 0.67, 0.91, 0.29, 0.88) 
m_edu   <- as.factor(c(0, 1, 1, 2, 2, 3, 2, 0, 1))
p_edu   <- as.factor(c(0, 2, 2, 2, 2, 3, 2, 0, 0))
f_color <- as.factor(c("blue", "blue", "yellow", "red", "red", "yellow", 
                       "yellow", "red", "yellow"))
asthma <- c(1, 1, 0, 1, 0, 0, 0, 1, 1)

xfactors <- model.matrix(asthma ~ gender + m_edu + p_edu + f_color)[, -1]
x        <- as.matrix(data.frame(age, bmi_p, xfactors))

# Note alpha=1 for lasso only and can blend with ridge penalty down to
# alpha=0 ridge only.
glmmod <- glmnet(x, y=as.factor(asthma), alpha=1, family="binomial")

# Plot variable coefficients vs. shrinkage parameter lambda.
plot(glmmod, xvar="lambda")

Các biến phân loại thường được chuyển đổi đầu tiên thành các yếu tố, sau đó một ma trận biến giả của các yếu tố dự đoán được tạo ra và cùng với các yếu tố dự đoán liên tục, được truyền cho mô hình. Hãy nhớ rằng, glmnet sử dụng cả hình phạt sườn núi và lasso, nhưng có thể được đặt thành một mình.

Một số kết quả:

# Model shown for lambda up to first 3 selected variables.
# Lambda can have manual tuning grid for wider range.

glmmod
# Call:  glmnet(x = x, y = as.factor(asthma), family = "binomial", alpha = 1) 
# 
#        Df    %Dev   Lambda
#   [1,]  0 0.00000 0.273300
#   [2,]  1 0.01955 0.260900
#   [3,]  1 0.03737 0.249000
#   [4,]  1 0.05362 0.237700
#   [5,]  1 0.06847 0.226900
#   [6,]  1 0.08204 0.216600
#   [7,]  1 0.09445 0.206700
#   [8,]  1 0.10580 0.197300
#   [9,]  1 0.11620 0.188400
#  [10,]  3 0.13120 0.179800
#  [11,]  3 0.15390 0.171600
# ...

Các hệ số có thể được trích xuất từ ​​glmmod. Ở đây hiển thị với 3 biến được chọn.

coef(glmmod)[, 10]
#   (Intercept)           age         bmi_p       gender1        m_edu1 
#    0.59445647    0.00000000    0.00000000   -0.01893607    0.00000000 
#        m_edu2        m_edu3        p_edu2        p_edu3    f_colorred 
#    0.00000000    0.00000000   -0.01882883    0.00000000    0.00000000 
# f_coloryellow 
#   -0.77207831 

Cuối cùng, xác nhận chéo cũng có thể được sử dụng để chọn lambda.

cv.glmmod <- cv.glmnet(x, y=asthma, alpha=1)
plot(cv.glmmod)

(best.lambda <- cv.glmmod$lambda.min)
# [1] 0.2732972

Tôi sẽ sử dụng gói enet vì đó là phương thức được ưu tiên của tôi. Nó linh hoạt hơn một chút.

install.packages('elasticnet')
library(elasticnet)

age <- c(4,8,7,12,6,9,10,14,7) 
gender <- c(1,0,1,1,1,0,1,0,0)
bmi_p <- c(0.86,0.45,0.99,0.84,0.85,0.67,0.91,0.29,0.88)
m_edu <- c(0,1,1,2,2,3,2,0,1)
p_edu <- c(0,2,2,2,2,3,2,0,0)
#f_color <- c("blue", "blue", "yellow", "red", "red", "yellow", "yellow", "red", "yellow")
f_color <- c(0, 0, 1, 2, 2, 1, 1, 2, 1)
asthma <- c(1,1,0,1,0,0,0,1,1)
pred <- cbind(age, gender, bmi_p, m_edu, p_edu, f_color)



enet(x=pred, y=asthma, lambda=0)

Chỉ để mở rộng trên ví dụ tuyệt vời được cung cấp bởi pat. Vấn đề ban đầu đặt ra các biến số thứ tự (m_edu, p_edu), với một trật tự vốn có giữa các cấp độ (0 <1 <2 <3). Trong câu trả lời ban đầu của pat tôi nghĩ rằng chúng được coi là các biến phân loại danh nghĩa không có thứ tự giữa chúng. Tôi có thể sai, nhưng tôi tin rằng các biến này nên được mã hóa sao cho mô hình tôn trọng trật tự vốn có của chúng. Nếu các yếu tố này được mã hóa thành các yếu tố theo thứ tự (chứ không phải là các yếu tố không được sắp xếp như trong câu trả lời của pat) thì glmnet cho kết quả hơi khác nhau ... Tôi nghĩ rằng mã dưới đây bao gồm chính xác các biến thứ tự là các yếu tố được đặt hàng và nó cho kết quả hơi khác:

library(glmnet)

age     <- c(4, 8, 7, 12, 6, 9, 10, 14, 7) 
gender  <- as.factor(c(1, 0, 1, 1, 1, 0, 1, 0, 0))
bmi_p   <- c(0.86, 0.45, 0.99, 0.84, 0.85, 0.67, 0.91, 0.29, 0.88) 
m_edu   <- factor(c(0, 1, 1, 2, 2, 3, 2, 0, 1), 
                  ordered = TRUE)
p_edu   <- factor(c(0, 2, 2, 2, 2, 3, 2, 0, 0), 
                  levels = c(0, 1, 2, 3), 
                  ordered = TRUE)
f_color <- as.factor(c("blue", "blue", "yellow", "red", "red", 
                       "yellow", "yellow", "red", "yellow"))
asthma <- c(1, 1, 0, 1, 0, 0, 0, 1, 1)

xfactors <- model.matrix(asthma ~ gender + m_edu + p_edu + f_color)[, -1]
x        <- as.matrix(data.frame(age, bmi_p, xfactors))

# Note alpha=1 for lasso only and can blend with ridge penalty down to
# alpha=0 ridge only.
glmmod <- glmnet(x, y=as.factor(asthma), alpha=1, family="binomial")

# Plot variable coefficients vs. shrinkage parameter lambda.
plot(glmmod, xvar="lambda")