Un exemple: régression LASSO utilisant glmnet pour les résultats binaires

Je commence à me familiariser avec l’utilisation de glmnetavec LASSO Regression, où mon résultat d’intérêt est dichotomique. J'ai créé un petit cadre de données fictif ci-dessous:

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)

Les colonnes (variables) de l'ensemble de données ci-dessus sont les suivantes:

• age (âge de l'enfant en années) - continu
• gender - binaire (1 = mâle; 0 = femelle)
• bmi_p (Percentile IMC) - continu
• m_edu (niveau d'éducation le plus élevé de la mère) - ordinal (0 = inférieur au lycée; 1 = diplôme d'études secondaires; 2 = baccalauréat; 3 = diplôme post-baccalauréat)
• p_edu (niveau d'éducation le plus élevé du père) - ordinal (identique à m_edu)
• f_color (couleur primaire préférée) - nominal ("bleu", "rouge" ou "jaune")
• asthma (statut de l'asthme de l'enfant) - binaire (1 = asthme; 0 = pas d'asthme)

L'objectif de cet exemple est d'utiliser Lasso pour créer un modèle prédictif de l' état de l' asthme de l' enfant dans la liste des 6 variables prédictives potentiels ( age, gender, bmi_p, m_edu, p_eduet f_color). Évidemment, la taille de l'échantillon est un problème ici, mais j'espère mieux comprendre comment gérer les différents types de variables (c.-à-d. Continues, ordinales, nominales et binaires) dans le glmnetcadre lorsque le résultat est binaire (1 = asthme 0 = pas d'asthme).

En tant que tel, est-ce que n'importe qui serait disposé à fournir un exemple de Rscript avec des explications pour cet exemple factice utilisant LASSO avec les données ci-dessus pour prédire le statut d'asthme? Bien que très basique, je sais que moi-même et probablement beaucoup d’autres sur CV apprécierions beaucoup cela!

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

Les variables catégorielles sont généralement d'abord transformées en facteurs, puis une matrice de variables indicatrices factices est créée et, avec les prédicteurs continus, est transmise au modèle. Gardez à l'esprit que glmnet utilise les pénalités de crête et de lasso, mais peut être réglé sur l'une ou l'autre.

Quelques résultats:

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

Les coefficients peuvent être extraits du glmmod. Ici montré avec 3 variables sélectionnées.

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 

Enfin, la validation croisée peut également être utilisée pour sélectionner lambda.

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

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

Je vais utiliser le paquet enet puisque c'est ma méthode préférée. C'est un peu plus flexible.

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)

Juste pour développer l'excellent exemple fourni par pat. Le problème original posait des variables ordinales (m_edu, p_edu), avec un ordre inhérent entre les niveaux (0 <1 <2 <3). Dans la réponse originale de pat, je pense qu'elles ont été traitées comme des variables nominales nominales sans ordre entre elles. Je me trompe peut-être, mais je crois que ces variables devraient être codées de manière à ce que le modèle respecte leur ordre inhérent. Si ceux-ci sont codés comme des facteurs ordonnés (plutôt que comme des facteurs non ordonnés comme dans la réponse de pat), alors glmnet donne des résultats légèrement différents ... Je pense que le code ci-dessous inclut correctement les variables ordinales en tant que facteurs ordonnés, et donne des résultats légèrement différents:

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