- Ajuster un modèle de régression logistique à l’aide de la fonction glm avec l’option family=“binomial”.
# Charger les données depuis le fichier "diabetes.csv"
data <- read.table("diabetes.csv", sep = ",", header = TRUE)
# Assurez-vous que la variable 'Outcome' contient deux catégories distinctes (0 et 1)
table(data$Outcome)
##
## 0 1
## 500 268
# Ajuster un modèle de régression logistique
model <- glm(Outcome ~ ., data = data, family = "binomial")
# Afficher un résumé du modèle
summary(model)
##
## Call:
## glm(formula = Outcome ~ ., family = "binomial", data = data)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.5566 -0.7274 -0.4159 0.7267 2.9297
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -8.4046964 0.7166359 -11.728 < 2e-16 ***
## Pregnancies 0.1231823 0.0320776 3.840 0.000123 ***
## Glucose 0.0351637 0.0037087 9.481 < 2e-16 ***
## BloodPressure -0.0132955 0.0052336 -2.540 0.011072 *
## SkinThickness 0.0006190 0.0068994 0.090 0.928515
## Insulin -0.0011917 0.0009012 -1.322 0.186065
## BMI 0.0897010 0.0150876 5.945 2.76e-09 ***
## DiabetesPedigreeFunction 0.9451797 0.2991475 3.160 0.001580 **
## Age 0.0148690 0.0093348 1.593 0.111192
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 993.48 on 767 degrees of freedom
## Residual deviance: 723.45 on 759 degrees of freedom
## AIC: 741.45
##
## Number of Fisher Scoring iterations: 5
- Afficher les résultats à l’aide de la commande summary.
# Afficher un résumé du modèle
summary(model)
##
## Call:
## glm(formula = Outcome ~ ., family = "binomial", data = data)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.5566 -0.7274 -0.4159 0.7267 2.9297
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -8.4046964 0.7166359 -11.728 < 2e-16 ***
## Pregnancies 0.1231823 0.0320776 3.840 0.000123 ***
## Glucose 0.0351637 0.0037087 9.481 < 2e-16 ***
## BloodPressure -0.0132955 0.0052336 -2.540 0.011072 *
## SkinThickness 0.0006190 0.0068994 0.090 0.928515
## Insulin -0.0011917 0.0009012 -1.322 0.186065
## BMI 0.0897010 0.0150876 5.945 2.76e-09 ***
## DiabetesPedigreeFunction 0.9451797 0.2991475 3.160 0.001580 **
## Age 0.0148690 0.0093348 1.593 0.111192
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 993.48 on 767 degrees of freedom
## Residual deviance: 723.45 on 759 degrees of freedom
## AIC: 741.45
##
## Number of Fisher Scoring iterations: 5
- Calculer les odds-ratios et leurs intervalles de confiance (utiliser la fonction confint)
# Calculer les odds-ratios et leurs intervalles de confiance
odds_ratios <- exp(coef(model))
conf_intervals <- exp(confint(model))
## Waiting for profiling to be done...
# Afficher les résultats
results <- data.frame(Odds_Ratio = odds_ratios,
Lower_CI = conf_intervals[, 1],
Upper_CI = conf_intervals[, 2])
print(results)
## Odds_Ratio Lower_CI Upper_CI
## (Intercept) 0.0002238137 5.220567e-05 0.0008690532
## Pregnancies 1.1310905981 1.062812e+00 1.2054534756
## Glucose 1.0357892688 1.028491e+00 1.0435726573
## BloodPressure 0.9867924485 9.765958e-01 0.9969008370
## SkinThickness 1.0006191560 9.872327e-01 1.0143130404
## Insulin 0.9988090108 9.970375e-01 1.0005823121
## BMI 1.0938471417 1.062739e+00 1.1275654616
## DiabetesPedigreeFunction 2.5732758592 1.441047e+00 4.6583260840
## Age 1.0149800983 9.965029e-01 1.0337433880
# Calculer l'odds-ratio de l'intercept
intercept_odds_ratio <- exp(coef(model)[1])
# Afficher l'odds-ratio de l'intercept
cat("Odds-Ratio de l'intercept :", intercept_odds_ratio, "\n")
## Odds-Ratio de l'intercept : 0.0002238137
# Créez un jeu de données
y <- c(1, 2, 3, 4, 5) # Variable dépendante (à prédire)
# Effectuez une régression linéaire simple
modele_regression <- lm(y ~ 1) # "1" indique qu'il n'y a pas de covariables
# Affichez les résultats de la régression
summary(modele_regression)
##
## Call:
## lm(formula = y ~ 1)
##
## Residuals:
## 1 2 3 4 5
## -2.00e+00 -1.00e+00 2.22e-16 1.00e+00 2.00e+00
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.0000 0.7071 4.243 0.0132 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.581 on 4 degrees of freedom
- Interpréter les sorties. Quels semblent être les facteurs de risque du diabète ? Exhiber des profils d’individus particulièrement à risque d’être diabétiques.
## Intercept (Constante) :
# L'intercept représente la log-odds de diabète lorsque toutes les autres variables explicatives sont égales à zéro. Dans ce modèle, l'intercept est très proche de zéro, ce qui signifie que le risque de diabète est très faible lorsque toutes les autres variables sont nulles.
## Pregnancies :
#L'odds-ratio pour les grossesses est de 1.13. Cela signifie qu'une augmentation d'une unité dans le nombre de grossesses est associée à une augmentation de 13% du risque de diabète, toutes choses étant égales par ailleurs.
## Glucose :
# L'odds-ratio pour la glycémie (Glucose) est de 1.04. Cela signifie qu'une augmentation d'une unité de la glycémie est associée à une augmentation de 4% du risque de diabète.
## BloodPressure :
# L'odds-ratio pour la pression artérielle (BloodPressure) est de 0.99. Cela suggère qu'une augmentation d'une unité de la pression artérielle est légèrement associée à une réduction de 1% du risque de diabète, bien que cela puisse ne pas être cliniquement significatif.
## SkinThickness et Insulin :
# Les odds-ratios pour ces deux variables sont proches de 1, ce qui indique qu'elles ont peu d'impact sur le risque de diabète lorsque toutes les autres variables sont prises en compte.
## BMI :
# L'odds-ratio pour l'indice de masse corporelle (BMI) est de 1.09. Cela suggère qu'une augmentation d'une unité de BMI est associée à une augmentation de 9% du risque de diabète.
## DiabetesPedigreeFunction :
# L'odds-ratio pour la fonction de généalogie du diabète (DiabetesPedigreeFunction) est de 2.57. Cela signifie qu'une augmentation d'une unité de cette fonction est associée à une augmentation substantielle de 157% du risque de diabète.
## Age :
# L'odds-ratio pour l'âge est de 1.01. Cela indique qu'une augmentation d'une unité d'âge est associée à une augmentation de 1% du risque de diabète.
- Proposer une méthode de sélection de variables permettant de construire le meilleur sous-modèle au sens de la prédiction du diabète. On gardera ce sous modèle dans la suite de l’exercice.
# Ajuster un modèle initial avec toutes les variables
initial_model <- glm(Outcome ~ ., data = data, family = "binomial")
# Effectuer une sélection ascendante automatique
final_model <- step(initial_model, direction = "forward", scope = formula(initial_model))
## Start: AIC=741.45
## Outcome ~ Pregnancies + Glucose + BloodPressure + SkinThickness +
## Insulin + BMI + DiabetesPedigreeFunction + Age
# Résumé du modèle final
summary(final_model)
##
## Call:
## glm(formula = Outcome ~ Pregnancies + Glucose + BloodPressure +
## SkinThickness + Insulin + BMI + DiabetesPedigreeFunction +
## Age, family = "binomial", data = data)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.5566 -0.7274 -0.4159 0.7267 2.9297
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -8.4046964 0.7166359 -11.728 < 2e-16 ***
## Pregnancies 0.1231823 0.0320776 3.840 0.000123 ***
## Glucose 0.0351637 0.0037087 9.481 < 2e-16 ***
## BloodPressure -0.0132955 0.0052336 -2.540 0.011072 *
## SkinThickness 0.0006190 0.0068994 0.090 0.928515
## Insulin -0.0011917 0.0009012 -1.322 0.186065
## BMI 0.0897010 0.0150876 5.945 2.76e-09 ***
## DiabetesPedigreeFunction 0.9451797 0.2991475 3.160 0.001580 **
## Age 0.0148690 0.0093348 1.593 0.111192
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 993.48 on 767 degrees of freedom
## Residual deviance: 723.45 on 759 degrees of freedom
## AIC: 741.45
##
## Number of Fisher Scoring iterations: 5
- Construire un échantillon d’apprentissage contenant 80% des données et un échantillon de test contenant les 20% des données restantes. Construire une règle de classification à partir de l’échantillon d’apprentissage et évaluer le taux de mauvaise classification sur les données test. On pourra pour cela utiliser la fonction predict permettant de prédire pour tout individu de l’échantillon test sa probabilité d’être diabétique.
# Diviser les données en échantillon d'apprentissage (80%) et échantillon de test (20%)
set.seed(123) # Pour la reproductibilité
sample_indices <- sample(nrow(data), size = 0.8 * nrow(data)) # 80% pour l'apprentissage
apprentissage <- data[sample_indices, ]
test <- data[-sample_indices, ]
# Ajuster un modèle de régression logistique sur l'échantillon d'apprentissage
model_apprentissage <- glm(Outcome ~ ., data = apprentissage, family = "binomial")
# Prédire les classes (0 ou 1) pour l'échantillon de test
classes_predites <- predict(model_apprentissage, newdata = test, type = "response")
classes_predites <- ifelse(classes_predites > 0.5, 1, 0)
# Calculer le taux de mauvaise classification
taux_mauvaise_classification <- mean(classes_predites != test$Outcome)
cat("Taux de mauvaise classification sur l'échantillon de test :", taux_mauvaise_classification, "\n")
## Taux de mauvaise classification sur l'échantillon de test : 0.2077922
## Le résultat obtenu est d'environ 20.78%. Cela signifie que le modèle de régression logistique ajusté sur l'échantillon d'apprentissage a une précision d'environ 79.22% pour prédire le statut diabétique sur l'échantillon de test.
- Comparer avec l’algorithme des k-plus proches voisins, pour la valeur de k obtenu au TP précédent. Comparer les taux de mauvaise classification.
library(class)
## Warning: le package 'class' a été compilé avec la version R 4.1.3
#Ajuster un modèle k-NN sur l'échantillon d'apprentissage en utilisant la valeur de k obtenue au TP précédent.
k_value <- 3 # la valeur de k appropriée tp1
model_knn <- knn(train = apprentissage[, -9], test = test[, -9], cl = apprentissage$Outcome, k = k_value)
#Calculer le taux de mauvaise classification pour le modèle k-NN sur l'échantillon de test :
taux_mauvaise_classification_knn <- mean(model_knn != test$Outcome)
cat("Taux de mauvaise classification avec k-NN sur l'échantillon de test :", taux_mauvaise_classification_knn, "\n")
## Taux de mauvaise classification avec k-NN sur l'échantillon de test : 0.2792208
#Le taux de mauvaise classification obtenu avec k-NN est d'environ 27.92%.
#Le taux de mauvaise classification obtenu avec le modèle de régression logistique est d'environ 20.78%, tandis que le taux de mauvaise classification obtenu avec le modèle k-NN (avec k = 3) est d'environ 27.92%.
#En comparant ces deux taux, on peut constater que le modèle de régression logistique semble offrir de meilleures performances de classification sur cet ensemble de données par rapport au modèle k-NN avec k = 3. Un taux de mauvaise classification plus bas indique généralement une meilleure capacité de prédiction.
- Question bonus : A l’aide d’une boucle for, faire varier le seuil utilisé dans le critère de classification et calculer la sensibilité et la spécificité pour chacune des valeurs de seuil possible. A partir de ce résultat, tracer la courbe ROC du modèle.
# Ajuster le modèle de régression logistique sur l'échantillon d'apprentissage
model_apprentissage <- glm(Outcome ~ ., data = apprentissage, family = "binomial")
# Prédire les probabilités de classe pour l'échantillon de test
probas_predites <- predict(model_apprentissage, newdata = test, type = "response")
# Créer une séquence de seuils de 0 à 1 avec un pas de 0.05
seuils <- seq(0, 1, by = 0.05)
# Initialiser des vecteurs pour stocker les valeurs de sensibilité et de spécificité
sensibilite <- numeric(length(seuils))
specificite <- numeric(length(seuils))
# Parcourir les différents seuils
for (i in 1:length(seuils)) {
# Appliquer le seuil actuel pour obtenir les prédictions de classe
predictions <- ifelse(probas_predites > seuils[i], 1, 0)
# Calculer la matrice de confusion
matrice_confusion <- table(predictions, test$Outcome)
# Vérifier que la matrice de confusion a les éléments nécessaires
if (nrow(matrice_confusion) == 2 && ncol(matrice_confusion) == 2) {
# Calculer la sensibilité et la spécificité
sensibilite[i] <- matrice_confusion[2, 2] / sum(matrice_confusion[2, ])
specificite[i] <- matrice_confusion[1, 1] / sum(matrice_confusion[1, ])
} else {
# Si la matrice de confusion n'a pas les éléments nécessaires, mettre les valeurs à NA
sensibilite[i] <- NA
specificite[i] <- NA
}
}
# Tracer la courbe ROC
plot(1 - specificite, sensibilite, type = "l",
main = "Courbe ROC du modèle de régression logistique",
xlab = "1 - Spécificité", ylab = "Sensibilité")
