
Créer un tableau synthétique explorant le lien entre une variable catégorielle et une multitude d’autres
Cet article a pour objectif de présenter une procédure pour automatiser la création de multiples tableaux croisés testant la relation entre une variable catégorielle principale et une multitude d’autres.
Voici le premier type de graphique que nous allons créer. Il s’agit de tableaux en chaîne, croisant une variable principale et chacune d’un ensemble de variables secondaires : le but est d’explorer rapidement leurs relations deux à deux. Les résultats pour chacune des relations sont de jolis tableaux croisés en pourcentages-ligne, affichant des cellules de largeur proportionnelle aux pourcentages. Le nom de la variable secondaire, le résultat d’un test khi2 d’indépendance et le V de Cramer sont indiqués à droite des lignes. Les résidus standardisés sont affichés dans chacune des cellules par un +
(sur-représentation à un niveau 0.95), un -
(sous-représentation à un niveau 0.95) ou rien du tout (pas de sur/sous-représentation) :
1) Préparations
J’utilise dans la suite les données issues de l’enquête Histoire de vie - Construction des identités menée par l’INSEE. J’utilise ces données mises en formes de la manière décrite par un article précédent de ce site : vous devez donc au préalable suivre cette procédure pour avoir sous la main les données chargées dans un objet, qu’il faut nommer d pour que les opérations présentées ci-après puissent s’exécuter. Un fichier reprenant l’ensemble du script présenté dans cette page et les données utilisées est téléchargeable en fin d’article.
Nous allons commencer par déterminer les variables d’intérêt dans des éléments génériques. Cela nous permet de définir les variables à utiliser au tout début du script, ce qui nous évitera de changer tout le script par la suite quand nous réaliserons ce même tableau avec d’autres variables :
- La variable principale est définie dans la colonne GROUPE_tableau_synthetique ;
- Les variables secondaires sont définie dans un vecteur nommé, appelé variables_sec. Le principe est que les valeurs du vecteurs désignent le nom des colonnes/variables dans la base de données, et leurs noms correspondent aux labels que l’on veut voir affichés en entête dans le graphique :
# Définir la variable principale qui ventilera tous les résultats et indiquer son nom
d$GROUPE_tableau_synthetique <- d$nivetud
label_groupe_tableau_synthetique <- "Niveau d'étude"
# /!\ ICI entrer les variables secondaires
# Ecrire les labels et le nom réel des variables dans la BDD
variables_sec <- c("Sexe" = "sexe",
"Age" = "age_rec",
"CSP" = "qualif",
"Lecture de BD" = "lecture.bd",
"Cinéma" = "cinema",
"Sport" = "sport")
2) Calcul des résultats
Il est alors possible de croiser systématiquement la variable principale avec chacune des variables secondaires à l’aide d’une boucle for. Celle-ci est inspirée d’une idée découverte dans un manuel R écrit par Joseph Larmarange. En voici la logique :
- La boucle exécute le code pour chaque
i
contenu dansas.character(variables_sec)
, autrement dit les noms des variables secondaires qui ont été déclarées ci-dessus dans le vecteur variables_sec ; - La boucle crée des tableaux entre la variable principale et chacune des variables secondaires par le biais de
table(d$GROUPE_tableau_synthetique, d[[i]]
, puisqued[[i]]
désigne successivement chacune des variables secondaires au fil des différentes itérations de la boucle ; - Le premier
table()
lancé crée un tableau en pourcentages par ligne, ensuite converti en dataframe dans l’objet tmp. Les effectifs sont également produits sous forme de dataframe dans l’objet tmp.n, et sont après ramenés dans l’objet tmp, qui concentre l’information ; - Un test khi2 d’indépendance est pratiqué, stocké dans l’objet test. La liste des résidus par cellules est produite sous forme de dataframe dans l’objet tmp.chi, pour être également rapatriée dans l’objet tmp dans les lignes correspondantes ;
- Une nouvelle colonne tmp$var est créée, contenant dans une même chaîne de charactères le nom de la variable secondaire correspondant à la ligne, le résultat du test khi2 d’indépendance et la valeur du V de Cramer pour qualifier la force du lien entre cette variable et la variable principale ;
- Les résultats de la boucle sont alors progressivement ajouté dans un objet res, augmenté à chaque itération de la boucle par un bind_rows pour ajouter les résultat de chaque variable secondaire (les noms ont été homogénéisés au préalable pour que l’opération soit possible) :
library(questionr) # Pour le V de cramer
library(tidyverse)
res <- tibble()
# Inspiration : https://larmarange.github.io/analyse-R/analyse-R.pdf
for (i in as.character(variables_sec)) {
tmp <- as.data.frame((prop.table(table(d$GROUPE_tableau_synthetique, d[[i]]), 2)*100))
tmp.n <- as.data.frame(table(d$GROUPE_tableau_synthetique, d[[i]]))
tmp$n <- tmp.n$Freq
names(tmp) <- c("groupe", "level", "percentage", "n")
test <- chisq.test(d$GROUPE_tableau_synthetique, d[[i]])
tmp.chi <- as.data.frame(test$residuals)
tmp$residuals <- tmp.chi$Freq
cramer <- cramer.v(table(d$GROUPE_tableau_synthetique, d[[i]]))
tmp$var <- paste0(
names(variables_sec)[variables_sec == i],
"\n",
scales::pvalue(test$p.value, add_p = TRUE),
"\n",
round(cramer, digits = 2)
)
res <- bind_rows(res, tmp)
}
Pour les besoins du graphique que l’on va construire par la suite, je calcule avec dplyr une nouvelle colonne res$level.n, dans laquelle les effectifs n sont calculés et ajoutés entre parenthèse à la suite des noms des modalités level des différentes variables secondaires. Je calcule également si les résidus standardisés de la ligne sont significativement positifs ou négatifs à un niveau de confiance 0,95 : j’indique un +
lorsque le résidus est supérieur à 1,96 et un -
lorsqu’il est inférieur à 1,96 (ce qui correspond bien à un niveau de confiance de 0,95 sur une normale centrée réduite).
# Je calcule le nombre d'observation par groupe pour créer un nouveau label.
res <- res %>%
group_by(var, level) %>%
mutate (level.n = paste0(level, " (", sum(n), ")"))
# Je crée les + et - sur base des résidus significatifs
res$sign <- ""
res$sign[res$residuals >= 1.96] <- "+"
res$sign[res$residuals <= -1.96] <- "-"
Je dispose ainsi d’un dataframe qui liste les pourcentages par ligne, effectifs, résidus standardisés et noms des modalités issus de chacun des croisements entre les modalités de la variable principale et celles des variables secondaires (tout le tableau n’est pas affiché, celui-ci étant trop long) :
3) Graphique en pourcentages par ligne (taille des cellules variable)
Il est désormais possible de mettre ces résultats bien plus joliment en forme grâce à ggplot 2. Ce dernier est déjà chargé à travers le tidyverse ; nous allons cependant avoir besoin d’opérer un traitement préalable grâce au package tidytext. Celui-ci possède la fonction bien utile reorder_within qui permet de réordonner différemment les modalités au sein de différents sous-groupes selon un critère. On ordonne ainsi dans un nouvel objet tableau_synthetique_khi2 les modalités des différentes variables secondaires, sur base du pourcentage par ligne (n’appliquez pas cette partie du code pour bien comprendre son intérêt) :
library(tidytext) # Pour la fonction reorder_within
# Fonction reorder_within de tidytext -> voir : https://juliasilge.com/blog/reorder-within/
tableau_synthetique_khi2 <- res %>%
group_by(groupe) %>%
mutate(level.n = reorder_within(level.n, percentage, var))
Passons à la création du graphique même. Il s’agit d’un geom_bar sur base de l’objet tableau_synthetique_khi2. Dans ses paramètres, on indique que la hauteur des barres est définie par le pourcentage (percentage) et qu’il y a autant de barres différentes que de modalités (level.n) ; on positionne les barres les unes au dessus des autres pour occuper toute la hauteur (position = "fill") et l’on précise que la hauteur des barres est explicitement mentionnée dans une colonne (stat = "identity"). On trouve malgré tout l’une ou l’autre subtilité que je précise ici :
- On remarque des conditions pour le geom_text, sous la forme
geom_text(aes(label = if_else(percentage > 3, paste0(round(res$percentage, digits = 0), sign), print("")))
. Le code réalise deux choses : il colle le signe de significativité des résidus standardisés après le pourcentage (arrondi) et affiche l’ensemble si ce dernier est au moins de 3% ; il n’affiche rien si le pourcentage est inférieur à 3%. L’utilité est de ne pas afficher les pourcentage trop petits, illisibles dans de petites cellules ; - La fonction facet_grid est utilisée pour créer autant de panneaux qu’il y a de variables secondaires. Cette fonction est expliquée plus en détail dans la documentation de ggplot2 ;
- Il faut utiliser scale_x_reordered, qui fonctionne de pair avec reorder_within afin de reclasser correctement les modalités selon le pourcentage ;
- Le theme_dark() de ggplot2 est utilisé comme base, et ensuite légèrement personnalisé ;
- Les très jolies palettes de couleur du package viridis sont utilisée, à travers la fonction scale_fill_viridis.
library(viridis) # Pour les palettes de couleur viridis
# Définir le titre du tableau
title_tableau_synthetique <- "Tableau synthétique : Niveau d'étude"
tableau_synthetique_khi2 %>%
ggplot +
aes(y = percentage, x = level.n, fill = fct_rev(groupe)) + # fct_rev pour inverser l'ordre des modalités de la variable principale
geom_bar(position = "fill", stat = "identity") +
geom_text(
aes(label = if_else(percentage > 3, paste0(round(res$percentage, digits = 0), sign), print(""))), # un if_else pour ne pas afficher les pourcentage trop petits (illisibles dans petites cellules)
position = position_fill(vjust = 0.5),
color="white",
size = 3.7,
family = "Arial"
) +
facet_grid(rows = vars(var), scales = "free", space = "free", labeller = label_wrap_gen(width=10)) +
scale_y_continuous(expand = c(0,0)) +
scale_x_reordered(expand = c(0,0)) + # Fonctionne avec reorder_within
coord_flip() +
theme_dark() +
theme(plot.title = element_text(hjust = 0.5),
legend.position="top",
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
panel.spacing = unit(0.5, "lines"),
legend.key = element_blank(),
axis.ticks = element_blank(),
axis.text.x = element_blank(),
strip.text.x = element_blank(),
text = element_text(family = "Arial",
size = 13)) +
guides(fill = guide_legend(reverse = TRUE)) + # Pour inverser la légende des modalités (puisqu'on a inversé l'ordre avec fct_rev au dessus)
scale_fill_viridis(discrete = TRUE,
begin = 0.77,
end = 0.05,
option = "D",
direction = 1) + # Changer la lettre pour changer la couleur (A, B, C, D, E)
xlab("") + ylab("") +
ggtitle(title_tableau_synthetique) +
labs(fill = label_groupe_tableau_synthetique)
Et voici le résultat, joli non ?
4) Graphique en pourcentages par ligne (taille des cellules fixe)
Si pour une raison ou une autre on désire que la taille des cellules ne varie pas avec le pourcentage par ligne, il est possible de fixer leur taille. Pour ce faire, j’utilise une astuce, qui consiste à calculer une nouvelle colonne equi = 100/nlevels(d$GROUPE_tableau_synthetique)
, ce qui revient à diviser 100 par le nombre de modalités de la variable principale (chaque ligne se divisant selon le nombre de ses modalités), afin d’obtenir une valeur égale pour chacune des cellule et dont la somme par ligne est toujours égale à 100 [1]. Il suffit ensuite de créer le même geom_bar que précédemment avec cette valeur equi au lieu du pourcentage réel. On supprime le if_else sur l’affichage du geom_text, puisqu’il n’y a dans cette solution plus de cellules trop petites (et j’ajoute également le signe "%", ayant désormais suffisamment de place) :
tableau_synthetique_khi2 %>%
mutate(equi = 100/nlevels(d$GROUPE_tableau_synthetique)) %>%
ggplot +
aes(y = equi, x = level.n, fill = fct_rev(groupe)) + # fct_rev pour inverser l'ordre des modalités de la variable principale
geom_bar(position = "fill", stat = "identity", colour="black", width = 1) +
geom_text(
aes(label = paste0(round(res$percentage, digits = 0), "%", sign)),
position = position_fill(vjust = 0.5),
color="white",
size = 3.7,
family = "Arial"
) +
facet_grid(rows = vars(var), scales = "free", space = "free", labeller = label_wrap_gen(width=10)) +
scale_y_continuous(expand = c(0,0)) +
scale_x_reordered(expand = c(0,0)) + # Fonctionne avec reorder_within
coord_flip() +
theme_dark() +
theme(plot.title = element_text(hjust = 0.5),
legend.position="top",
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
panel.spacing = unit(0.5, "lines"),
legend.key = element_blank(),
axis.ticks = element_blank(),
strip.text.x = element_blank(),
axis.text.x = element_blank(),
text = element_text(family = "Arial",
size = 13)) +
guides(fill = guide_legend(reverse = TRUE), x = "none") +
scale_fill_viridis(discrete = TRUE,
begin = 0.75,
end = 0.15,
option = "B",
direction = 1) + # Changer la lettre pour changer la couleur (A, B, C, D, E)
xlab("") + ylab("") +
ggtitle(title_tableau_synthetique) +
labs(fill = label_groupe_tableau_synthetique)
Voici le résultat :
5) Graphique en pourcentages par ligne avec résidus standardisés
Le graphique précédent ressemble fortement à une suite de tableaux croisés classiques (sauf les couleurs). Continuons dans cette voie et colorons alors les cellules selon la valeur des résidus, à la manière de l’article Créer de jolis tableaux croisés avec R et ggplot2 de mon blog. Les résidus standardisés constituent une indication qui enrichit fortement la lecture d’un tableau croisé : ils permettent d’indiquer les cellules d’un tableau qui "attirent" ou "repoussent" significativement (dans un sens statistique) par rapport à une situation de référence, généralement l’indépendance entre lignes et colonnes (en considérant donc uniquement les effets des marges) [2]. Ils sont déjà présents dans les deux précédents tableaux à travers les signes +
et -
, mais ne sont pas forcément très visibles.
Notre objectif sera ici de voir comment produire le même tableau que celui vu précédemment, mais en colorant cette fois les cellules en fonction de l’importance des résidus standardisés, et non pas des modalités de la variable principale. A cette fin, je crée une colonne tableau_synthetique_khi2$residuals_cat qui "discrétise" les résidus en 5 catégories de significativité (non significatif, significatif à des niveaux de confiance de 0,95 et 0,99). En outre, je crée une palette de couleur qui associe ces niveaux de significativité à des couleurs dans l’objet palette_crosstable :
# Je discrétise les résidus
tableau_synthetique_khi2$residuals_cat <- "0"
tableau_synthetique_khi2$residuals_cat[tableau_synthetique_khi2$residuals >= 1.96] <- "1.96 (0.95)"
tableau_synthetique_khi2$residuals_cat[tableau_synthetique_khi2$residuals <= -1.96] <- "-1.96 (0.95)"
tableau_synthetique_khi2$residuals_cat[tableau_synthetique_khi2$residuals >= 2.58] <- "2.58 (0.99)"
tableau_synthetique_khi2$residuals_cat[tableau_synthetique_khi2$residuals <= -2.58] <- "-2.58 (0.99)"
tableau_synthetique_khi2$residuals_cat <- factor(tableau_synthetique_khi2$residuals_cat, levels = c("-2.58 (0.99)", "-1.96 (0.95)","0","1.96 (0.95)","2.58 (0.99)"))
# Couleurs pour les résidus
palette_crosstable <- c("-2.58 (0.99)" = "#FF3D7F", "-1.96 (0.95)" = "#FF9E9D", "0" = "white", "1.96 (0.95)" = "#7EC7AF", "2.58 (0.99)" = "#3DB8AF")
Je peux alors entamer la construction du graphique avec ggplot2. J’utilise cette fois la fonction geom_tile, dont je paramètre que la couleur des cellules varie en fonction des résidus discrétisés (info que l’on trouve dans residuals_cat) :
tableau_synthetique_khi2 %>%
ggplot(aes(level.n, groupe)) +
geom_tile(aes(fill = residuals_cat),
colour = "grey") +
scale_y_discrete(expand = c(0,0)) +
scale_fill_manual(values = alpha(palette_crosstable, .70)) +
geom_text(aes(label = paste(round(percentage, digits = 0),
"%") ),
size = 3.7,
family = "Arial") +
facet_grid(var ~ ., scales = "free", space = "free", labeller = label_wrap_gen(width=10)) +
coord_flip() +
scale_x_reordered(expand = c(0,0)) + # Fonctionne avec reorder_within
theme(plot.title = element_text(hjust = 0.5),
legend.position="top",
panel.spacing = unit(0.5, "lines"),
axis.ticks = element_blank(),
axis.text.x = element_text(angle=35, hjust = 1),
text = element_text(family = "Arial",
size = 13)) +
labs(fill = "Résidus") +
xlab("") + ylab("") +
ggtitle(title_tableau_synthetique)
Et voilà le résultat ! les cellules dans lesquelles on trouve une sur/sous-représentation qui n’est pas liée à la fluctuation d’échantillonnage sont colorées, permettant de voir celles-ci d’un coup d’œil.