library(rio)
library(epitools)
library(questionr)heart <- import("heart.xlsx")
str(heart)## 'data.frame': 270 obs. of 13 variables:
## $ age : num 58 41 58 53 41 65 51 45 55 58 ...
## $ sexe : chr "masculin" "feminin" "masculin" "masculin" ...
## $ type_douleur: chr "D" "B" "D" "D" ...
## $ pression : num 100 130 150 140 130 155 110 112 130 136 ...
## $ cholester : num 234 204 270 203 214 269 175 160 262 319 ...
## $ sucre : chr "A" "A" "A" "B" ...
## $ electro : chr "A" "C" "C" "C" ...
## $ taux_max : num 156 172 111 155 168 148 123 138 155 152 ...
## $ angine : chr "non" "non" "oui" "oui" ...
## $ depression : num 1 14 8 31 20 8 6 0 0 0 ...
## $ pic : num 1 1 1 3 2 1 1 2 1 1 ...
## $ vaisseau : chr "B" "A" "A" "A" ...
## $ coeur : chr "presence" "absence" "presence" "presence" ...## Recodage de heart$coeur
heart$coeur[heart$coeur == "absence"] <- "0"
heart$coeur[heart$coeur == "presence"] <- "1"heart$coeur <- as.numeric(heart$coeur)# Stat sur angine et coeur
summary(heart[, c("angine", "coeur")])## angine coeur
## Length:270 Min. :0.0000
## Class :character 1st Qu.:0.0000
## Mode :character Median :0.0000
## Mean :0.4444
## 3rd Qu.:1.0000
## Max. :1.0000# Association coeur et angine
chisq.test(x= heart$angine, y =heart$coeur, correct = FALSE )##
## Pearson's Chi-squared test
##
## data: heart$angine and heart$coeur
## X-squared = 47.47, df = 1, p-value = 5.585e-12Il existe un lien entre angine et maladie du coeur
# Tableau croisé entre maladie du coeur et angine
tc <- table(heart$coeur, heart$angine)
tc##
## non oui
## 0 127 23
## 1 54 66# Proportion en colonne du tableau tc
pc <- prop.table(tc, margin = 2)
pc##
## non oui
## 0 0.7016575 0.2584270
## 1 0.2983425 0.741573029,% des personnes qui n’ont pas eu d’angine ont une maladie du coeur alors que 74 % des personnes qui ont eu une angine ont une maladie du coeur Et comme le lien est significatif, on peut donc deduire que l’angine est premonitoire d’une maladie cardiaque
# Calculons le risque relatif avec la librairie epitools
#method "wald" pour echantillon grand et "small" pour petit echantillon
# La variable a expliquer doit etre en y= , et la vairable explicative en x=
riskratio(y= heart$coeur, x= heart$angine, method = "wald") ## $data
## Outcome
## Predictor 0 1 Total
## non 127 54 181
## oui 23 66 89
## Total 150 120 270
##
## $measure
## risk ratio with 95% C.I.
## Predictor estimate lower upper
## non 1.000000 NA NA
## oui 2.485643 1.926426 3.207193
##
## $p.value
## two-sided
## Predictor midp.exact fisher.exact chi.square
## non NA NA NA
## oui 4.691803e-12 4.921297e-12 5.58526e-12
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"On a 2,48 fois de chance d’avoir une maladie du cœur si présence d’angine
# Calculons l'odds ratio qui s'utilise devant n'importe quelle taille d'echantillon
# Contrairement au risk relatif (grand echantillon)
oddsratio(y= heart$coeur, heart$angine, method = "wald")## $data
## Outcome
## Predictor 0 1 Total
## non 127 54 181
## oui 23 66 89
## Total 150 120 270
##
## $measure
## odds ratio with 95% C.I.
## Predictor estimate lower upper
## non 1.000000 NA NA
## oui 6.748792 3.810902 11.95155
##
## $p.value
## two-sided
## Predictor midp.exact fisher.exact chi.square
## non NA NA NA
## oui 4.691803e-12 4.921297e-12 5.58526e-12
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"6,74 fois de chance d’avoir une maladie du coeur si on a l’angine p.value = 5.58526e-12 donc significatif
# Regression logistique
# Angine est automaiquement recodée en binaire 0/1
#angine = non (première modalité par ordre alphabétique) est exclue
# angine = oui est donc celle qui est conservée
reg <- glm(coeur ~ angine, data = heart, family = binomial)summary(reg)##
## Call:
## glm(formula = coeur ~ angine, family = binomial, data = heart)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.6451 -0.8418 -0.8418 0.7733 1.5553
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.8552 0.1625 -5.264 1.41e-07 ***
## angineoui 1.9094 0.2916 6.548 5.82e-11 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 370.96 on 269 degrees of freedom
## Residual deviance: 322.33 on 268 degrees of freedom
## AIC: 326.33
##
## Number of Fisher Scoring iterations: 4# calcul de l'Odds ratio avec library questionr
odds.ratio(reg)## OR 2.5 % 97.5 % p
## (Intercept) 0.42520 0.30692 0.581 1.408e-07 ***
## angineoui 6.74879 3.86125 12.148 5.823e-11 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 16,74 fois de chance d’avoir une maladie du coeur si on a l’angine
exp(coefficients(reg))## (Intercept) angineoui
## 0.4251969 6.7487923exp(confint(reg))## 2.5 % 97.5 %
## (Intercept) 0.3069203 0.5810482
## angineoui 3.8612482 12.1483515cbind(exp(coefficients(reg)),exp(confint(reg)))## 2.5 % 97.5 %
## (Intercept) 0.4251969 0.3069203 0.5810482
## angineoui 6.7487923 3.8612482 12.1483515# Ajout de la variable sexe en plus de angine
reg_bin <- glm(coeur ~ angine + sexe , data = heart, family = binomial)
summary(reg_bin)##
## Call:
## glm(formula = coeur ~ angine + sexe, family = binomial, data = heart)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.7837 -0.9912 -0.5756 0.6751 1.9389
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.7141 0.2911 -5.889 3.88e-09 ***
## angineoui 1.8181 0.3012 6.037 1.57e-09 ***
## sexemasculin 1.2588 0.3176 3.963 7.40e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 370.96 on 269 degrees of freedom
## Residual deviance: 305.27 on 267 degrees of freedom
## AIC: 311.27
##
## Number of Fisher Scoring iterations: 4# Calculons l'Odds ratio de angine = oui
# Odds ration = 6,74 dans la régression simple
# Ici différent de celui de la régression simple parceque angine et sexe ne sont pas indépendants
# on a 6,16 fois de chance de faire une maladie du coeur chez les personnes angine = oui par rapport aux personnes angine = non, en considérant que l'influence est la meme chez les hommes que chez les femmes
exp(coefficients(summary(reg_bin))[2,1])## [1] 6.16043# Lien entre angine et sexe
chisq.test(heart$angine, heart$sexe, correct = FALSE)##
## Pearson's Chi-squared test
##
## data: heart$angine and heart$sexe
## X-squared = 8.7501, df = 1, p-value = 0.003096# Odds ratio angine et coeur chez les femmes
oddsratio( x= heart$angine[heart$sexe == "feminin"], y=heart$coeur[heart$sexe == "feminin"], method = "wald")## $data
## Outcome
## Predictor 0 1 Total
## non 59 10 69
## oui 8 10 18
## Total 67 20 87
##
## $measure
## odds ratio with 95% C.I.
## Predictor estimate lower upper
## non 1.000 NA NA
## oui 7.375 2.344282 23.2014
##
## $p.value
## two-sided
## Predictor midp.exact fisher.exact chi.square
## non NA NA NA
## oui 0.0007920958 0.0007092328 0.0002265846
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"# Odds ratio angine et coeur chez les hommes
oddsratio( x= heart$angine[heart$sexe == "masculin"], y=heart$coeur[heart$sexe == "masculin"], method = "wald")## $data
## Outcome
## Predictor 0 1 Total
## non 68 44 112
## oui 15 56 71
## Total 83 100 183
##
## $measure
## odds ratio with 95% C.I.
## Predictor estimate lower upper
## non 1.000000 NA NA
## oui 5.769697 2.910004 11.43964
##
## $p.value
## two-sided
## Predictor midp.exact fisher.exact chi.square
## non NA NA NA
## oui 1.160078e-07 1.503941e-07 1.589907e-07
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"# Introduire le terme d'interaction entre angine * sexe
reg_ter <- glm(coeur ~ angine * sexe , data = heart, family = binomial)
summary(reg_ter)##
## Call:
## glm(formula = coeur ~ angine * sexe, family = binomial, data = heart)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.7633 -0.9990 -0.5596 0.6889 1.9655
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.7750 0.3420 -5.190 2.1e-07 ***
## angineoui 1.9981 0.5848 3.417 0.000633 ***
## sexemasculin 1.3396 0.3929 3.409 0.000651 ***
## angineoui:sexemasculin -0.2455 0.6811 -0.360 0.718542
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 370.96 on 269 degrees of freedom
## Residual deviance: 305.14 on 266 degrees of freedom
## AIC: 313.14
##
## Number of Fisher Scoring iterations: 4# Etre un homme et avoir l'angine n'induit pas un risque supplementaire de faire d'etre malade du coeur# Distribution de frequence de la variable vaisseau
table(heart$vaisseau)##
## A B C D
## 160 58 33 19# Variable vaisseau explicative
# vaisseau = A : est la modalité de référence
# Coefficient indiquent risque par rapport à la modalité A
reg_vaisseau <- glm(coeur ~ vaisseau, data = heart, family = binomial)
summary(reg_vaisseau)##
## Call:
## glm(formula = coeur ~ vaisseau, family = binomial, data = heart)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.9214 -0.7585 -0.7585 0.9196 1.6651
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.0986 0.1826 -6.017 1.77e-09 ***
## vaisseauB 1.7405 0.3311 5.256 1.47e-07 ***
## vaisseauC 2.4108 0.4633 5.203 1.96e-07 ***
## vaisseauD 2.7726 0.6551 4.232 2.31e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 370.96 on 269 degrees of freedom
## Residual deviance: 305.35 on 266 degrees of freedom
## AIC: 313.35
##
## Number of Fisher Scoring iterations: 4# Odds ratio avec epitools
oddsratio(y =heart$coeur, x=heart$vaisseau, method = "wald")## $data
## Outcome
## Predictor 0 1 Total
## A 120 40 160
## B 20 38 58
## C 7 26 33
## D 3 16 19
## Total 150 120 270
##
## $measure
## odds ratio with 95% C.I.
## Predictor estimate lower upper
## A 1.00000 NA NA
## B 5.70000 2.978611 10.90777
## C 11.14286 4.493970 27.62886
## D 16.00000 4.430890 57.77621
##
## $p.value
## two-sided
## Predictor midp.exact fisher.exact chi.square
## A NA NA NA
## B 7.176507e-08 7.027937e-08 3.491512e-08
## C 1.045625e-08 9.644499e-09 3.016397e-09
## D 7.259666e-07 6.868193e-07 1.418892e-07
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"# Par rapport à la modalité A, la modalité B a 5,7 fois plus de chance d'avoir la maladie du coeur que de ne pas avoir
# Par rapport à la modalité A, la modalité C a 11,14 fois plus de chance d'avoir la maladie du coeur que de ne pas avoir
#Par rapport à la modalité A, la modalité D a 16 fois plus de chance d'avoir la maladie du coeur que de ne pas avoir# Tableau croisé
table(heart$coeur, heart$vaisseau)##
## A B C D
## 0 120 20 7 3
## 1 40 38 26 16# Recodage en variable ordinale
ordinal_vaisseau <- ordered(heart$vaisseau)
ordinal_vaisseau## [1] B A A A A A A A A C A B A A A C C B A A B B A A A B A B B C A D A A D A C
## [38] A A B A D A B A B C C B A B C A C A B C C A A A B B B C C B A C A A D A A
## [75] C C C A A A D A A A A A B D A A C A B B A A A A A A B A D A A A A B A A A
## [112] A D B C B A A C A A A A A A B A A A B B A A B A D A A D A A A A A A D C A
## [149] A B C A A A A A A B B A B A A A A A A B A A A A C B A B A B A B B D A A A
## [186] A C A A B A A A C B C D A D A B A C A A A A B A A A A A A A D A D B A B A
## [223] A A C C C B C A A B A A A A A A A A A A D A C B A A B A B B B A D B B D A
## [260] C B B B A B A A A A A
## Levels: A < B < C < Dclass(ordinal_vaisseau)## [1] "ordered" "factor"# recodage en indicatrice cumulutive
vais_b <- ifelse(ordinal_vaisseau >= "B", 1,0)
vais_c <- ifelse(ordinal_vaisseau >= "C", 1,0)
vais_d <- ifelse(ordinal_vaisseau >= "D", 1,0)
reg_vaisseau_bis <- glm(coeur ~ vais_b + vais_c + vais_d , data = heart, family = binomial)
summary(reg_vaisseau_bis)##
## Call:
## glm(formula = coeur ~ vais_b + vais_c + vais_d, family = binomial,
## data = heart)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.9214 -0.7585 -0.7585 0.9196 1.6651
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.0986 0.1826 -6.017 1.77e-09 ***
## vais_b 1.7405 0.3311 5.256 1.47e-07 ***
## vais_c 0.6703 0.5076 1.321 0.187
## vais_d 0.3618 0.7597 0.476 0.634
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 370.96 on 269 degrees of freedom
## Residual deviance: 305.35 on 266 degrees of freedom
## AIC: 313.35
##
## Number of Fisher Scoring iterations: 4# le vaisseau B presente un surcroit de risque significatif par rapport au vaisseau A
# le vaisseau C presente pas un surcroit de risque qui n'est pas significatif par rapport au vaisseau B
# le vaisseau D ne presente pas un surcroit de risque qui n'est pas significatif par rapport au vaisseau C# Odds ratio avec questionr
odds.ratio(reg_vaisseau_bis)## OR 2.5 % 97.5 % p
## (Intercept) 0.33333 0.23034 0.4722 1.773e-09 ***
## vais_b 5.70000 3.01369 11.0846 1.471e-07 ***
## vais_c 1.95489 0.74672 5.5876 0.1866
## vais_d 1.43590 0.34361 7.4028 0.6339
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1le vaisseau B presente un surcroit de risque significatif par rapport au vaisseau A le vaisseau C presente pas un surcroit de risque qui n’est pas significatif par rapport au vaisseau B le vaisseau D ne presente pas un surcroit de risque qui n’est pas significatif par rapport au vaisseau C