From 3c8b7365d91f006ad366b7008b261521a1dff30f Mon Sep 17 00:00:00 2001 From: 19035d41447a43bf638157acd6ff2bcd <19035d41447a43bf638157acd6ff2bcd@app-learninglab.inria.fr> Date: Sun, 16 Nov 2025 14:37:18 +0000 Subject: [PATCH] Paradoxe de Simpson_Auriane Mens --- .../Paradoxe de simpson _ Auriane Mens | 153 ++++++++++++++++++ 1 file changed, 153 insertions(+) create mode 100644 module3/exercice3/Paradoxe de simpson _ Auriane Mens diff --git a/module3/exercice3/Paradoxe de simpson _ Auriane Mens b/module3/exercice3/Paradoxe de simpson _ Auriane Mens new file mode 100644 index 0000000..7d5ed8c --- /dev/null +++ b/module3/exercice3/Paradoxe de simpson _ Auriane Mens @@ -0,0 +1,153 @@ +title: "Module 3 Paradoxe de simpson" +author: "Auriane Mens" +date: "2025-11-16" +output: html_document +editor_options: + markdown: + wrap: 72 +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = TRUE) +``` + +# *Question 1* + +#Nombres total de femmes vivanteset décédées sur la période en +fonction des habitudes liés au tabagisme library(dplyr) data \<- +read.csv("C:/Users/auria/OneDrive - Institut Catholique de +Lille/Bureau/Subject6_smoking.csv") head(data) summary(data) + +# Filtrer les femmes concernées + +dataF \<- data %\>% filter(Smoker %in% c("Yes", "No")) head(dataF) + +# Tableau croisé + +table_smoke \<- table(dataF$Smoker, dataF$Status) colnames(table_smoke) +\<- c("Dead", "Alive") \# Renommer pour plus de clarté + +# Ajouter une colonne Total + +table_smoke \<- cbind(table_smoke, Total = rowSums(table_smoke)) +table_smoke + +# Transformer en data frame pour plus de clarté + +table_smoke_df \<- data.frame( Smoker = rownames(table_smoke), Dead = +table_smoke[, "Dead"], Alive = table_smoke[, "Alive"] ) + +# Calculer le taux de mortalité + +table_smoke_df$Mortality_Rate <- table_smoke_df$Dead / +table_smoke_df\$Total table_smoke_df library(ggplot2) + +# Ajouter Total et taux de mortalité + +table_smoke_df$Total <- table_smoke_df$Dead + table_smoke_df$Alive +table_smoke_df$Mortality_Rate \<- +table_smoke_df$Dead / table_smoke_df$Total + +table_smoke_df + +#Graphique + +library(ggplot2) + +ggplot(table_smoke_df, aes(x = Smoker, y = Mortality_Rate, fill = +Smoker)) + geom_bar(stat = "identity") + ylab("Taux de mortalité sur 20 +ans") + xlab("Tabagisme") + ggtitle("Taux de mortalité selon le +tabagisme") + scale_fill_manual(values=c("red", "green")) + +theme_minimal() + +#Le résultat est surprenant car le taux de mortalité est légèrement plus élevé chez les fumeurs que chez les non fumeurs. Il n'ya pas beaucoup de diffrences. + +#*Question 2* + +# Créer des classes d'âge +dataF$AgeClass <- cut( + dataF$Age, + breaks = c(18, 34, 54, 64, Inf), + labels = c("18-34", "35-54", "55-64", "65+"), + right = TRUE +) + +# Vérifier +table(dataF$AgeClass) + +# Tableau croisé +table_age <- as.data.frame(ftable(dataF$Smoker, dataF$AgeClass, dataF$Status)) +colnames(table_age) <- c("Smoker", "AgeClass", "Status", "Freq") + +# Séparer Dead et Alive +library(dplyr) +library(tidyr) +table_summary <- table_age %>% + tidyr::pivot_wider(names_from = Status, values_from = Freq, values_fill = 0) %>% + mutate( + Total = Alive + Dead, + Mortality_Rate = Dead / Total + ) + +table_summary + +#Graphique du taux e mortalité par âge et par tabagime +library(ggplot2) + +ggplot(table_summary, aes(x = AgeClass, y = Mortality_Rate, fill = Smoker)) + + geom_bar(stat = "identity", position = "dodge") + + ylab("Taux de mortalité sur 20 ans") + + xlab("Classe d'âge") + + ggtitle("Taux de mortalité selon le tabagisme et l'âge") + + scale_fill_manual(values=c("red", "green")) + + theme_minimal() + +#Explication du paradoxe +#Globalement, les fumeuses ont un taux de mortalité plus élevé, comme montré précédemment. Cependant, stratifié par âge : les fumeuses peuvent avoir un taux de mortalité inférieur à celui des non-fumeuses dans chaque tranche. Cela s'explique par le fait que les fumeuses sont souvent plus jeunes dans l'échantillon.Les non-fumeuses incluent proportionnellement plus de femmes âgées, donc plus à risque de décès. + +# *Question 3* + +#Régression logistiqu +#Création de la variable Death +dataF$Death <- ifelse(dataF$Status == "Dead", 1, 0) + +# Fumeuses +smokers <- dataF %>% filter(Smoker == "Yes") +model_smokers <- glm(Death ~ Age, data = smokers, family = binomial) + +# Non-fumeuses +nonsmokers <- dataF %>% filter(Smoker == "No") +model_nonsmokers <- glm(Death ~ Age, data = nonsmokers, family = binomial) + +summary(model_smokers) +summary(model_nonsmokers) + +library(ggplot2) + +# Préparer les données pour les prédictions +age_range <- data.frame(Age = seq(min(dataF$Age), max(dataF$Age), length.out = 100)) + +# Prédictions pour fumeuses +age_range$Death_smokers <- predict(model_smokers, newdata = age_range, type = "response") + +# Prédictions pour non-fumeuses +age_range$Death_nonsmokers <- predict(model_nonsmokers, newdata = age_range, type = "response") + +# Transformer en long format pour ggplot +library(tidyr) +age_plot <- age_range %>% + pivot_longer(cols = c(Death_smokers, Death_nonsmokers), + names_to = "Group", values_to = "Death_Prob") %>% + mutate(Group = ifelse(Group == "Death_smokers", "Smokers", "Non-smokers")) + +# Graphique +ggplot(age_plot, aes(x = Age, y = Death_Prob, color = Group)) + + geom_line(size = 1) + + ylab("Probabilité de décès sur 20 ans") + + xlab("Âge initial") + + ggtitle("Régression logistique : probabilité de décès selon l'âge et le tabagisme") + + scale_color_manual(values = c("red", "green")) + + theme_minimal() + +#Discussion +#La probabilité de décès augmente avec l’âge dans les deux groupes, comme attendu. #À âge égal, les fumeuses ont toujours une probabilité de décès plus élevée que les non-fumeuses, ce qui confirme la nocivité du tabagisme.Cette approche évite le biais du paradoxe de Simpson, car elle compare les individus à âge égal au lieu de faire des regroupements arbitraires. A noter selon le graphique que cette tendance s'inverse à partir d'un certains âge, notamment du à d'autres multiples facteurs. \ No newline at end of file -- 2.18.1