UTILISATION DE LA REGRESSION LOGISTIQUE MULTIPLE POUR EXAMINER LA RELATION ENTRE LE RYTHME CARDIAQUE ET LA MALADIE CARDIAQUE
Afouda Josue
1 janvier 2020
Introduction -Objectif
Les statistiques prouvent que les maladies cardiaques constituent la plus grande cause de mortalité aux Etats-Unis et aussi dans le monde entier. Nous disposons d’un ensemble de donnés sur des individus malades ou non en fonction de certains attributs comme le sexe, l’âge, le cholestérol, la pression sanguine, etc. L’objectif de cette étude est d’utiliser un modèle de régression logistique multiple pour prédire la probabilité de contracter une maladie cardiaque.
Le choix de la Régression multiple logistique n’est pas anodin.En général, on utilise cette technique lorsque nous avons une variable binaire et deux ou plusieurs variables prédictives. La variable binaire est la variable dépendante (Y); nous étudions l’effet des variables indépendantes (X) sur la probabilité d’obtenir une valeur particulière de la variable dépendante.
Analyse exploratoire des données
Vue d’ensemble des données
#Importation des données
df <- read.csv("Cleveland_hd.csv")
#Vue d'ensemble des données
glimpse(df)## Observations: 303
## Variables: 14
## $ age <int> 63, 67, 67, 37, 41, 56, 62, 57, 63, 53, 57, 56, 56, 4...
## $ sex <int> 1, 1, 1, 1, 0, 1, 0, 0, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1,...
## $ cp <int> 1, 4, 4, 3, 2, 2, 4, 4, 4, 4, 4, 2, 3, 2, 3, 3, 2, 4,...
## $ trestbps <int> 145, 160, 120, 130, 130, 120, 140, 120, 130, 140, 140...
## $ chol <int> 233, 286, 229, 250, 204, 236, 268, 354, 254, 203, 192...
## $ fbs <int> 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 1, 0, 0, 0,...
## $ restecg <int> 2, 2, 2, 0, 2, 0, 2, 0, 2, 2, 0, 2, 2, 0, 0, 0, 0, 0,...
## $ thalach <int> 150, 108, 129, 187, 172, 178, 160, 163, 147, 155, 148...
## $ exang <int> 0, 1, 1, 0, 0, 0, 0, 1, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0,...
## $ oldpeak <dbl> 2.3, 1.5, 2.6, 3.5, 1.4, 0.8, 3.6, 0.6, 1.4, 3.1, 0.4...
## $ slope <int> 3, 2, 2, 3, 1, 1, 3, 1, 2, 3, 2, 2, 2, 1, 1, 1, 3, 1,...
## $ ca <int> 0, 3, 2, 0, 0, 0, 2, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0,...
## $ thal <int> 6, 3, 7, 3, 3, 3, 3, 3, 7, 7, 6, 3, 6, 7, 7, 3, 7, 3,...
## $ class <int> 0, 2, 1, 0, 0, 0, 3, 0, 2, 1, 0, 0, 2, 0, 0, 0, 1, 0,...Rendez-vous sur ce lien pour la description des variables et pour télécharger l’ensemble des données. Selon cette description, certaines variables comme le sex sont en réalité des variables catégorielles mais elles apparraissent ici en tant que variables numériques et seront traitées comme tel par le logiciel R. Il faudra corriger cela.
Par ailleurs la variable class est égale à 0 si l’individu n’a pas de maladie cardiaque et les valeurs 1 à 4 sont des degrés de maladie cardiaque. Pour faire simple on va créer une variable binaire mc (maladie cardiaque) qui est égale à 0 pour class == 0 et égale à 1 pour class > 0.
#Recodage de variables
df %>% mutate(mc = ifelse(class > 0, 1, 0))-> df
df %>% mutate(sex = factor(sex, levels = 0:1, labels = c("Female","Male")))-> df
df$cp <- as.factor(df$cp)
df$fbs <- as.factor(df$fbs)
df$exang <- as.factor(df$exang)
df$restecg <- as.factor(df$restecg)
df$slope <- as.factor(df$slope)
df$ca <- as.factor(df$ca)
df$thal <- as.factor(df$thal)
#Plus besoin de la variable 'class'
df <- df %>%
select(-class)
#Nouveau dataframe df
glimpse(df)## Observations: 303
## Variables: 14
## $ age <int> 63, 67, 67, 37, 41, 56, 62, 57, 63, 53, 57, 56, 56, 4...
## $ sex <fct> Male, Male, Male, Male, Female, Male, Female, Female,...
## $ cp <fct> 1, 4, 4, 3, 2, 2, 4, 4, 4, 4, 4, 2, 3, 2, 3, 3, 2, 4,...
## $ trestbps <int> 145, 160, 120, 130, 130, 120, 140, 120, 130, 140, 140...
## $ chol <int> 233, 286, 229, 250, 204, 236, 268, 354, 254, 203, 192...
## $ fbs <fct> 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 1, 0, 0, 0,...
## $ restecg <fct> 2, 2, 2, 0, 2, 0, 2, 0, 2, 2, 0, 2, 2, 0, 0, 0, 0, 0,...
## $ thalach <int> 150, 108, 129, 187, 172, 178, 160, 163, 147, 155, 148...
## $ exang <fct> 0, 1, 1, 0, 0, 0, 0, 1, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0,...
## $ oldpeak <dbl> 2.3, 1.5, 2.6, 3.5, 1.4, 0.8, 3.6, 0.6, 1.4, 3.1, 0.4...
## $ slope <fct> 3, 2, 2, 3, 1, 1, 3, 1, 2, 3, 2, 2, 2, 1, 1, 1, 3, 1,...
## $ ca <fct> 0, 3, 2, 0, 0, 0, 2, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0,...
## $ thal <fct> 6, 3, 7, 3, 3, 3, 3, 3, 7, 7, 6, 3, 6, 7, 7, 3, 7, 3,...
## $ mc <dbl> 0, 1, 1, 0, 0, 0, 1, 0, 1, 1, 0, 0, 1, 0, 0, 0, 1, 0,...La variable mc est maintenant notre variable cible.
Les variables prédictrices les plus importantes
Pour créer un modèle de régression, il est important de tester la liaison entres certaines variables et la variable d’intérêt (ou variable cible). Dans R, il y a deux fonctions simples qui vous permettent de le faire : t-test et chisq.test. Le t-test s’utilise pour les variables continues pour déterminer s’il existe une différence significative entre les moyennes de deux groupes (par exemple, l’âge moyen du groupe A est-il différent de l’âge moyen du groupe B?). Le chisq.test s’utilise pour les variables catégorielles. Il teste pour voir si les distributions des variables catégorielles diffèrent les unes des autres. Ces deux fonctions retournent la p-valeur et si cette p-valeur est inférieure à 0,05, on peut tirer la conclusion selon laquelle la variable testée est significativement associée à la variable cible. Ce faisant, le modèle sera créé avec uniquement les variables les plus statistiquement importantes.
#Test de l'association de la variable 'mc' avec toutes les variables numériques
df_num <- df %>%
select(-mc) %>%
select_if(is.numeric)
n_num <- ncol(df_num)
for (i in 1:n_num) {
print(names(df_num)[i])
print(t.test(x = df_num[i], df$mc))
}## [1] "age"
##
## Welch Two Sample t-test
##
## data: df_num[i] and df$mc
## t = 103.8, df = 303.84, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 52.95685 55.00355
## sample estimates:
## mean of x mean of y
## 54.4389439 0.4587459
##
## [1] "trestbps"
##
## Welch Two Sample t-test
##
## data: df_num[i] and df$mc
## t = 129.74, df = 302.49, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 129.2406 133.2215
## sample estimates:
## mean of x mean of y
## 131.6897690 0.4587459
##
## [1] "chol"
##
## Welch Two Sample t-test
##
## data: df_num[i] and df$mc
## t = 82.778, df = 302.06, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 240.3807 252.0880
## sample estimates:
## mean of x mean of y
## 246.6930693 0.4587459
##
## [1] "thalach"
##
## Welch Two Sample t-test
##
## data: df_num[i] and df$mc
## t = 113.47, df = 302.29, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 146.5619 151.7351
## sample estimates:
## mean of x mean of y
## 149.6072607 0.4587459
##
## [1] "oldpeak"
##
## Welch Two Sample t-test
##
## data: df_num[i] and df$mc
## t = 8.0004, df = 409.93, p-value = 1.285e-14
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.4381355 0.7235807
## sample estimates:
## mean of x mean of y
## 1.0396040 0.4587459#Test de l'association de la variable 'mc' avec toutes les variables catégorielles.
df_fact <- df %>%
select(-mc) %>%
select_if(is.factor)
n_fact <- ncol(df_fact)
for (i in 1:n_fact) {
print(names(df_fact)[i])
print(chisq.test(x = df_fact[i], df$mc))
}## [1] "sex"
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: df_fact[i] and df$mc
## X-squared = 22.043, df = 1, p-value = 2.667e-06
##
## [1] "cp"
##
## Pearson's Chi-squared test
##
## data: df_fact[i] and df$mc
## X-squared = 81.816, df = 3, p-value < 2.2e-16
##
## [1] "fbs"
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: df_fact[i] and df$mc
## X-squared = 0.077095, df = 1, p-value = 0.7813
##
## [1] "restecg"## Warning in chisq.test(x = df_fact[i], df$mc): Chi-squared approximation may
## be incorrect##
## Pearson's Chi-squared test
##
## data: df_fact[i] and df$mc
## X-squared = 10.052, df = 2, p-value = 0.006567
##
## [1] "exang"
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: df_fact[i] and df$mc
## X-squared = 54.686, df = 1, p-value = 1.414e-13
##
## [1] "slope"
##
## Pearson's Chi-squared test
##
## data: df_fact[i] and df$mc
## X-squared = 45.785, df = 2, p-value = 1.143e-10
##
## [1] "ca"
##
## Pearson's Chi-squared test
##
## data: df_fact[i] and df$mc
## X-squared = 71.843, df = 3, p-value = 1.72e-15
##
## [1] "thal"
##
## Pearson's Chi-squared test
##
## data: df_fact[i] and df$mc
## X-squared = 83.29, df = 2, p-value < 2.2e-16Toutes les p-valeurs des tests sont très largement inférieures à 0,001. Alors on peut considérer que toutes les variables prédictrices sont significativement associés à la variable cible mc.
Visualisation des données
Créons à présent quelques visuels de nos données.
#Création de la variable 'mc_label' étiquetée
df %>% mutate(mc_label = ifelse(mc == 1, "Malade", "Non Malade")) -> df
#age vs mc_label
ggplot(df, aes(mc_label, age)) +
geom_boxplot() +
labs(x = "Maladie Cardiaqe", y = "Âge")
On voit très bien que ceux qui sont malades ont tendances à être plus âgés que ceux qui ne le sont pas. L’âge est donc bel et bien un facteur de risque d’une maladie cardiaque.
#mc_label vs sex
ggplot(df, aes(mc_label, fill =sex)) +
geom_bar(position = "fill") +
labs(x = "Maladie cardiaque", y = "Proportion")
Ce graphique montre clairement le sex est un facteur de risque de survenue d’une maladie cardiaque. Parmi, les malades, il y a une très grande proportion (plus de 75%) d’hommes. De plus, il y a plus de femmes non-malades que d’hommes non-malades. On peut donc conclure que les maladies cardiaques sont plus fréquentes chez les hommes que chez les femmes.
#mc_label vs thalach.
ggplot(df, aes(mc_label, thalach)) +
geom_boxplot() +
labs(x = "Maladie cardiaque", y = "fréquence cardiaque maximale atteinte") +
ggtitle("Distribution de la fréquence cardiaque maximale atteinte en fonction de la présence ou non de maladie cardiaque")
La variable thalach désigne la fréquence maximale atteinte.
Les boîtes à moustaches montrent que l’exercice physique est aussi un facteur de survenue d’une maladie cardiaque. En effet, la fréquence maximale atteinte par les non-malades est supérieure à celle atteinte par les malades. Donc les malades cardiaques doivent faire attention pendant toutes activités sportives où le rythme cardiaque s’accélère.
#mc_label vs cp
ggplot(df, aes(mc_label, fill = cp)) +
geom_bar(position = "fill") +
labs(x = "Maladie cardiaque", y = "Proportion")
La variable cp désigne la douleur thoracique ressentie (Valeur 1: angine de poitrine typique, Valeur 2: angine de poitrine atypique, Valeur 3: douleur non angorale, Valeur 4: asymptomatique). 75% des personnes malades ont une douleur thoracique de niveau 4 (niveau le plus intense). Si on cumule avec ceux qui ont une douleur de niveau 3 on atteint un peu plus de 87,5% des personnes malades. Ce qui veut dire que la plupart des personnes malades ont des douleurs thoraciques extrêmement intenses Chez les non-malades, on a seulement environ 25% d’individus qui ont une douleur thoracique de niveau 4, environ 37,5% ont une douleur de niveau 3, un peu plus de 25% ont une douleur de niveau 2. Donc chez les non-malades, il n’ya pas vraiment une tendance qui se dégage c’est-à-dire que la douleur thoracique, même si elle plus accentuée chez les malades cardiaques est aussi présente chez les non-malades.
#trestbps vs mc_label
ggplot(df, aes(mc_label, trestbps)) +
geom_boxplot() +
labs(x = "Maladie cardiaque", y = "Pression artérielle au repos") +
ggtitle("Distribution de la pression artérielle au repos (en mm Hg à l'admission à l'hôpital) en fonction de la présence ou non de maladie cardiaque")
La figure montre que la pression artérielle au repos (variable trestbps) est quasiment la même aussi bien chez les malades cardiaques que chez les non malades. Même si ce la variable trestbps est statisquement associée à notre variable cible, la visualisation montre clairement qu’elle ne doit pas être priseen compte dans le modèle.
#chol vs mc_label
ggplot(df, aes(mc_label, chol)) +
geom_boxplot() +
labs(x = "Maladie cardiaque", y = "Cholestérol sérique en mg/l") +
ggtitle("Distribution du Cholestérol en fonction de la présence ou non de maladie cardiaque")
La concentration en cholestérol (variable chol) dans le sang des malades cardiaques est lègèrement supérieure à celle supérieure à celle des non-malades. On peut dire que le taux de cholestérol n’est pas tellement un paramètre propre aux maladies cardiaques.
#mc_label vs cp
ggplot(df, aes(mc_label, fill = fbs)) +
geom_bar(position = "fill") +
labs(x = "Maladie cardiaque", y = "Proportion")
Le taux de glycémie à jeun (> 120 mg / dl), variable fbs (1 = true; 0 = false), n’est pas un paramètre propre aux maladies cardiaques.
#mc_label vs restecg
ggplot(df, aes(mc_label, fill = restecg)) +
geom_bar(position = "fill") +
labs(x = "Maladie cardiaque", y = "Proportion")
La variable restecg désigne la mesure électrocardiographique au repos (0 = normale, 1 = présentant une anomalie de l’onde ST-T, 2 = montrant une hypertrophie ventriculaire gauche probable ou définitive selon les critères d’Estes)
#mc_label vs exang
ggplot(df, aes(mc_label, fill = exang)) +
geom_bar(position = "fill") +
labs(x = "Maladie cardiaque", y = "Proportion")
La variable exang désigne la présence ou non d’une angine de poitrine (1 = true, 0 = false). Trouvez ici une documentation sur l’angine de poitrine. Retenez que c’est une douleur qui signe un problème des artères coronaires. Le graphique montre clairement une trè faible proportion (environ 13%) des personnes non malades ont ce problème. Chez les malades, aucune tendance ne se dégage vraiment car on a une moitié qui présente l’angine et l’autre moitié qui ne souffre pas de cette affection.
#oldpeak vs mc_label
ggplot(df, aes(mc_label, oldpeak)) +
geom_boxplot() +
labs(x = "Maladie cardiaque", y = "Dépression ST induite par l'exercice par rapport au repos")
La variable oldpeak désigne la dépression ST induite par l’exercice physique par rapport au repos («ST» se rapporte aux positions sur le tracé ECG). Trouvez ici un article qui décrit ce paramètre. Le graphique montre que les personnes malades sont plus affectées par un exercice physique que les non malades. Trouvez ici une documentaion sur la dépression ST induite par l’exercice par rapport au repos.
Cela est aussi confirmé par la figure ci-dessous qui représente la variable slope (1 : montée ascendante, 2 : plate, 3: descente)) : pente du segment ST d’exercice maximal.
#slope vs mc_label
ggplot(df, aes(mc_label, fill = slope)) +
geom_bar(position = "fill") +
labs(x = "Maladie cardiaque", y = "Proportion")
#mc_label vs ca
ggplot(df, aes(mc_label, fill = ca)) +
geom_bar(position = "fill") +
labs(x = "Maladie cardiaque", y = "Proportion")
La variable ca désigne le nombre de grands vaisseaux (0-3) colorés par la fluorosopie.
#mc_label vs thal
ggplot(df, aes(mc_label, fill = thal)) +
geom_bar(position = "fill") +
labs(x = "Maladie cardiaque", y = "Proportion")
La variable thal désigne Un trouble sanguin appelé thalassémie (3 = normal; 6 = défaut corrigé; 7 = défaut irréversible). On remarque que chez plus de la moitié des malades cardiaques présentent la thalassémie irrévresible tandis que l plupart des personnes non-malades ont une thalassémie normale (plus de 75%).
Les graphiques nous ont permis de visualiser la relation entre chacune des potentielles variables prédictrices avec la vaiable cible. Passons à présent à la phase de modélisation.
Modélisation
En fonction des informations tirées lors de l’analyse exploratoire des données, dans un premier temps nous allons construire un modèle mc_label ~ age + sex + thalach et dans un second temps, nous rajouterons plus de complicité au premier modèle avec l’ajout d’autres variables prédictrices.
#Construction du modèle mc_label ~ age + sex + thalach
model1 <- glm(mc ~ age + sex + thalach, family = "binomial", data = df)
#Informations de model1
model1_tidy <- tidy(model1)
model1_tidy## # A tibble: 4 x 5
## term estimate std.error statistic p.value
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 (Intercept) 3.11 1.61 1.94 0.0529
## 2 age 0.0319 0.0164 1.94 0.0524
## 3 sexMale 1.49 0.307 4.86 0.00000119
## 4 thalach -0.0405 0.00707 -5.73 0.00000000993La table ci-dessus montre les paramètres du modèle. Quelles informations utiles peut-on tirer de ce modèle?
Il est courant dans la recherche médicale de rapporter le rapport de chances (Odd Ratio en anglais) pour quantifier à quel point la présence ou l’absence de la propriété A est associée à la présence ou à l’absence du résultat. Lorsque lerapport de chances est supérieur à 1, on dit que A est positivement associé au résultat B (augmente les chances d’avoir B). Sinon, on dit que A est négativement associé à B (diminue les chances d’avoir B). Le tableau des coefficients glm bruts dans R représente le log (rapport de chances) du résultat. Par conséquent, nous devons convertir les valeurs à l’échelle OR d’origine et calculer l’intervalle de confiance (IC) à 95% correspondant du rapport de chances estimé lors de la communication des résultats d’une régression logistique. Veuillez lire cet arrticle surle calcul de l’Intervalle de confiance de la proportion binomiale.
#Calcul rapports de chance 'OR'
model1_tidy$OR <- exp(model1_tidy$estimate)
#Calcul de l'intervalle de confiance à 95%
model1_tidy$lower_CI <- exp(model1_tidy$estimate - 1.96 * model1_tidy$std.error)
model1_tidy$upper_CI <- exp(model1_tidy$estimate + 1.96 * model1_tidy$std.error)
model1_tidy## # A tibble: 4 x 8
## term estimate std.error statistic p.value OR lower_CI upper_CI
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 (Interc~ 3.11 1.61 1.94 5.29e-2 22.5 0.962 524.
## 2 age 0.0319 0.0164 1.94 5.24e-2 1.03 1.000 1.07
## 3 sexMale 1.49 0.307 4.86 1.19e-6 4.45 2.43 8.12
## 4 thalach -0.0405 0.00707 -5.73 9.93e-9 0.960 0.947 0.974Nous allons à présent utiliser ce modèle pour prédire la probabilité qu’une personne souffre d’une maladie cardiaque compte tenu de son âge (age), de son sexe (sex) et de sa fréquence cardiaque maximale (thalach). De plus, nous allons traduire la probabilité prédite en une règle de décision à usage clinique en définissant une valeur seuil sur l’échelle de probabilité. En pratique, lorsqu’une personne se présente pour un bilan de santé, le médecin souhaite connaître la probabilité prédite de maladie cardiaque, pour des valeurs spécifiques des prédicteurs : par exemple une femme de 45 ans avec une fréquence cardiaque maximale de 150.
#Probabilités prédictes dans notre ensemble de données
prob_pred <- predict(model1, data = df, type = "response")
#Création d'une règle de décision pour dire qu'une personne est malade si prod_pred >= 0,5 et non-malade dans le cas-contraire.
df$pred_mc <- ifelse(prob_pred >= 0.5, 1, 0)
#Probabilité qu'une femme de 45 ans avec une fréquence cardiaque maximale de 150 soit malade
test_data <- data.frame(age = 45, sex = "Female", thalach = 150)
prob_new <- predict(model1, newdata = test_data, type = "response")
prob_new## 1
## 0.1773002Selon le modèle, la probabilité qu’une femme de 45 ans avec une fréquence cardiaque maximale de 150 soit malade est de 0,177.
Comprenez ceci : La colonne mc donne les réelles personnes malades et non-malades. La colonne pred_mc donne les personnes malades et non-malades selon notre modèle. Il s’agira donc de voir si le modèle a bien classé les individus.
Il exite plusieurs mesures pour évaluer la qualité d’un modèle. Ici, nous calculerons la précion du modèle, l’erreur de classification, l’Aire sous la courbe ROC (AUC en Anglais) et la matrice de confusion.
#Calcul de la précision
precision1 <-accuracy(df$mc, df$pred_mc)
#Erreur de classification (1 - précision)
erreur1 <- 1 - precision1
#Aire sous la courbe ROC
auc1 <- auc(df$mc, df$pred_mc)
#Affichage des paramètres
print(paste("La Précision du modèle1 est : ", precision1))## [1] "La Précision du modèle1 est : 0.70957095709571"print(paste("L'Erreur de Classification du modèle 1 est : ", erreur1))## [1] "L'Erreur de Classification du modèle 1 est : 0.29042904290429"print(paste("L'Aire sous la courbe ROC du Modèle 1 est : ", auc1))## [1] "L'Aire sous la courbe ROC du Modèle 1 est : 0.706483593612915"#Matrice de confusion
mconfusion1 <- table(df$mc, df$pred_mc, dnn=c("Vrai Statut","Statut prédit"))
mconfusion1## Statut prédit
## Vrai Statut 0 1
## 0 122 42
## 1 46 93Avec une précision globale d’environ 71%, le modèle a prédit à tort l’état de santé de 29% des individus de l’ensemble de données. Globalement, on peut dire que le modèle est acceptable mais en réalité il n’est pas réellement satisfaisant. Car on est dans un cadre très sensible : la santé et de plus la santé du coeur. Imaginez une personne qui est en réalité malade cardiaque alors qu’on la diagnostic non-malade (les Faux négatifs sont ici au nombre de 46). C’est très dangereux pour cette personne car elle n’aura pas les soisn nécessaires. C’est également dangereux pour les personnes non-malades qu’on diagnostic malades car elles subiront des traitement pour rien (les faux positifs sont ici au nombre de 42). Le modèle prédit mieux les non-malades (122 sur un total de 164 soit une précision d’environ 74%) que les malades (93 sur un total de 139 soit eviron 67%). Gardons toutefois, qu’on ne peut jamais atteindre une précision de 100%.
Nous allons ajouter plus de complexité au modèle dans l’objectif d’augementer sa précision. Nous allons construire le modèle mc ~ age + sex + thalach + cp + exang
#Construction du modèle mc ~ age + sex + thalach + cp + exang
model2 <- glm(mc ~ age + sex + thalach + cp + exang, family = "binomial", data = df)
#Informations de model2
model2_tidy <- tidy(model2)
#Calcul rapports de chance 'OR'
model2_tidy$OR <- exp(model2_tidy$estimate)
#Calcul de l'intervalle de confiance à 95%
model2_tidy$lower_CI <- exp(model2_tidy$estimate - 1.96 * model2_tidy$std.error)
model2_tidy$upper_CI <- exp(model2_tidy$estimate + 1.96 * model2_tidy$std.error)
model2_tidy## # A tibble: 8 x 8
## term estimate std.error statistic p.value OR lower_CI upper_CI
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 (Intercep~ -1.08 2.03 -0.531 5.96e-1 0.340 0.00638 18.2
## 2 age 0.0444 0.0192 2.31 2.09e-2 1.05 1.01 1.09
## 3 sexMale 1.65 0.355 4.66 3.21e-6 5.23 2.61 10.5
## 4 thalach -0.0251 0.00826 -3.04 2.36e-3 0.975 0.960 0.991
## 5 cp2 -0.156 0.641 -0.243 8.08e-1 0.856 0.244 3.01
## 6 cp3 -0.156 0.574 -0.273 7.85e-1 0.855 0.278 2.63
## 7 cp4 1.72 0.555 3.11 1.90e-3 5.61 1.89 16.7
## 8 exang1 0.955 0.352 2.72 6.57e-3 2.60 1.31 5.18#Probabilités prédictes dans notre ensemble de données
prob_pred2 <- predict(model2, data = df, type = "response")
#Création d'une règle de décision pour dire qu'une personne est malade si prod_pred >= 0,5 et non-malade dans le cas-contraire.
df$pred2_mc <- ifelse(prob_pred2 >= 0.5, 1, 0)Passons à l’évaluation du model2.
#Calcul de la précision
precision2 <-accuracy(df$mc, df$pred2_mc)
#Erreur de classification (1 - précision)
erreur2 <- 1 - precision2
#Aire sous la courbe ROC
auc2 <- auc(df$mc, df$pred2_mc)
#Affichage des paramètres
print(paste("La Précision du modèle1 est : ", precision2))## [1] "La Précision du modèle1 est : 0.792079207920792"print(paste("L'Erreur de Classification du modèle 1 est : ", erreur2))## [1] "L'Erreur de Classification du modèle 1 est : 0.207920792079208"print(paste("L'Aire sous la courbe ROC du Modèle 1 est : ", auc2))## [1] "L'Aire sous la courbe ROC du Modèle 1 est : 0.788734865765924"#Matrice de confusion
mconfusion2 <- table(df$mc, df$pred2_mc, dnn=c("Vrai Statut","Statut prédit"))
mconfusion2## Statut prédit
## Vrai Statut 0 1
## 0 136 28
## 1 35 104L’ajout de complexité a nettement augmenté la précision globale du modèle. Le modèle 2 est globalement plus précis (environ 80%) que le modèle 1 (environ 71%). Cependant il y a toujours des personnes mal classées dans le modèle. Un modèle n’est qu’une représentation simplifiée de la réalité mais un bon outil d’aide à la décison. Le modèle 2 peut également être utilisé pour prédire la probabilité q’une personne soit atteite de maladie cardiaque.