Un esempio: regressione di LASSO utilizzando glmnet per il risultato binario

Sto iniziando a dilettarsi con l'uso di glmnetcon LASSO Regressione dove il mio risultato di interesse è dicotomica. Di seguito ho creato un piccolo frame di dati finti:

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)

Le colonne (variabili) nel set di dati sopra sono le seguenti:

• age (età del bambino in anni) - continua
• gender - binario (1 = maschio; 0 = femmina)
• bmi_p (BMI percentile) - continuo
• m_edu (livello di istruzione superiore della madre) - ordinale (0 = inferiore alla scuola superiore; 1 = diploma di scuola superiore; 2 = diploma di laurea; 3 = diploma post-diploma di maturità)
• p_edu (livello di istruzione superiore del padre) - ordinale (uguale a m_edu)
• f_color (colore primario preferito) - nominale ("blu", "rosso" o "giallo")
• asthma (stato dell'asma infantile) - binario (1 = asma; 0 = nessun asma)

L'obiettivo di questo esempio è di fare uso di LASSO per creare un modello di predire lo stato del bambino asma dalla lista delle 6 variabili potenziali predittori ( age, gender, bmi_p, m_edu, p_edu, e f_color). Ovviamente la dimensione del campione è un problema qui, ma spero di ottenere maggiori informazioni su come gestire i diversi tipi di variabili (cioè, continuo, ordinale, nominale e binario) all'interno del glmnetframework quando il risultato è binario (1 = asma ; 0 = nessun asma).

Come tale, qualcuno sarebbe disposto a fornire uno Rscript di esempio insieme alle spiegazioni per questo esempio falso usando LASSO con i dati sopra per prevedere lo stato dell'asma? Anche se molto semplice, lo so, e probabilmente molti altri su CV, lo apprezzerei molto!

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

Le variabili categoriche di solito vengono prima trasformate in fattori, quindi viene creata una matrice variabile fittizia di predittori e insieme ai predittori continui viene passata al modello. Tieni presente che glmnet utilizza entrambe le penalità di cresta e lazo, ma può essere impostato su uno solo.

Alcuni risultati:

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

I coefficienti possono essere estratti dal glmmod. Qui mostrato con 3 variabili selezionate.

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 

Infine, la validazione incrociata può anche essere usata per selezionare lambda.

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

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

Userò il pacchetto enet poiché quello è il mio metodo preferito. È un po 'più flessibile.

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)

Solo per espandere l'eccellente esempio fornito da pat. Il problema originale presentava variabili ordinali (m_edu, p_edu), con un ordine intrinseco tra i livelli (0 <1 <2 <3). Nella risposta originale di Pat penso che queste siano state trattate come variabili nominali categoriche senza alcun ordine tra loro. Potrei sbagliarmi, ma credo che queste variabili debbano essere codificate in modo tale che il modello rispetti il ​​loro ordine intrinseco. Se questi sono codificati come fattori ordinati (piuttosto che come fattori non ordinati come nella risposta di pat) allora glmnet dà risultati leggermente diversi ... Penso che il codice qui sotto includa correttamente le variabili ordinali come fattori ordinati, e dà risultati leggermente diversi:

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