Début: chargement des packages pouvant être utiles

library(epiDisplay)
library(epiR)
library(prettyR)
library(knitr)
library(kableExtra)

Puis l’import des données

Dans un premier temps, il s’agissait de télécharger le fichier dans mon dossier local, ensuite on commit cette action et avec un push il est envoyé sur gitlab.

Ensuite il s’agit de le charger dans R :

data <- read.csv("Subject6_smoking.csv")
View(data)

Vérification du format des données :

str(data)
## 'data.frame':    1314 obs. of  3 variables:
##  $ Smoker: Factor w/ 2 levels "No","Yes": 2 2 1 1 2 1 1 2 2 2 ...
##  $ Status: Factor w/ 2 levels "Alive","Dead": 1 1 2 1 1 1 1 2 1 1 ...
##  $ Age   : num  21 19.3 57.5 47.1 81.4 36.8 23.8 57.5 24.8 49.5 ...

Tout semble ok.

Mission 1

Creation du tableau :

L’objectif est de créer un tableau avec le nombre total de femme vivantes ou décédées sur la période en fonction des habitudes de tabagisme.

vivantes_fum <- sum(data$Status[data$Smoker=="Yes"]=="Alive")
vivantes_nonfum <- sum(data$Status[data$Smoker=="No"]=="Alive")

decedees_fum <- sum(data$Status[data$Smoker=="Yes"]=="Dead")
decedees_nonfum  <- sum(data$Status[data$Smoker=="No"]=="Dead")
tab_1 <- data.frame(Vivantes = c(vivantes_fum,vivantes_nonfum), Decedees = c(decedees_fum,decedees_nonfum), row.names = c("Fumeuses","Non fumeuses"))
kable(tab_1,align = 'l')
Vivantes Decedees
Fumeuses 443 139
Non fumeuses 502 230

Calcul des taux de mortalité :

Creation d’un tableau de contigence

mort_fum <- sum(data$Status[data$Smoker=="Yes"]=="Dead")
mort_nonfum <- sum(data$Status[data$Smoker=="No"]=="Dead")
vivant_fum <-sum(data$Status[data$Smoker=="Yes"]=="Alive")
vivant_nonfum <- sum(data$Status[data$Smoker=="No"]=="Alive")
nb_fum <- sum(data$Smoker=="Yes")
nb_nonfum <- sum(data$Smoker=="No")
nb_viv <- sum(data$Status=="Alive")
nb_deces <-sum(data$Status=="Dead")
tot <- sum(data$Status=="Alive"|data$Status=="Dead")

tab_2 <- data.frame(cbind(rbind(mort_fum, vivant_fum, nb_fum)), rbind(mort_nonfum,vivant_nonfum, nb_nonfum),rbind(nb_deces,nb_viv,tot))
row.names(tab_2) <- c("Decedees", "Vivantes","Total")
names(tab_2) <- c("Fumeuses", "Non Fumeuses", "Total")

kable(tab_2,align = "c")
Fumeuses Non Fumeuses Total
Decedees 139 230 369
Vivantes 443 502 945
Total 582 732 1314

Representation graphique

Ceci passe par la création d’un tableau avec les pourcentages de mortalité

tab_3 <- data.frame(cbind(rbind((sum(data$Status[data$Smoker=="Yes"]=="Dead")/sum(data$Smoker=="Yes"))*100,(sum(data$Status[data$Smoker=="Yes"]=="Alive")/sum(data$Smoker=="Yes"))*100)), 
                    rbind((sum(data$Status[data$Smoker=="No"]=="Dead")/sum(data$Smoker=="No"))*100,(sum(data$Status[data$Smoker=="No"]=="Alive")/sum(data$Smoker=="No"))*100))
                                
names(tab_3) <- c("Fumeuses", "Non fumeuses")
row.names(tab_3) <- c("Decedees", "Vivantes")

kable(tab_3, align = "c")
Fumeuses Non fumeuses
Decedees 23.88316 31.42076
Vivantes 76.11684 68.57923 
barplot(as.matrix(tab_3), col = c("black","gray"), space = 1.5,width = 0.5) 
legend("center",xpd=NA, legend = c("Decedees", "Vivantes"), fill = c("black","gray"))

Calcul des intervalles de confiance des proportions

#  creation de la fonction :

IC = function(x) {
  y <- x/100
  inf = y-(1.96*sqrt((y*(1-y))/n))
  sup = y+(1.96*sqrt((y*(1-y))/n))
  print(c(x,inf*100,sup*100))
}

Chez les fumeuses :

x <- tab_3[1,1]
n <- as.numeric(tab_2[3,1])

IC(x)
## [1] 23.88316 20.41914 27.34719

Chez les non fumeuses :

x <- tab_3[1,2]
n <- tab_2[3,2]

IC(x)
## [1] 31.42077 28.05793 34.78360

Au vu de l’ensemble des résultats, on fait le constat suivant : Il semblerait que le taux de mortalité est plus important chez les non-fumeuses… Ceci va à l’encontre des connaissances sur le tabac, on pourrait s’attendre à ce que les non fumeuses décèdent moins.

Mission 2

Il s’agit de reprendre les données, cette fois-ci en fonction de la classe d’âge

Première étape : création de la variable classe d’âge

data$cl_age <- as.factor(ifelse(data$Age>=18&data$Age<35,"[18;34]",
                                ifelse(data$Age>=35&data$Age<54,"[35;54]",
                                       ifelse(data$Age>=55&data$Age<65,"[55;64]","[65;["))))

tab1(data$cl_age)

## data$cl_age : 
##         Frequency Percent Cum. percent
## [18;34]       416    31.7         31.7
## [35;54]       420    32.0         63.6
## [55;64]       236    18.0         81.6
## [65;[         242    18.4        100.0
##   Total      1314   100.0        100.0

Deuxième étape on refait les tableaux de contingence mais cette fois-ci de manière plus optimisée

Pour cela on utilise ce lien pour connaître la méthode.

tab_5 <- ftable(data[,c(1,2,4)])
tab_5 <- round(prop.table(tab_5,2)*100,1)
tab_5 <- rbind(tab_5, tab1(data$cl_age)$output.table[,1])
## Warning in rbind(tab_5, tab1(data$cl_age)$output.table[, 1]): number of columns
## of result is not a multiple of vector length (arg 2)

tab_5 <- as.table(tab_5)
row.names(tab_5) <- c("Non fumeuses vivantes ", "Non fumeuses decedees", "Fumeuses vivantes", "Fumeuses decedees" ,"Effectifs")
colnames(tab_5) <- c("[18;34]", "[35;54]", "[55;64]", "[65;[")

kable(tab_5,"latex", align = "c") %>% kable_styling(latex_options = "striped", stripe_index = c(1,2))

Et maintenant on trace le barplot

barplot(tab_5[c(1,2),], col = c("gray", "black"), width = 0.5)
legend("right",xpd=NA, legend = c("Decedees", "Vivantes"), fill = c("black","gray"))

Et maintenant on peut obtenir les intervalles de confiance

Pour le premier groupe d’age

x <- tab_5[2,1]
n <- tab_5[3,1]

IC(x)
## [1]  1.400000 -2.079537  4.879537

Pour le deuxième groupe d’age

x <- tab_5[2,2]
n <- tab_5[3,2]

IC(x)
## [1]  4.500000 -1.543587 10.543587

Pour le troisieme groupe d’age

x <- tab_5[2,3]
n <- tab_5[3,3]

IC(x)
## [1] 16.900000  2.790381 31.009619

Pour le quatrieme groupe d’age

x <- tab_5[2,4]
n <- tab_5[3,4]

IC(x)
## [1]  68.20000  14.60024 121.79976