ตัวอย่าง: การถดถอย LASSO โดยใช้ glmnet สำหรับผลลัพธ์ไบนารี

ฉันเริ่มตะลุยกับการใช้งานglmnetกับการถดถอยแบบ LASSOซึ่งผลลัพธ์ของความสนใจของฉันนั้นเป็นแบบขั้วคู่ ฉันได้สร้างกรอบข้อมูลจำลองขนาดเล็กด้านล่าง:

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)

คอลัมน์ (ตัวแปร) ในชุดข้อมูลด้านบนมีดังนี้:

• age (อายุของเด็กเป็นปี) - ต่อเนื่อง
• gender - ไบนารี (1 = ชาย; 0 = หญิง)
• bmi_p (BMI เปอร์เซ็นไทล์) - ต่อเนื่อง
• m_edu (ระดับการศึกษาสูงสุดของมารดา) - ลำดับ (0 = น้อยกว่าโรงเรียนมัธยม 1 = อนุปริญญามัธยมปลาย 2 = ระดับปริญญาตรี 3 = ปริญญาระดับหลังปริญญา)
• p_edu (พ่อระดับการศึกษาสูงสุด) - ลำดับ (เหมือนกับ m_edu)
• f_color (สีหลักโปรด) - ระบุ ("สีน้ำเงิน", "สีแดง" หรือ "สีเหลือง")
• asthma (สถานะเด็กโรคหอบหืด) - ไบนารี (1 = asthma; 0 = ไม่มีโรคหอบหืด)

เป้าหมายของตัวอย่างนี้คือการทำให้การใช้เชือกในการสร้างแบบจำลองทำนายภาวะเด็กโรคหอบหืดจากรายการ 6 ตัวแปรที่มีศักยภาพ ( age, gender, bmi_p, m_edu, p_eduและf_color) เห็นได้ชัดว่าขนาดตัวอย่างเป็นปัญหาที่นี่ แต่ฉันหวังว่าจะได้รับข้อมูลเชิงลึกมากขึ้นเกี่ยวกับวิธีการจัดการตัวแปรประเภทต่างๆ (เช่นต่อเนื่องลำดับที่ระบุและไบนารี) ภายในglmnetกรอบเมื่อผลที่ได้คือไบนารี (1 = โรคหอบหืด ; 0 = ไม่มีโรคหอบหืด)

ดังนั้นทุกคนจะยินดีที่จะให้Rสคริปต์ตัวอย่างพร้อมกับคำอธิบายสำหรับตัวอย่างการเยาะเย้ยนี้โดยใช้ LASSO กับข้อมูลข้างต้นเพื่อทำนายสถานะโรคหอบหืด? แม้ว่าขั้นพื้นฐานมากฉันรู้ว่าฉันและมีแนวโน้มที่คนอื่น ๆ ใน CV จะขอบคุณมากนี้!

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")

ตัวแปรหมวดหมู่มักจะถูกแปรสภาพเป็นปัจจัยแรกจากนั้นจะสร้างเมทริกซ์ตัวแปรจำลองของตัวทำนายและตามด้วยตัวทำนายแบบต่อเนื่องจะถูกส่งผ่านไปยังแบบจำลอง โปรดจำไว้ว่า glmnet ใช้ทั้งบทลงโทษสันเขาและบ่วงบาศ แต่สามารถกำหนดให้เป็นแบบเดี่ยวก็ได้

ผลลัพธ์บางส่วน:

# 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
# ...

ค่าสัมประสิทธิ์สามารถสกัดได้จาก glmmod แสดงที่นี่ด้วย 3 ตัวแปรที่เลือก

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 

สุดท้ายการตรวจสอบข้ามยังสามารถใช้เพื่อเลือกแลมบ์ดา

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

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

ฉันจะใช้แพ็กเกจ enet เนื่องจากเป็นวิธีที่ฉันได้เลือกไว้ มันยืดหยุ่นเล็กน้อย

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)

เพียงแค่ขยายตัวอย่างที่ยอดเยี่ยมโดย pat ปัญหาดั้งเดิมถูกวางลำดับตัวแปร (m_edu, p_edu) โดยมีลำดับที่แท้จริงระหว่างระดับ (0 <1 <2 <3) ในคำตอบดั้งเดิมของ pat ฉันคิดว่าสิ่งเหล่านี้ถือว่าเป็นตัวแปรเด็ดขาดเล็กน้อยโดยไม่มีคำสั่งระหว่างพวกเขา ฉันอาจจะผิด แต่ฉันเชื่อว่าตัวแปรเหล่านี้ควรได้รับการกำหนดรหัสเพื่อให้โมเดลเคารพลำดับที่แท้จริงของพวกเขา ถ้าสิ่งเหล่านี้ถูกเขียนเป็นปัจจัยสั่ง (แทนที่จะเป็นปัจจัยที่ไม่ได้จัดเรียงตามคำตอบของ pat) จากนั้น glmnet ให้ผลลัพธ์ที่แตกต่างกันเล็กน้อย ... ฉันคิดว่ารหัสด้านล่างถูกต้องรวมถึงตัวแปรลำดับที่เป็นปัจจัยสั่งและมันให้ผลลัพธ์ที่แตกต่างกันเล็กน้อย:

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")