diff --git a/module3/exo3/Sujet6_Mikaela_Potier.Rmd b/module3/exo3/Sujet6_Mikaela_Potier.Rmd new file mode 100644 index 0000000000000000000000000000000000000000..1c3512adc8c45a610ad3127b36d061614eeaaf94 --- /dev/null +++ b/module3/exo3/Sujet6_Mikaela_Potier.Rmd @@ -0,0 +1,273 @@ +--- +title: 'Sujet 6: Autour du Paradoxe de Simpson' +author: "Mikaëla POTIER" +date: "08/11/2022" +output: + pdf_document: + toc: true + number_sections: TRUE +geometry: left = 2cm, right = 2cm, top = 2cm, bottom = 2cm +mainfont: Times New Roman +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = TRUE) +setwd("~/THESE/formation_git/mooc-rr/exo_pair") +library(tidyverse) +library(ggplot2) +library(dplyr) +library(reshape2) +library(questionr) +library(ggpattern) +library(ggpubr) +``` + +  +  +  +  + +# Contexte du sujet et présentation des données + +En 1972-1974, à Whickham, une ville du nord-est de l'Angleterre, située à environ 6,5 kilomètres au sud-ouest de Newcastle upon Tyne, un sondage d'un sixième des électeurs a été effectué afin d'éclairer des travaux sur les maladies thyroïdiennes et cardiaques (Tunbridge et al. 1977). Une suite de cette étude a été menée vingt ans plus tard (Vanderpump et al. 1995). Certains des résultats avaient trait au tabagisme et cherchaient à savoir si les individus étaient toujours en vie lors de la seconde étude. Par simplicité, nous nous restreindrons aux femmes et parmi celles-ci aux 1314 qui ont été catégorisées comme "fumant actuellement" ou "n'ayant jamais fumé". Il y avait relativement peu de femmes dans le sondage initial ayant fumé et ayant arrêté depuis (162) et très peu pour lesquelles l'information n'était pas disponible (18). La survie à 20 ans a été déterminée pour l'ensemble des femmes du premier sondage. + +Les données du sondage sont disponibles en format csv. Elles ont été téléchargées à [cette url](https://gitlab.inria.fr/learninglab/mooc-rr/mooc-rr-ressources/-/raw/master/module3/Practical_session/Subject6_smoking.csv?inline=false) et sont chargées ci-dessous (dans l'objet data). On peut voir ici un aperçu des données. + +  +  + +```{r} +#Chargement des données du sondage +data<- read.csv2("Subject6_smoking.csv", header=TRUE, sep=",",dec=".") +head(data) +tail(data) +``` +  +  + +| Nom de colonne | Libellé de colonne | +|----------------+-----------------------------------------------------------------------------------------------------------------------------------| +| `Smoker` | Indique si la personne fume actuellement (Yes) ou n'a jamais fumé (No) | +| `Status` | Indique si la personne est vivante (Alive) ou décédée (Dead) | +| `Age` | Age lors du premier sondage | + +Y a-t-il des points manquants dans nos données ? +```{r} +na_records = apply(data, 1, function (x) any(is.na(x))) +data[na_records,] +``` + +Il semblerait qu'il n'y ait pas de point manquant dans les données. +Intéressons nous maintenant aux variables d'intérêt `Smoker`,`Status` et Àge`et vérifions leur classe. + +  +  + +```{r} +class(data$Smoker) +class(data$Status) +class(data$Age) + +``` +`Smoker` et `Status` sont bien des chaines de caractères et `Age` est bien une variable numérique. + +  +  +  +  +  +  +  +  + +\newpage + +# Réponse à la question 1 du sujet: lien entre tabagisme et mortalité + +## Nombre total de femmes vivantes/décédées en fonction de leur habitude de tabagisme + +On représente le nombre de femmes vivantes/dédées en fonction de leurs habitudes de tabagisme. + +
+```{r, fig.cap= "Nombre de femmes vivantes/décédées en fonction des habitudes de tabagisme"} +#Représentation graphique des effectifs +data %>% ggplot()+ geom_bar(aes(x= Smoker,fill=Status))+ +ylab(label = "Number of dead/alive in relation to tabagism") +``` +
+  +  + +## Taux de mortalité moyen en fonction des habitudes de tabagisme + +On transforme la variable qualitative `Status` en une nouvelle variable quantitative `Dead` qui indique un 1 si la personne est décédée et un 0 sinon. On calcule les taux de mortalité moyens pour les deux sous-populations fumeurs et non fumeurs. Les taux de mortalités sont présentés ci-dessous: + +```{r,fig.cap= "Taux de mortalités moyens en fonction des habitudes de tabagisme"} +data_tx<- data %>% mutate(Dead= ifelse(Status=="Alive",0,1)) +tapply(data_tx$Dead, data_tx$Smoker, mean)%>% melt()%>% + ggplot()+ geom_bar(aes(x=Var1, y= value),stat = "identity")+ xlab(label="Smoker")+ + ylab(label="Mortality_rate") +``` +Il semblerait que la population de femmes qui fume ait un taux de mortalité inférieur en moyenne à la population de femmes qui ne fument pas. On effectue ensuite un test statistique pour savoir s'il y a un lien entre la mortalité (la variable `Dead`) et le tabagisme (la variable `Smoker`). La méthode utilisée est un test de Wilcox. Les résultats du test sont présentés ci-dessous. + +  +  +```{r} +wilcox.test(data_tx$Dead ~ data_tx$Smoker) + +``` +  +  + +La valeur `p-value` -valeur qui permet de conclure sur l'indépendance entre `Dead`et `Smoker`- étant petite (<1%), on peut rejeter l’hypothèse d’indépendance entre la mortalité et le fait d'être fumeur et considérer que le taux de mortalité dans les deux sous-populations (fumeur/non fumeurs) est significativement différent. + +  +\LARGE +\color{red}**Réponse à la question 1:** En conclusion, les résultats du sondage indiquent que le taux moyen de mortalité chez les femmes qui fument (`r round(tapply(data_tx$Dead, data_tx$Smoker, mean)[1]*100,2)` %) est moins important que chez les femmes non fumeuses (`r round(tapply(data_tx$Dead, data_tx$Smoker, mean)[2]*100,2)` %). Ceci est surprenant car on aurait tendance à penser que le tabac pourrait provoquer des pathologies thyroïdiennes et cardiaques. \normalcolor +  + +\normalsize + + +# Réponse à la question 2 du sujet: lien entre tabagisme, mortalité et âge + +On ajoute maintenant la variable `Age_category` et on effectue des catégories liées à la classe d'âge: 18-34 ans, 34-54ans , 55-64 ans et plus de 65 ans. + +```{r} +data_age<- data +data_age$age_category<- data_age$Age +#Création d'une nouvelle variable +#`age category` qui correspond à la class d'âge + +for (line in 1:nrow(data_age)){ #On balaie toutes les lignes du tableau + if (data_age$Age[line] >= 65){ + data_age$age_category[line] = ">65" + }else{ + if (data_age$Age[line] >= 55){ + data_age$age_category[line] = "55-64" + }else{ + if (data_age$Age[line] >=34){ + data_age$age_category[line] = "34-54" + + }else{ + data_age$age_category[line] = "18-33" + }}}} +``` + +On vérifie que toutes les classes d'âge sont bien représentées. +```{r} +levels(as.factor(data_age$age_category)) +``` + + +## Nombre total de femmes vivantes/décédées en fonction de leur habitude de tabagisme et de leur âge + +On représente le nombre de femmes vivantes/dédées en fonction de leurs habitudes de tabagisme et de leur classe d'âge. + +```{r, fig.cap= "Nombre de femmes vivantes/décédées en fonction des habitudes de tabagisme et de l'âge"} +#Représentation graphique des effectifs +ggplot(data_age,aes(x= Smoker, fill=Status, pattern= age_category))+ + + geom_bar_pattern( position = position_dodge(preserve = "single"), + color = "black", + pattern_fill = "black", + pattern_angle = 45, + pattern_density = 0.1, + pattern_spacing = 0.025, + pattern_key_scale_factor = 0.6)+ + ylab(label = "Number of dead/alive in relation to tabagism and age")+ + + guides(pattern = guide_legend(override.aes = list(fill = "white")), + fill = guide_legend(override.aes = list(pattern = "none"))) +``` +Il semblerait que la catégorie de femmes qui meurent le plus en terme d'effectif soit les femmes non fumeuses de plus de 65 ans. + + +## Taux de mortalité moyen en fonction des habitudes de tabagisme + +On transforme la variable qualitative `Status` en une nouvelle variable quantitative `Dead` qui indique un 1 si la personne est décédée et un 0 sinon. On calcule les taux de mortalité moyens pour les deux sous-populations fumeurs et non fumeurs et en fonction des classes d'âge. Les taux de mortalités sont présentés ci-dessous: + +```{r,fig.cap= "Taux de mortalités moyens en fonction des habitudes de tabagisme et de l'âge"} + +data_age_tx<- data_age %>% mutate(Dead= ifelse(Status=="Alive",0,1)) +tapply(data_age_tx$Dead, paste(data_age_tx$age_category,data_age_tx$Smoker), mean)%>% + melt()%>% ggplot()+ +geom_bar(aes(x=Var1, y= value),stat = "identity")+ + xlab(label="Age_category x Smoker")+ + ylab(label="Mortality_rate") +``` +Si on compare les taux de mortalité des femmes fumeuses et non fumeuses entre les différentes classes d'âge, on constate que les femmes fumeuses et non fumeuses de plus de 65 ans et entre 18 et 33 ans ont des taux de mortalité similaires. En revanche, pour les classe d'âge 34-54 ans et 55-64 ans, le taux de mortalité des femmes fumeuses semble plus élevé que pour les femmes non fumeuses. + + +  +\LARGE +\color{red}**Réponse à la question 2:** D'après le paradoxe de Simpson, le phénomène (ici l'impact du tabagisme) observé dans plusieurs groupes (ici différentes classes d'âge et groupes fumeurs/non fumeurs) s'inverse lorsque les groupes sont combinés (ici quand toutes les classes d'âge sont poolées). Toutes classes d'âge confondues, le tabagisme ne semble pas avoir de lien avec la mortalité, mais toutes classes d'âge séparées, le tabagisme semble avoir des conséquences négatives sur la mortalités de femmes de certaines classes d'âge. Ceci est certainement dû au fait que le taux de mortalité des femmes de plus de 65 ans est plus élevé que celui des autres classes d'âge, et que les fumeuses et non fumeuses de cette classe d'âge ont les mêmes taux de mortalité. Ceci gomme la tendance observé chez d'autres classes d'âge. \normalcolor +  + +\normalsize + + +# Réponse à la question 3 du sujet: Conclusion sur la nocivité du tabagisme? + + +On reprend le jeu de données et on transforme la variable qualitative `Status` en une nouvelle variable quantitative `Death` qui indique un 1 si la personne est décédée et un 0 sinon. On effectue ensuite une régression logistique (glm) pour connaître l'impact de l'âge sur la mortalité des femmes. La régression est d'abord appliquée à l'ensemble des femmes fumeuses puis à l'ensemble des femmes non fumeuses. Les résultats de la régression sur l'ensemble des femmes fumeuses est présenté ci-dessous. + +  +  + +```{r} +data_tx1<- data %>% mutate(Death= ifelse(Status=="Alive",0,1))%>% filter(Smoker== "Yes") + +logistic_reg = glm(data=data_tx1, Death ~ Age , family=binomial(link='logit')) +summary(logistic_reg) + +``` +Le coefficient lié à l'âge (`r logistic_reg$coefficients[2]`) est significativement différent de 0 (c'est ce qu'indique la p-value très petite). Il y a donc une influence de l'âge sur la mortalité des femmes fumeuses. Le coefficient est positif donc plus l'âge augmente plus le taux de mortalité augmente. + +\newpage +Les résultats de la régression sur les femmes non fumeuses sont présentés ci-dessous. +```{r} +data_tx2<- data %>% mutate(Death= ifelse(Status=="Alive",0,1))%>% filter(Smoker== "No") + +logistic_reg2 = glm(data=data_tx2, Death ~ Age , family=binomial(link='logit')) +summary(logistic_reg2) +``` +Le coefficient lié à l'âge (`r logistic_reg2$coefficients[2]`) est significativement différent de 0 (c'est ce qu'indique la p-value très petite). Il y a donc une influence de l'âge sur la mortalité des femmes non fumeuses. Le coefficient est positif donc plus l'âge augmente plus le taux de mortalité augmente. + +  + +```{r, fig.cap= "Lien entre âge et mortalité chez les femmes fumeuses"} +#Prédiction de régression pour les fumeurs +age = c(1:100) +REG <- predict(logistic_reg,list(Age=age),type="response", se.fit = TRUE) + +#Plot +plot_smoker<- ggplot(data=NULL,aes(x = age,y= REG$fit))+ + geom_line(color= "#996699")+ + +geom_ribbon(aes(ymin = REG$fit- 1.96*REG$se.fit, ymax =REG$fit + 1.96*REG$se.fit), + alpha = 0.3, color= "#996699", fill= "#996699")+ + ggtitle(label="Smoker")+ ylab("Prediction of the mortality rate") +plot_smoker +``` + +```{r, fig.cap= "Lien entre âge et mortalité chez les femmes non fumeuses"} +#Prediction de régression pour les non fumeurs +REG2 <- predict(logistic_reg2,list(Age=age),type="response", se.fit = TRUE) + +#Plot +plot_not_smoker<- ggplot(data=NULL,aes(x = age,y= REG2$fit))+geom_line(color= "#339966")+ +geom_ribbon(aes(ymin = REG2$fit- 1.96*REG2$se.fit, ymax =REG2$fit + 1.96*REG2$se.fit), + alpha = 0.3,color= "#339966", fill= "#339966")+ + ggtitle(label="Not smoker")+ ylab("Prediction of the mortality rate") +plot_not_smoker +``` + + +  +  +  +\LARGE +\color{red}**Réponse à la question 3:** La prédiction du taux de mortalité en fonction de l'âge chez les fumeurs et les non fumeurs semble être assez similaires, étant donné que les intervalles de confiance sont chevauchants. On ne peut donc pas conclure sur la nocivité du tabagisme.\normalcolor +\normalsize + diff --git a/module3/exo3/Sujet6_Mikaela_Potier.pdf b/module3/exo3/Sujet6_Mikaela_Potier.pdf new file mode 100644 index 0000000000000000000000000000000000000000..33f270b9f1cf524e39bb5e5ec17cfb82ca5cd24b Binary files /dev/null and b/module3/exo3/Sujet6_Mikaela_Potier.pdf differ