Contoh: regresi LASSO menggunakan glmnet untuk hasil biner

Saya mulai mencoba-coba penggunaan glmnetdengan LASSO Regression di mana hasil yang saya minati menjadi dikotomis. Saya telah membuat bingkai data mock kecil di bawah ini:

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)

Kolom (variabel) dalam dataset di atas adalah sebagai berikut:

• age (usia anak dalam tahun) - terus menerus
• gender - biner (1 = laki-laki; 0 = perempuan)
• bmi_p (Persentase BMI) - kontinyu
• m_edu (tingkat pendidikan tertinggi ibu) - ordinal (0 = kurang dari sekolah tinggi; 1 = ijazah sekolah tinggi; 2 = gelar sarjana; 3 = gelar pasca sarjana muda)
• p_edu (tingkat pendidikan tertinggi ayah) - ordinal (sama dengan m_edu)
• f_color (warna primer favorit) - nominal ("biru", "merah", atau "kuning")
• asthma (status asma anak) - biner (1 = asma; 0 = tidak ada asma)

Tujuan dari contoh ini adalah untuk memanfaatkan Lasso untuk membuat model memprediksi Status asma anak dari daftar 6 variabel prediktor potensial ( age, gender, bmi_p, m_edu, p_edu, dan f_color). Jelas ukuran sampel adalah masalah di sini, tetapi saya berharap untuk mendapatkan lebih banyak wawasan tentang bagaimana menangani berbagai jenis variabel (yaitu, kontinu, ordinal, nominal, dan biner) dalam glmnetkerangka kerja ketika hasilnya adalah biner (1 = asma ; 0 = tidak ada asma).

Dengan demikian, apakah ada orang yang bersedia memberikan Rskrip sampel bersama dengan penjelasan untuk contoh tiruan ini menggunakan LASSO dengan data di atas untuk memprediksi status asma? Meskipun sangat mendasar, saya tahu saya, dan kemungkinan banyak orang lain di CV, akan sangat menghargai ini!

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

Variabel kategorikal biasanya pertama-tama ditransformasikan menjadi faktor, kemudian matriks variabel tiruan dari prediktor dibuat dan bersama dengan prediktor kontinu, diteruskan ke model. Perlu diingat, glmnet menggunakan penalti ridge dan laso, tetapi dapat diatur untuk keduanya saja.

Beberapa hasil:

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

Koefisien dapat diekstraksi dari glmmod. Di sini ditunjukkan dengan 3 variabel yang dipilih.

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 

Terakhir, validasi silang juga dapat digunakan untuk memilih lambda.

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

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

Saya akan menggunakan paket enet karena itu adalah metode yang saya pilih. Ini sedikit lebih fleksibel.

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)

Hanya untuk memperluas contoh luar biasa yang diberikan oleh tepuk. Masalah asli menimbulkan variabel ordinal (m_edu, p_edu), dengan urutan bawaan antar level (0 <1 <2 <3). Dalam jawaban asli pat, saya pikir ini diperlakukan sebagai variabel kategori nominal tanpa urutan di antara mereka. Saya mungkin salah, tetapi saya percaya variabel-variabel ini harus dikodekan sedemikian sehingga model menghormati urutan bawaannya. Jika ini dikodekan sebagai faktor yang diurutkan (bukan sebagai faktor yang tidak berurutan seperti dalam jawaban pat) maka glmnet memberikan hasil yang sedikit berbeda ... Saya pikir kode di bawah ini dengan benar memasukkan variabel ordinal sebagai faktor yang dipesan, dan itu memberikan hasil yang sedikit berbeda:

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