ANALYSE EXPLORATOIRE - DONNEES MANQUANTES ET IMPUTATION

Lea Lê Dinh & Camille Prince : ESIEE Paris 2022-2023


Jeu de données

Nous disposons d’un jeu de données de n = 70 000. Pour chaque cas, on a 12 variables mesurées :

1. Datas et librairies

La premiere chose à faire avant tout c’est de supprimer tout grace à :

rm(list = ls())

Une fois que c’est fait, nous allons utiliser ici differentes librairies telles que :

#-> Chargement des paquets
library(ggplot2)      # graphiques
library(kableExtra)   # tableau
library(readr)
library(corrplot)  
## corrplot 0.92 loaded
LoadPack <- function(Packrequired)
{
  for(i in 1:length(Packrequired))
  {
    if(require(Packrequired[i], character.only = TRUE) == FALSE)
    {install.packages(Packrequired[i])}
    library(Packrequired[i],character.only = TRUE)
  }
}
# les paquets
mypack <- c('VIM','mice', 'kableExtra','ggplot2', 'dplyr')
LoadPack(mypack)
## Le chargement a nécessité le package : VIM
## Le chargement a nécessité le package : colorspace
## Le chargement a nécessité le package : grid
## VIM is ready to use.
## Suggestions and bug-reports can be submitted at: https://github.com/statistikat/VIM/issues
## 
## Attachement du package : 'VIM'
## L'objet suivant est masqué depuis 'package:datasets':
## 
##     sleep
## Le chargement a nécessité le package : mice
## 
## Attachement du package : 'mice'
## L'objet suivant est masqué depuis 'package:stats':
## 
##     filter
## Les objets suivants sont masqués depuis 'package:base':
## 
##     cbind, rbind
## Le chargement a nécessité le package : dplyr
## 
## Attachement du package : 'dplyr'
## L'objet suivant est masqué depuis 'package:kableExtra':
## 
##     group_rows
## Les objets suivants sont masqués depuis 'package:stats':
## 
##     filter, lag
## Les objets suivants sont masqués depuis 'package:base':
## 
##     intersect, setdiff, setequal, union

On charge ensuite notre jeu de données et l’affichons :

load(file="TP_MISS_2022.Rda")

head(dfw,25) %>% kbl(digits=3) %>%   kable_styling(bootstrap_options = "striped", full_width = F, position = "center", latex_options = 'stripped') %>%  scroll_box(width = "1000px", height = "400px")
id age gender height ap_hi ap_lo cholesterol gluc smoke alco active cardio
0 18393 2 168 110 80 1 1 0 0 1 0
1 20228 1 156 140 90 3 1 0 0 1 1
2 18857 1 165 130 70 3 1 0 0 0 1
3 17623 2 169 150 100 1 1 0 0 1 1
4 17474 1 156 100 60 1 1 0 0 0 0
8 21914 1 151 120 80 2 2 0 0 0 0
9 22113 1 157 130 NA 3 1 0 0 1 0
12 22584 2 178 130 NA 3 3 0 0 1 1
13 17668 1 158 110 NA 1 1 0 0 1 0
14 19834 1 164 110 60 1 1 0 0 0 0
15 22530 1 169 120 80 1 1 0 0 1 0
16 18815 2 173 120 80 1 1 0 0 1 0
18 14791 2 165 120 80 1 1 0 0 0 0
21 19809 1 158 110 70 1 1 0 0 1 0
23 14532 2 181 130 NA 1 NA 1 1 1 0
24 16782 2 172 120 80 1 1 0 0 0 1
25 21296 1 170 130 70 1 1 0 0 0 0
27 16747 1 158 110 70 1 3 0 0 1 0
28 17482 1 154 100 NA NA 1 0 0 0 0
29 21755 2 162 120 70 1 1 1 0 1 0
30 19778 2 163 120 80 1 1 0 0 1 0
31 21413 1 157 130 80 1 1 0 0 1 0
32 23046 1 158 145 85 2 2 0 0 1 1
33 23376 2 156 110 60 1 1 0 0 1 0
35 16608 1 170 150 90 3 1 0 0 1 1

2. Objectifs et estimations

Pour anayser correctement notre jeu de données, il est indispensable de faire une statistique descriptive afin de :

On peut en premier regarder de quoi il s’agit pour avoir une estimation :

summary(dfw) # permet de visualiser des statistiques de base pour chaque variable
##        id             age            gender         height     
##  Min.   :    0   Min.   :10798   Min.   :1.00   Min.   : 55.0  
##  1st Qu.:25007   1st Qu.:17664   1st Qu.:1.00   1st Qu.:159.0  
##  Median :50002   Median :19703   Median :1.00   Median :165.0  
##  Mean   :49972   Mean   :19469   Mean   :1.35   Mean   :164.4  
##  3rd Qu.:74889   3rd Qu.:21327   3rd Qu.:2.00   3rd Qu.:170.0  
##  Max.   :99999   Max.   :23713   Max.   :2.00   Max.   :250.0  
##                                                                
##      ap_hi             ap_lo           cholesterol         gluc      
##  Min.   : -150.0   Min.   :  -70.00   Min.   :1.000   Min.   :1.000  
##  1st Qu.:  120.0   1st Qu.:   80.00   1st Qu.:1.000   1st Qu.:1.000  
##  Median :  120.0   Median :   80.00   Median :1.000   Median :1.000  
##  Mean   :  128.8   Mean   :   96.52   Mean   :1.367   Mean   :1.227  
##  3rd Qu.:  140.0   3rd Qu.:   90.00   3rd Qu.:2.000   3rd Qu.:1.000  
##  Max.   :16020.0   Max.   :11000.00   Max.   :3.000   Max.   :3.000  
##                    NA's   :5014       NA's   :4561    NA's   :5398   
##      smoke              alco             active           cardio      
##  Min.   :0.00000   Min.   :0.00000   Min.   :0.0000   Min.   :0.0000  
##  1st Qu.:0.00000   1st Qu.:0.00000   1st Qu.:1.0000   1st Qu.:0.0000  
##  Median :0.00000   Median :0.00000   Median :1.0000   Median :0.0000  
##  Mean   :0.08813   Mean   :0.05377   Mean   :0.8037   Mean   :0.4997  
##  3rd Qu.:0.00000   3rd Qu.:0.00000   3rd Qu.:1.0000   3rd Qu.:1.0000  
##  Max.   :1.00000   Max.   :1.00000   Max.   :1.0000   Max.   :1.0000  
##

On peut notamment voir le nombre de données manquantes dites “NA”, sur lesquelles on reviendra. Cette fonction nous permet ausside voir le minimum et le maximum de chaque variable ce qui nous ammène à penser qu’il y a des données aberrantes dans les variables ap_hi et ap_lo au vu des résultats obtenus.

3. Formatage

Avant de rentrer complétement dans la statistique descriptive, on formate notre jeu de données pour le rendre le plus lisible possible. Pour cela on effectue :

gender  <- factor(dfw$gender , levels = c(1,2), labels = c('F','H'))
# la fonction factor retoune un vecteur dont les données sont catégorielles  

YN_cat <- c('smoke', 'alco', 'active', 'cardio')
OuiNon <- sapply(YN_cat, function(x){dfw[[x]] <- factor(dfw[[x]],levels = c(0,1), labels = c('Non','Oui'))})

dfw <- data.frame(dfw[,c(1,2,4,5,6,7,8)], gender, OuiNon) 
# on ajoute a notre dataframe les modifications

dfw$age <- dfw$age%/%365 # age en années

head(dfw,25) %>% kbl(digits=3) %>%   kable_styling(bootstrap_options = "striped", full_width = F, position = "center", latex_options = 'stripped') %>%  scroll_box(width = "1000px", height = "400px")
id age height ap_hi ap_lo cholesterol gluc gender smoke alco active cardio
0 50 168 110 80 1 1 H Non Non Oui Non
1 55 156 140 90 3 1 F Non Non Oui Oui
2 51 165 130 70 3 1 F Non Non Non Oui
3 48 169 150 100 1 1 H Non Non Oui Oui
4 47 156 100 60 1 1 F Non Non Non Non
8 60 151 120 80 2 2 F Non Non Non Non
9 60 157 130 NA 3 1 F Non Non Oui Non
12 61 178 130 NA 3 3 H Non Non Oui Oui
13 48 158 110 NA 1 1 F Non Non Oui Non
14 54 164 110 60 1 1 F Non Non Non Non
15 61 169 120 80 1 1 F Non Non Oui Non
16 51 173 120 80 1 1 H Non Non Oui Non
18 40 165 120 80 1 1 H Non Non Non Non
21 54 158 110 70 1 1 F Non Non Oui Non
23 39 181 130 NA 1 NA H Oui Oui Oui Non
24 45 172 120 80 1 1 H Non Non Non Oui
25 58 170 130 70 1 1 F Non Non Non Non
27 45 158 110 70 1 3 F Non Non Oui Non
28 47 154 100 NA NA 1 F Non Non Non Non
29 59 162 120 70 1 1 H Oui Non Oui Non
30 54 163 120 80 1 1 H Non Non Oui Non
31 58 157 130 80 1 1 F Non Non Oui Non
32 63 158 145 85 2 2 F Non Non Oui Oui
33 64 156 110 60 1 1 H Non Non Oui Non
35 45 170 150 90 3 1 F Non Non Oui Oui

On a maintenant les âges des patients en années, le sexe en “F” ou “H” et toutes les variables binaires en “Oui” ou “Non” pour plus de lisibilité.

On cherche à savoir s’il existe des valeurs aberrantes dans nos variables. Pour cela, on utilise la fonction ggplot2 pour pouvoir visualiser des boxplot. Ici, on étudie les variables ap_lo et ap_hi :

gr1 <- ggplot(dfw) + geom_boxplot(aes(y = ap_hi), fill = '#0066CC', colour = 'navy' ) + xlab('') + theme( axis.text.x = element_blank())
gr1

gr2 <- ggplot(dfw) + geom_boxplot(aes(y = ap_lo), fill = '#0066CC', colour = 'navy' ) + xlab('') + theme( axis.text.x = element_blank())
gr2
## Warning: Removed 5014 rows containing non-finite values (stat_boxplot).

On visualise donc bien qu’il y a certaines données qui sont aberrantes et qui donc vont devoir être supprimées. En cherchant plus précisément, la pression artérielle systolique doit être comprise entre 100 et 190 et la pression artérielle diastolique entre 60 et 120. Pour cela, on fait :

dfw$ap_lo <- ifelse (dfw$ap_lo < 60, NA, dfw$ap_lo)
dfw$ap_lo <- ifelse (dfw$ap_lo > 140, NA, dfw$ap_lo)
dfw$ap_hi <- ifelse (dfw$ap_hi < 100, NA, dfw$ap_hi)
dfw$ap_hi <- ifelse (dfw$ap_hi > 190, NA, dfw$ap_hi)

Maintenant que nos données aberrantes ont été remplacées par des valeurs manquantes, on pourra les imputer par la suite. On réutilise les boxplots pour bien visualiser ce qu’on vient de faire et ils paraissent nettement plus cohérents.

gr1 <- ggplot(dfw) + geom_boxplot(aes(y = ap_hi), fill = '#0066CC', colour = 'navy' ) + xlab('') + theme( axis.text.x = element_blank())
gr1
## Warning: Removed 1570 rows containing non-finite values (stat_boxplot).

gr2 <- ggplot(dfw) + geom_boxplot(aes(y = ap_lo), fill = '#0066CC', colour = 'navy' ) + xlab('') + theme( axis.text.x = element_blank())
gr2
## Warning: Removed 6076 rows containing non-finite values (stat_boxplot).

## 4. Visualisation des données manquantes

On utilise ici le graphique d’aggrégation qui nous permet de visualiser la proportion de données manquantes par variable.

aggr(dfw) # visualisation de la proportion de données manquantes

On voit donc bien que les données manquantes sont concentrées dans les colonnes ap_lo, ap_hi, cholesterol et gluc.

On utilise a présent, le marginplot pour interpréter davantage nos données manquantes.

marginplot(dfw[,c('ap_hi','ap_lo')])

Le boxplot bleu résume la distribution des ap_lo observées. Le boxplot rouge résume la distibution des ap_lo lorsque l’on ôte les valeurs manquantes de ap_hi. OOn en conclut donc que les données manquantes de ap_hi sont indépendantes de ap_lo puisque les boxplot sont analogues (ce qui reflète la même distribution) et donc une typologie MCAR.

pbox(dfw[,c('ap_lo','ap_hi')])
## Warning in createPlot(main, sub, xlab, ylab, labels, ca$at): not enough space to
## display frequencies

## 
## Click in in the left margin to switch to the previous variable or in the right margin to switch to the next variable.
## To regain use of the VIM GUI and the R console, click anywhere else in the graphics window.

Ici, grâce à pbox, on peut visualiser dans le boxplot blanc la distributionde toutes les valeurs observées de ap_lo, dans le boxplot bleu la distribution des valeurs observées de ap_lo en fonction des valeurs observées de ap_hi et dans le boxplot rouge la distribution des valeurs observées de ap_lo en fonction des valeurs manquantes de ap_hi.

matrixplot(dfw) # localisation des données manquantes

## 
## Click in a column to sort by the corresponding variable.
## To regain use of the VIM GUI and the R console, click outside the plot region.

Grâce à cette fonction, on voit donc bien la répartition des données manquantes.

On en conclut donc grâce à ces graphes que les données manquantes sont MCAR (donc manquantes de façon strictement aléatoires)

5. Imputation

Maintenant que nous savons que les données manquantes sont MCAR, on va utiliser la méthode Cold-Deck. Cette méthode consiste à remplacer une donnée manquante par une valeur observée chez un individu ayant les mêmes caractéristiques mais provenant d’une source d’information différente.

On choisit ici d’utiliser la fonction du k plus proche voisin KNN. Cette fonction nous retourne un dataframe en deux parties : la première partie correspond aux jeu de données complet avec imputation et la deuxième partie correspond aux valeurs imputées sous forme booléenne.

imput_knn <- kNN(data = dfw, variable = c('gluc','cholesterol','ap_lo','ap_hi'), k = 3)

head(imput_knn,25) %>% kbl(digits=3) %>%   kable_styling(bootstrap_options = "striped", full_width = F, position = "center", latex_options = 'stripped') %>%  scroll_box(width = "1000px", height = "400px")
id age height ap_hi ap_lo cholesterol gluc gender smoke alco active cardio gluc_imp cholesterol_imp ap_lo_imp ap_hi_imp
0 50 168 110 80 1 1 H Non Non Oui Non FALSE FALSE FALSE FALSE
1 55 156 140 90 3 1 F Non Non Oui Oui FALSE FALSE FALSE FALSE
2 51 165 130 70 3 1 F Non Non Non Oui FALSE FALSE FALSE FALSE
3 48 169 150 100 1 1 H Non Non Oui Oui FALSE FALSE FALSE FALSE
4 47 156 100 60 1 1 F Non Non Non Non FALSE FALSE FALSE FALSE
8 60 151 120 80 2 2 F Non Non Non Non FALSE FALSE FALSE FALSE
9 60 157 130 80 3 1 F Non Non Oui Non FALSE FALSE TRUE FALSE
12 61 178 130 90 3 3 H Non Non Oui Oui FALSE FALSE TRUE FALSE
13 48 158 110 70 1 1 F Non Non Oui Non FALSE FALSE TRUE FALSE
14 54 164 110 60 1 1 F Non Non Non Non FALSE FALSE FALSE FALSE
15 61 169 120 80 1 1 F Non Non Oui Non FALSE FALSE FALSE FALSE
16 51 173 120 80 1 1 H Non Non Oui Non FALSE FALSE FALSE FALSE
18 40 165 120 80 1 1 H Non Non Non Non FALSE FALSE FALSE FALSE
21 54 158 110 70 1 1 F Non Non Oui Non FALSE FALSE FALSE FALSE
23 39 181 130 80 1 1 H Oui Oui Oui Non TRUE FALSE TRUE FALSE
24 45 172 120 80 1 1 H Non Non Non Oui FALSE FALSE FALSE FALSE
25 58 170 130 70 1 1 F Non Non Non Non FALSE FALSE FALSE FALSE
27 45 158 110 70 1 3 F Non Non Oui Non FALSE FALSE FALSE FALSE
28 47 154 100 60 1 1 F Non Non Non Non FALSE TRUE TRUE FALSE
29 59 162 120 70 1 1 H Oui Non Oui Non FALSE FALSE FALSE FALSE
30 54 163 120 80 1 1 H Non Non Oui Non FALSE FALSE FALSE FALSE
31 58 157 130 80 1 1 F Non Non Oui Non FALSE FALSE FALSE FALSE
32 63 158 145 85 2 2 F Non Non Oui Oui FALSE FALSE FALSE FALSE
33 64 156 110 60 1 1 H Non Non Oui Non FALSE FALSE FALSE FALSE
35 45 170 150 90 3 1 F Non Non Oui Oui FALSE FALSE FALSE FALSE

6. Statistiques univariées

Pour plus de simplicité à ce stade, on décide de scindé en deux notre dataframe. Notre premier jeu de données sera les données quantitatives et le deuxième, les données qualitatives.

Après vérification, les variables cholesterol et glucose sont des variables qualitatives ordinales (Normal = N, Supérieur à la normale = N+, Bien supérieur à la normale = N++). On décide donc de les passer en facteurs.

glucose <- factor(imput_knn$gluc , levels = c(1,2,3), labels = c('N','N+','N++'), ordered = TRUE)
chol <- factor(imput_knn$cholesterol , levels = c(1,2,3), labels = c('N','N+','N++'), ordered = TRUE)

imput_knn <- data.frame(imput_knn[,c(1,2,3,4,5,8,9,10,11,12)], chol, glucose) 

# pour les variables numériques
id_num  <- which(sapply(imput_knn, is.numeric))
dfw_num <- imput_knn[, id_num]

head(dfw_num,25) %>% kbl(digits=3) %>%   kable_styling(bootstrap_options = "striped", full_width = F, position = "center", latex_options = 'stripped') %>%  scroll_box(width = "1000px", height = "400px")
id age height ap_hi ap_lo
0 50 168 110 80
1 55 156 140 90
2 51 165 130 70
3 48 169 150 100
4 47 156 100 60
8 60 151 120 80
9 60 157 130 80
12 61 178 130 90
13 48 158 110 70
14 54 164 110 60
15 61 169 120 80
16 51 173 120 80
18 40 165 120 80
21 54 158 110 70
23 39 181 130 80
24 45 172 120 80
25 58 170 130 70
27 45 158 110 70
28 47 154 100 60
29 59 162 120 70
30 54 163 120 80
31 58 157 130 80
32 63 158 145 85
33 64 156 110 60
35 45 170 150 90 
# pour les variables catégorielles
id_cat  <- which(!sapply(imput_knn, is.numeric)) 
dfw_cat <- imput_knn[, id_cat] 

head(dfw_cat,25) %>% kbl(digits=3) %>%   kable_styling(bootstrap_options = "striped", full_width = F, position = "center", latex_options = 'stripped') %>%  scroll_box(width = "1000px", height = "400px")
gender smoke alco active cardio chol glucose
H Non Non Oui Non N N
F Non Non Oui Oui N++ N
F Non Non Non Oui N++ N
H Non Non Oui Oui N N
F Non Non Non Non N N
F Non Non Non Non N+ N+
F Non Non Oui Non N++ N
H Non Non Oui Oui N++ N++
F Non Non Oui Non N N
F Non Non Non Non N N
F Non Non Oui Non N N
H Non Non Oui Non N N
H Non Non Non Non N N
F Non Non Oui Non N N
H Oui Oui Oui Non N N
H Non Non Non Oui N N
F Non Non Non Non N N
F Non Non Oui Non N N++
F Non Non Non Non N N
H Oui Non Oui Non N N
H Non Non Oui Non N N
F Non Non Oui Non N N
F Non Non Oui Oui N+ N+
H Non Non Oui Non N N
F Non Non Oui Oui N++ N

6.1. Données quantitatives

Position et Dispersion

On cherche donc maintenant à s’intéresser aux valeurs de notre jeu de données.

PROC_stat_desc <- function(df)
{
  v <- sapply(dfw_num, function(x){is.numeric(x)})
  if(all(v != T)) {stop('donnnées non numériques détectées')}
  
  #--> calcul et mise en forme directe
  ret <- data.frame( "moy_arith"  = sapply(dfw_num[,c(2,3,4,5)], mean)                              ,
                     "moy_har"    = sapply(dfw_num[,c(2,3,4,5)], function(x){ length(x) /sum(1/x)}) ,
                     "moy_geo"    = sapply(dfw_num[,c(2,3,4,5)],function(x){exp(mean(log(x)))} )    ,
                     "mediane"    = sapply(dfw_num[,c(2,3,4,5)], median)                            ,
                     "variance"   = sapply(dfw_num[,c(2,3,4,5)], var)                               ,
                     "ecart_type" = sapply(dfw_num[,c(2,3,4,5)], sd)
  )
  return(ret)
  
}

# appel de a fonction
PROC_stat_desc(dfw_num)
##        moy_arith   moy_har   moy_geo mediane  variance ecart_type
## age     52.84067  51.92101  52.38945      53  45.78923   6.766774
## height 164.35923 163.91520 164.14535     165  67.40617   8.210126
## ap_hi  127.24946 125.36848 126.28265     120 261.03130  16.156463
## ap_lo   81.53561  80.45171  80.99419      80  89.09869   9.439210

On va s’intéresser en premier aux paramètres de position donc aux moyennes et à la médiane. Pour rappel la médiane partage une série de données d’une variable quantitative en deux groupes d’effectifs égaux. Ici par exemple, on voit que la médiane de l’âge de nos patients est de 53ans ce qui signifie qu’il y a autant de patients moins âgés que plus âgés que 53ans. De plus, on voit bien que la moyenne arithmétique d’âge des patients est d’environ 53ans.

Enfin, on étudie les paramètres de dispersion qui sont l’écart-type et la variance. La variance résume l’ensemble des écarts de chaque valeur d’une distribution par rapport à la moyenne. Si celle-ci est élevée alors la dipersion est importante et à l’inverse, si celle-ci est faible alors la dispersion est petite. Ici, on remarque que la variance de l’âge ou de la taille sont beaucoup plus petites que la variance de la pression artérielle systolique ce qui nous indique donc que l’âge et la taille des patients ne varient pas énormément mais à l’inverse de la pression artérielle systolique connait une grande dispersion.

En ce qui concerne l’écart-type, il mesure aussi l’écart par rapport à la moyenne. Il nous confirme donc bien nos premières estimations en ce qui concerne l’âge et la taille. On obtient un écart-type relativement faible qui indique une faible dispersion. A l’inverse, pour la pression artérielle systolique, l’écart-type est relativement élevé ce qui indique une grande dipersion.

On remarque que pour les pressions artérielles systolique et diastolique leur médiane est de 120 et 80 ce qui représente une valeur normale de pression artérielle ce qui veut dire qu’il y a autant de patients avec des pressions artérielles normale que avec de l’hypertension.

Distribution en intervalles

On étudie maintenant la distribution des données quantitatives en intervalles. On choisit ici de scindé notre variable age en quatre classes pour pouvoir étudier l’effectif de notre variable sélectionnée.

age   <- dfw_num$age
n_class <- 4

step <- (max(age) - min(age)) / n_class
intervalles <- seq(min(age) - 0.01, max(age) + 0.1, step)
# la variable classif est une variable catégorielle
classif_patient <- cut(age, breaks = intervalles)
# la variable étant catégorielle, on utilise la fonction table
table_patient  <- table(classif_patient) 
table_patient
## classif_patient
##   (29,37.7] (37.7,46.5] (46.5,55.2]   (55.2,64] 
##           4       13980       28688       25141

On voit donc qu’il y a très peu de patients dans notre jeu de données âgés entre 29 ans et 38 ans. La plus grosse partie des patients enregistrés ont plus de 47 ans, ils représentent 77% des patients de notre base de données.

On calcule ensuite le centre de chacune de nos classes:

mid_step          <- step/2
mid_intervalles   <- NULL
for (i in 2 : length(intervalles)){mid_intervalles[i-1] <- (intervalles[i] + intervalles[i-1])/2}
mid_intervalles
## [1] 33.365 42.115 50.865 59.615

Une fois que tout est exécuté, on dispose de tous les éléments pour construire le tableau de distribution observée sous forme d’un dataframe.

dist_obs <- data.frame( 'xi' = mid_intervalles, 'ni' = as.numeric(table_patient)) 
rownames(dist_obs) <- names(table_patient)

head(dist_obs,25) %>% kbl(digits=3) %>%   kable_styling(bootstrap_options = "striped", full_width = F, position = "center", latex_options = 'stripped') %>%  scroll_box(width = "1000px", height = "400px")
xi ni
(29,37.7] 33.365 4
(37.7,46.5] 42.115 13980
(46.5,55.2] 50.865 28688
(55.2,64] 59.615 25141

On obtient alors sous forme d’un tableau nos valeurs observées. On discrétise nos variables pour les analyser. La première colonne correspond à nos différentes classe avec leurs bornes inférieures et supérieures. La deuxième colonne correspond au centre de la classe que nous avons préalablement calculée et enfin la troisième colonne correspond au nombre d’observations (ici de patients) observées dans l’intervalle de classe.

A partir du tableau de distribution, nous calculons les éléments nécessaires à l’estimation de la moyenne et de la variance.

dist_obs['Ni']    <- cumsum(dist_obs$ni)
dist_obs['fi']    <- dist_obs$ni  / sum(dist_obs$ni)
dist_obs['Fi']    <- dist_obs$Ni  / sum(dist_obs$ni)
dist_obs['xifi']  <- dist_obs$xi  * dist_obs$fi
dist_obs['xi2']   <- dist_obs$xi  * dist_obs$xi
dist_obs['xi2fi'] <- dist_obs$xi2 * dist_obs$fi

head(dist_obs,25) %>% kbl(digits=3) %>%   kable_styling(bootstrap_options = "striped", full_width = F, position = "center", latex_options = 'stripped') %>%  scroll_box(width = "1000px", height = "400px")
xi ni Ni fi Fi xifi xi2 xi2fi
(29,37.7] 33.365 4 4 0.000 0.000 0.002 1113.223 0.066
(37.7,46.5] 42.115 13980 13984 0.206 0.206 8.682 1773.673 365.652
(46.5,55.2] 50.865 28688 42672 0.423 0.629 21.518 2587.248 1094.524
(55.2,64] 59.615 25141 67813 0.371 1.000 22.102 3553.948 1317.591

On observe donc ici: - la colonne Ni : le dénombrement cumulé de chaque classe - la colonne fi : l’estimation en pourcentage d’observations dans la classe - la colonne Fi : l’estimation en pourcentage d’observation cumulées dans la classe - la colonne xifi : la milieu de la classe multiplié par l’estimation en pourcentage d’observations dans la classe - la colonne xi2 : le milieu de la classe au carré - la colonne xi2fi : le milieu de la classe au carré multiplié par l’estimation en pourcentage d’observations dans la classe.

Toutes ces observations sur la distribution vont nous servir à déterminer la variance et la moyenne :

moyenne  <- sum(dist_obs$xifi)
moyenne
## [1] 52.30409
variance <- sum(dist_obs$xi2fi) 
variance
## [1] 2777.833

Histogramme

gr = ggplot(dfw_num) + geom_histogram(aes(x = age), bins = (n_class -1), fill = '#0066CC', colour = 'navy') 
gr

On voit donc bien la distribution en trois intervalles qui nous indique donc bien que la plus grande distribution est dans l’intervalle des patients ayant entre 44 et 62ans environ.

Distribution en fréquence

On utilise ici la fonction quantiles qui permet d’estimer la distribution en fréquence. Par exemple, pour estimer la distribution en fréquence de l’âge des patients on fait :

int_freq <- seq(0,1,0.25) # on peut ici modifier les intervalles 
quant_age <- quantile(dfw_num$age, probs = int_freq)
quant_age
##   0%  25%  50%  75% 100% 
##   29   48   53   58   64
gr <- ggplot(dfw_num) + geom_boxplot(aes(y = age), fill = '#0066CC', colour = 'navy' ) + xlab('') + theme( axis.text.x = element_blank())
gr

Grâce au boxplot, on voit bien la distribution en fréquence de notre varaible age. On voit par exemple bien que à 50% de la distribution les patients ont environ 53ans.

6.2. Données qualitatives

On regarde la distribution des données qualitatives de notre jeu de données :

lapply(dfw_cat, table)
## $gender
## 
##     F     H 
## 45530 24470 
## 
## $smoke
## 
##   Non   Oui 
## 63831  6169 
## 
## $alco
## 
##   Non   Oui 
## 66236  3764 
## 
## $active
## 
##   Non   Oui 
## 13739 56261 
## 
## $cardio
## 
##   Non   Oui 
## 35021 34979 
## 
## $chol
## 
##     N    N+   N++ 
## 52619  9488  7893 
## 
## $glucose
## 
##     N    N+   N++ 
## 59732  5060  5208

On voit donc bien les différentes distributions. On a dans notre jeu de données : - 65% de femmes enregistrés pour 35% d’hommes, - 91% de non fumeurs contre 9% de fumeurs, - 95% de personnes qui ne boivent pas contre 5% de personnes qui boivent, - 20% de personnes non sportives contre 80% de personnes pratiquant une activité sportive, - 50% de personnes non cardiaques et 50% de personnes cardiaques, - 75% de personnes ont un taux de cholesterol normal, 14% ont un taux de cholesterol supérieur à la normale et 11% ont un taux de cholesterol bien supérieur à la normale, - 85% de personnes ont un taux de glucose normal, 7% ont un taux de glucose supérieur à la normale et 8% ont un taux de glucose bien supérieur à la normale.

On remarque donc une majorité de personnes (hommes ou femmes) ayant une bonne qualité de vie (ne fumant pas, ne buvant pas et pratiquant du sport) contre une petite partie. Néanmoins, on observe que 50% de ces patients ont une maladie cardiovasculaire. Et concernant les taux de glucose et de cholesterol, une grande majorité ont des taux normaux.

7. Statistiques bivariées

On étudie à présent les statistiques bivariées qui ont pour objectif principale de mesurer et de visualiser la dépendance entre deux variables On va procéder en 3 étapes :

7.1. Croisement de deux variables quantitatives

On va donc avoir un coefficient de corrélation qui va nous permettre d’estimer la dépendance entre deux variables quantitatives.

round(cor(dfw_num),2)
##        id   age height ap_hi ap_lo
## id      1  0.00   0.00  0.00  0.00
## age     0  1.00  -0.08  0.21  0.16
## height  0 -0.08   1.00  0.01  0.03
## ap_hi   0  0.21   0.01  1.00  0.72
## ap_lo   0  0.16   0.03  0.72  1.00
corrplot(cor(dfw_num), method = 'ellipse', type = 'upper')

On remarque donc ici que le coefficient de corrélation est relativement faible pour l’ensemble des variables quantitatives. La seule corrélation nettement remarquée est la dépendance entre la pression artérielle systolique et la pression artérielle diastolique ce qui est donc logique. Le pourcentage du coefficient de corrélation est de 72% entre ces deux pressions artérielles. On observe aussi un taux de corrélation légèrement plus élevé entre les pressions artérielles et l’âge. Ce qui indique donc que plus l’âge est élevé plus il y a de chance d’avoir de l’hypertension.

gr <- ggplot(data = dfw_num) + geom_point (aes(x = ap_lo, y = ap_hi), size = 1, colour = "#0066CC") + 
  geom_smooth(method= 'lm', aes(x = ap_lo, y = ap_hi), size = 1, colour = "0666CC")
gr
## `geom_smooth()` using formula 'y ~ x'

On remarque donc bien la dépendance entre les deux pressions artérielles. En effet, pour une grande majorité on observe que si la pression systolique est faible alors la pression diastolique le sera aussi car ces deux dernières sont dépendantes l’une de l’autre. De plus, en ce qui concerne la droite de régression en rouge, elle nous montre très clairement la dépendance entre les pressions artérielles.

7.2. Croisement de deux variables qualitatives

On s’intéresse ici à la dépendance de deux variables qualitatives. Dans un premier temps, nous voulions étudier l’intégralité des dépendance avec la fonction ‘tab1 <- table(dfw_cat)’ mais cela faisait beaucoup et n’avait plus de sens. Nous avons donc décider de représenter les dépendances les plus intéressantes.

tab1 <- table(dfw_cat$cardio, dfw_cat$glucose) 
tab1
##      
##           N    N+   N++
##   Non 31022  2060  1939
##   Oui 28710  3000  3269
tab2 <- table(dfw_cat$cardio, dfw_cat$chol) 
tab2
##      
##           N    N+   N++
##   Non 29461  3715  1845
##   Oui 23158  5773  6048

Après une étude, les plus intéressantes à étudier sont les maladies cardiovasculaire en fonction du taux de glucose ainsi que du taux de cholesterol. En effet, on voit bien que lorsque le patient a un taux de glucose bien supérieur à la normale, il y a une plus forte probabilité que cette même personne ait une maladie cardiovasculaire. Il en est de même avec le taux de cholesterol. On voit bien que si la personne à un taux de cholesterol bien supérieur à la normale alors il y a plus de chance que celui ci présente une maladie cardiovasculaire.

On utilise la fonction suivante pour estimer la probabilité jointe. Cette fréquence relative représente la proportion de la population observée dans certaines des classes de la variable.

ptab1 <- prop.table(tab1) # proportion de patients cardiaques dans la variable gender
round(ptab1*100,1) # permet d'arrondir la fréquence et de la mettre sous forme de pourentage
##      
##          N   N+  N++
##   Non 44.3  2.9  2.8
##   Oui 41.0  4.3  4.7
ptab2 <- prop.table(tab2) # proportion de patients cardiaques dans la variable gender
round(ptab2*100,1) # permet d'arrondir la fréquence et de la mettre sous forme de pourentage
##      
##          N   N+  N++
##   Non 42.1  5.3  2.6
##   Oui 33.1  8.2  8.6

On voit bien ici qu’une personne avec un taux de glucose bien supérieur à la normale à une plus grande probabilité en pourcentage d’avoir une maladie cardivasculaire 4.7% contre 2.8%. Et idem pour le taux de cholesterol qui est de 8.6% contre 2.6%.

7.3. Croisement d’une variable qualitative et d’une variable quantitative

On veut désormais étudié les statistiques entre les variables quantitatives et qualitatives. Pour cela, on cherche à estimer les paramètres statistiques par niveau de facteurs de la variable qualitative. Ici, on sélectionne comme variable qualitative le genre (homme ou femme). On décide d’étudier la moyenne et l’écart-type en fonction du sexe des patients. On va ainsi pouvoir déterminer la corrélation entre ces différentes variables.

out <- aggregate(dfw_num[,c(2,3,4,5)], by = list(dfw_cat$gender), mean) # moyenne
out
##   Group.1      age   height    ap_hi    ap_lo
## 1       F 52.95434 161.3556 126.5622 81.06427
## 2       H 52.62918 169.9479 128.5281 82.41263

On voit donc ici, que la moyenne d’âge des hommes et des femmes dans notre jeu de données est similaire tout comme la moyenne des pressions artérielles. La seule différence observée est sur la moyenne de la taille qui diffère.

Finalement, on étudie les pressiosn artérielles en fonction de toutes les variables qualitatives :

out1 <- aggregate(dfw_num[,c(4,5)], by = list(dfw_cat$chol), mean)
out1
##   Group.1    ap_hi    ap_lo
## 1       N 125.3976 80.66510
## 2      N+ 131.6994 83.45700
## 3     N++ 134.2459 85.02927
out2 <- aggregate(dfw_num[,c(4,5)], by = list(dfw_cat$glucose), mean)
out2
##   Group.1    ap_hi    ap_lo
## 1       N 126.5426 81.20609
## 2      N+ 131.7980 83.60395
## 3     N++ 130.9376 83.30549
out3 <- aggregate(dfw_num[,c(4,5)], by = list(dfw_cat$smoke), mean)
out3
##   Group.1    ap_hi    ap_lo
## 1     Non 127.1133 81.46258
## 2     Oui 128.6586 82.29130
out4 <- aggregate(dfw_num[,c(4,5)], by = list(dfw_cat$cardio), mean)
out4
##   Group.1    ap_hi    ap_lo
## 1     Non 120.1710 78.23569
## 2     Oui 134.3365 84.83950
out5 <- aggregate(dfw_num[,c(4,5)], by = list(dfw_cat$alco), mean)
out5
##   Group.1    ap_hi    ap_lo
## 1     Non 127.1076 81.44091
## 2     Oui 129.7455 83.20218
out6 <- aggregate(dfw_num[,c(4,5)], by = list(dfw_cat$active), mean)
out6
##   Group.1    ap_hi    ap_lo
## 1     Non 127.2266 81.51285
## 2     Oui 127.2550 81.54117

On voit donc ici que le glucose et le cholesterol influent légèrement sur les différentes pressions artérielles. En effet, avec un taux de glucose normal les moyennes des pressions artérielles sont plus faible que avec un taux de glucose supérieur et bien supérieur à la normale. Et idem pour le cholesterol.

Concernant les autres variables qualitatives, on remarque que le fait d’être fumeur ou de boire de l’alcool n’influent quasiment pas sur les pressions artérielles de notre jeu de données puisque la différence entre les moyennes est très faible. Pour la pratique d’activités sportives, il n’y a aucune différence si oui ou non on pratique une activité sur les moyennes des pressions artérielles.

Enfin, on voit qu’il y a une forte dépendance entre les maladie cardivasculaire et les pressions artérielles. En effet, on voit bien que les moyennes des pressions artérielles sont plus basses lorsque le patient n’a pas de maladie cardiovasculaire et inversement.

Maintenant, on va étudier l’écart-type

out1 <- aggregate(dfw_num[,c(4,5)], by = list(dfw_cat$chol), sd)
out1
##   Group.1    ap_hi     ap_lo
## 1       N 15.23993  9.074694
## 2      N+ 18.39742 10.405029
## 3     N++ 16.25547  9.454028
out2 <- aggregate(dfw_num[,c(4,5)], by = list(dfw_cat$glucose), sd)
out2
##   Group.1    ap_hi     ap_lo
## 1       N 15.84816  9.305292
## 2      N+ 18.45828 10.456551
## 3     N++ 16.04578  9.472438
out3 <- aggregate(dfw_num[,c(4,5)], by = list(dfw_cat$smoke), sd)
out3
##   Group.1    ap_hi    ap_lo
## 1     Non 16.11324 9.403192
## 2     Oui 16.53266 9.772921
out4 <- aggregate(dfw_num[,c(4,5)], by = list(dfw_cat$cardio), sd)
out4
##   Group.1    ap_hi    ap_lo
## 1     Non 11.74932 8.112946
## 2     Oui 16.84569 9.517830
out5 <- aggregate(dfw_num[,c(4,5)], by = list(dfw_cat$alco), sd)
out5
##   Group.1    ap_hi     ap_lo
## 1     Non 16.09194  9.367044
## 2     Oui 17.06275 10.491650
out6 <- aggregate(dfw_num[,c(4,5)], by = list(dfw_cat$active), sd)
out6
##   Group.1    ap_hi    ap_lo
## 1     Non 15.93149 9.305739
## 2     Oui 16.21106 9.471592

L’écart-type nous reconfirme les premières estimations faites grâce à la moyenne.

On utilise ensuite des boxplots pour visualier les statistiques bivariées :

gr <- ggplot(dfw) + geom_boxplot(aes(x = cardio, y =  age, fill = gender) )
gr

On étudie ici des âges en fonction des maladies cardiovasculaire et on ajoute une variable qualitative le genre (homme ou femme). On remarque donc qu’en majorité les personnes atteintes de maladies cardiovasculaire sont plus âgées et que celles qui ne sont pas atteintes sont en général plus jeunes. Enfin en ce qui concerne le genre, il n’a pas d’influence ici.

Conclusion

On peut donc conclure de nos statistiques descriptives qu’il y a plus de chance qu’une personne âgée ait une maladie cardiovasculaire et que ces maladies sont souvent signes d’hypertension artérielle qui elle peut être liée à un taux trop élevé de glucose et/ou de cholesterol.