diff --git a/analyse-R.html b/analyse-R.html index 823185a9..245a3d4b 100644 --- a/analyse-R.html +++ b/analyse-R.html @@ -186,7 +186,7 @@
-
-
+
@@ -411,7 +411,7 @@

Présentation de RStudio

-
+
@@ -463,7 +463,7 @@

Voir aussi

-
+
@@ -855,7 +855,7 @@

Autocomplétion

-
+
@@ -1369,7 +1369,7 @@

Et ensuite ?

-
+
@@ -1437,7 +1437,7 @@

Mise à jour des extensions

-
+
@@ -1711,7 +1711,7 @@

tibbles

-
+
@@ -2210,7 +2210,7 @@

En résumé

-
+
@@ -3188,7 +3188,7 @@

En résumé

-
+
@@ -3612,7 +3612,7 @@

Quelques fonctions supplémentaires

-
+
@@ -3733,7 +3733,7 @@

Appeler un script depuis un autre script

-
+
@@ -4112,7 +4112,7 @@

Sauver ses données

-
+
@@ -4433,7 +4433,7 @@

Où trouver des extensions intéressantes ?

-
+
@@ -5658,7 +5658,7 @@

makeCodebook (dataMaid)

-
+
@@ -6559,7 +6559,7 @@

Recodage et data.table

-
+
@@ -7219,7 +7219,7 @@

dplyr et survey

-
+
@@ -7396,7 +7396,7 @@

Réorganiser un tableau

-
+
@@ -7654,7 +7654,7 @@

Extension data.table

-
+
@@ -7816,7 +7816,7 @@

Extension data.table

-
+
@@ -9388,7 +9388,7 @@

Ajouter des observations

-
+ -
+ -
+
@@ -9699,7 +9699,7 @@

Ressources

-
+
@@ -9730,6 +9730,9 @@

Réorganiser ses données avec tidyr

La version originale de ce chapitre a été écrite par Julien Barnier dans le cadre de son Introduction à R et au tidyverse.

+
+

Ce chapitre est évoqué dans le webin-R #13 (exemples de graphiques avancés) sur YouTube.

+

Tidy data

Comme indiqué dans l’introduction au tidyverse, les extensions du tidyverse comme dplyr ou ggplot2 partent du principe que les données sont “bien rangées” sous forme de tidy data.

@@ -10763,7 +10766,7 @@

Fichiers volumineux

-
+
@@ -10960,7 +10963,7 @@

Combinaison des résultats

-
+
@@ -11089,7 +11092,7 @@

Sauvegarder des objets

-
+
@@ -11194,7 +11197,7 @@

Export avec ggplot2

-
+
@@ -12602,7 +12605,7 @@

Exporter les graphiques obtenus

-
+
@@ -14998,7 +15001,7 @@

Tableaux faciles avec gtsummary

-
+
@@ -15044,6 +15047,9 @@

Introduction à ggplot2, la grammaire des graphique

Ce chapitre est tiré d’une séance de cours de François Briatte et destinée à des étudiants de L2 sans aucune connaissance de R. Cette séance de cours est elle-même inspirée d’un exercice tiré d’un cours de Cosma Shalizi.

+
+

Ce chapitre est évoqué dans le webin-R #08 (ggplot2 et la grammaires des graphiques) sur YouTube.

+

R possède un puissant moteur graphique interne, qui permet de dessiner dans un graphique en y rajoutant des segments, des points, du texte, ou toutes sortes d’autres symboles. Toutefois, pour produire un graphique complet avec les fonctions basiques de R, il faut un peu bricoler : d’abord, ouvrir une fenêtre ; puis rajouter des points ; puis rajouter des lignes ; tout en configurant les couleurs au fur-et-à-mesure ; puis finir par fermer la fenêtre graphique.

L’extension ggplot21, développée par Hadley Wickham et mettant en œuvre la grammaire graphique théorisée par Leland Wilkinson, devient vite indispensable lorsque l’on souhaite réaliser des graphiques plus complexes2. On renvoit le lecteur intéressé à l’ouvrage de Winston Chang, R Graphics Cookbook, disponible gratuitement dans sa deuxième édition à l’adresse suivante : https://r-graphics.org.

Ce chapitre, articulé autour d’une étude de cas, présente ggplot2 à partir d’un exemple simple de visualisation de séries temporelles, puis rentre dans le détail de sa syntaxe. Pour une présentation plus formelle, on pourra se référer au chapitre dédié de la section Approfondir.

@@ -15286,7 +15292,7 @@

Extensions de ggplot2

-
+
@@ -15315,6 +15321,7 @@

Graphiques univariés et bivariés avec ggplot2

Ce chapitre est évoqué dans le webin-R #03 (statistiques descriptives avec gtsummary et esquisse) sur YouTube.

+

Ce chapitre est évoqué dans le webin-R #09 (Graphiques uni- et bivariés avec ggplot2) sur YouTube.

Après avoir introduit l’extension ggplot2 au travers d’une étude de cas, nous reprenons ici les graphiques produits dans les chapitres statistique univariée et statistique bivariée et montrons comment les réaliser avec ggplot2.

@@ -15835,7 +15842,7 @@

Exporter les graphiques obtenus

-
+
@@ -15861,6 +15868,9 @@

Données pondérées

+
+

Ce chapitre est évoqué dans le webin-R #10 (Données pondérées, plan d’échantillonnage complexe & survey) sur YouTube.

+

S’il est tout à fait possible de travailler avec des données pondérées sous R, cette fonctionnalité n’est pas aussi bien intégrée que dans la plupart des autres logiciels de traitement statistique. En particulier, il y a plusieurs manières possibles de gérer la pondération. Cependant, lorsque l’on doit également prendre un compte un plan d’échantillonnage complexe (voir section dédiée ci-après), R fournit tous les outils nécessaires, alors que dans la plupart des logiciels propriétaires, il faut disposer d’une extension adéquate, pas toujours vendue de base avec le logiciel.

Dans ce qui suit, on utilisera le jeu de données tiré de l’enquête Histoire de vie et notamment sa variable de pondération poids1.

library(questionr)
@@ -16887,7 +16897,7 @@ 

Conclusion

-
+
@@ -17066,7 +17076,7 @@

Données pondérées et l’extension survey

-
+
@@ -18548,7 +18558,7 @@

Tests dans les tableaux de gtsummary

-
+
@@ -18565,6 +18575,9 @@

Définir un plan d’échantillonnage complexe

+
+

Ce chapitre est évoqué dans le webin-R #10 (Données pondérées, plan d’échantillonnage complexe & survey) sur YouTube.

+

L’extension survey ne permet pas seulement d’indiquer une variable de pondération mais également de prendre les spécificités du plan d’échantillonnage (strates, grappes, …). Le plan d’échantillonnage ne joue pas seulement sur la pondération des données, mais influence le calcul des variances et par ricochet tous les tests statistiques. Deux échantillons identiques avec la même variable de pondération mais des designs différents produiront les mêmes moyennes et proportions mais des intervalles de confiance différents.

Le site officiel (en anglais) comporte beaucoup d’informations, mais pas forcément très accessibles :
http://r-survey.r-forge.r-project.org/.

@@ -18622,7 +18635,7 @@

Extraire un sous-échantillon

-
+ -
+
@@ -23432,7 +23445,7 @@

Régression logistique multinomiale

<none> 16 1979.857 - etud 8 1988.068 - trav.imp 10 2016.791 -

La plupart des fonctions vues précédemment fonctionnent :

+

La plupart des fonctions vues précédemment fonctionnent, y compris tbl_regression (par contre, add_global_p n’est pour le moment pas compatible)  :

summary(regm2)
Call:
 multinom(formula = trav.satisf ~ etud + trav.imp, data = d)
@@ -23473,146 +23486,17 @@ 

Régression logistique multinomiale

{"columns":[{"label":[""],"name":["_rn_"],"type":[""],"align":["left"]},{"label":["OR"],"name":[1],"type":["dbl"],"align":["right"]},{"label":["2.5 %"],"name":[2],"type":["dbl"],"align":["right"]},{"label":["97.5 %"],"name":[3],"type":["dbl"],"align":["right"]},{"label":["p"],"name":[4],"type":["dbl"],"align":["right"]}],"data":[{"1":"0.8948496","2":"0.36891824","3":"2.170551","4":"0.805878421","_rn_":"Satisfaction/(Intercept)"},{"1":"1.0503906","2":"0.62662899","3":"1.760724","4":"0.852026888","_rn_":"Satisfaction/etudSecondaire"},{"1":"1.0810496","2":"0.67427204","3":"1.733230","4":"0.746260102","_rn_":"Satisfaction/etudTechnique/Professionnel"},{"1":"2.0127473","2":"1.23972010","3":"3.267795","4":"0.004668761","_rn_":"Satisfaction/etudSupérieur"},{"1":"0.5836722","2":"0.18324174","3":"1.859146","4":"0.362362820","_rn_":"Satisfaction/etudmanquant"},{"1":"1.2942058","2":"0.56148541","3":"2.983103","4":"0.544976949","_rn_":"Satisfaction/trav.impAussi"},{"1":"0.8389362","2":"0.37444660","3":"1.879611","4":"0.669600230","_rn_":"Satisfaction/trav.impMoins"},{"1":"0.5490833","2":"0.18393230","3":"1.639149","4":"0.282661454","_rn_":"Satisfaction/trav.impPeu"},{"1":"0.3258311","2":"0.09083751","3":"1.168745","4":"0.085306052","_rn_":"Insatisfaction/(Intercept)"},{"1":"0.9072155","2":"0.41422897","3":"1.986920","4":"0.807660187","_rn_":"Insatisfaction/etudSecondaire"},{"1":"1.0875484","2":"0.53919437","3":"2.193572","4":"0.814634911","_rn_":"Insatisfaction/etudTechnique/Professionnel"},{"1":"1.0806396","2":"0.51000705","3":"2.289737","4":"0.839580764","_rn_":"Insatisfaction/etudSupérieur"},{"1":"0.9572980","2":"0.18424328","3":"4.973964","4":"0.958603498","_rn_":"Insatisfaction/etudmanquant"},{"1":"0.7961422","2":"0.23554433","3":"2.690969","4":"0.713701054","_rn_":"Insatisfaction/trav.impAussi"},{"1":"0.5868213","2":"0.18312418","3":"1.880469","4":"0.369662736","_rn_":"Insatisfaction/trav.impMoins"},{"1":"3.8196198","2":"1.05027036","3":"13.891181","4":"0.041909177","_rn_":"Insatisfaction/trav.impPeu"}],"options":{"columns":{"min":{},"max":[10]},"rows":{"min":[10],"max":[10]},"pages":{}}}
-

De même, il est possible de calculer la matrice de confusion :

-
table(predict(regm2, newdata = d), d$trav.satisf)
-
                
-                 Equilibre Satisfaction Insatisfaction
-  Equilibre            262          211             49
-  Satisfaction         171          258             45
-  Insatisfaction        18           11             23
-

La fonction tidy_plus_plus peut s’appliquer au résultat de multinom :

-
library(broom.helpers)
-tidy_plus_plus(regm2, exponentiate = TRUE)
-
- -
-

On notera la présence d’une colonne supplémentaire, y.level. De fait, la fonction ggcoef_model de GGally ne peut s’appliquer directement, car les coefficients vont se supperposer. On aura dès lors recours à sa variante ggcoef_multinom dédiée aux modèles multinomiax.

-
library(GGally)
-ggcoef_multinom(
-  regm2,
-  exponentiate = TRUE
-)
-

-
ggcoef_multinom(
-  regm2,
-  type = "faceted",
-  exponentiate = TRUE
-)
-
-La fonction ggcoef_multinom -

Il est possible de représenter les effets marginaux du modèle avec la fonction allEffects de l’extension effects.

-
library(effects)
-plot(allEffects(regm2))
-
-Effets marginaux du modèle multinomial -

Une alternative est d’avoir recours à la fonction ggeffect de l’extension ggeffects.

-
library(ggeffects)
-plot(ggeffect(regm2, "trav.imp"))
-

-
plot(ggeffect(regm2, "etud"))
-
-Représentation alternative des effets marginaux du modèle multinomial -
-
-
-

Régression logistique ordinale

-

La régression logistique ordinale s’applique lorsque la variable à expliquer possède trois ou plus modalités qui sont ordonnées (par exemple : modéré, moyen, fort).

-

L’extension la plus utilisée pour réaliser des modèles ordinaux est ordinal et sa fonction clm. Il est même possible de réaliser des modèles ordinaux avec des effets aléatoires (modèles mixtes) à l’aide de la fonction clmm.

-

Pour une bonne introduction à l’extension ordinal, on pourra se référer au tutoriel officiel (en anglais) : https://cran.r-project.org/web/packages/ordinal/vignettes/clm_tutorial.pdf.

-

Une autre introduction pertinente (en français) et utilisant cette fois-ci l’extention VGAM et sa fonction vglm est disponible sur le site de l’université de Lyon : https://eric.univ-lyon2.fr/~ricco/cours/didacticiels/data-mining/didacticiel_Reg_Logistique_Polytomique_Ordinale.pdf.

-

On va reprendre l’exemple précédent puisque la variable trav.satisf est une variable ordonnée.

-
freq(d$trav.satisf)
-
- -
-

ATTENTION : Dans le cas d’une régression logistique ordinale, il importante que les niveaux du facteur soient classés selon leur ordre hiéarchique (du plus faible au plus fort). On va dès lors recoder notre variable à expliquer.

-
d$trav.satisf <- factor(d$trav.satisf, c("Insatisfaction", "Equilibre", "Satisfaction"), ordered = TRUE)
-freq(d$trav.satisf)
-
- -
-
library(ordinal)
-rego <- clm(trav.satisf ~ sexe + etud + trav.imp, data = d)
-summary(rego)
-
formula: trav.satisf ~ sexe + etud + trav.imp
-data:    d
-
- link  threshold nobs logLik  AIC     niter max.grad
- logit flexible  1048 -978.61 1977.23 5(0)  5.41e-09
- cond.H 
- 3.9e+02
-
-Coefficients:
-                            Estimate Std. Error z value
-sexeHomme                   -0.16141    0.12215  -1.321
-etudSecondaire               0.05558    0.23220   0.239
-etudTechnique/Professionnel  0.03373    0.21210   0.159
-etudSupérieur                0.61336    0.21972   2.792
-etudmanquant                -0.45555    0.48761  -0.934
-trav.impAussi                0.35104    0.38578   0.910
-trav.impMoins                0.02616    0.37174   0.070
-trav.impPeu                 -1.66062    0.46204  -3.594
-                            Pr(>|z|)    
-sexeHomme                   0.186369    
-etudSecondaire              0.810819    
-etudTechnique/Professionnel 0.873660    
-etudSupérieur               0.005245 ** 
-etudmanquant                0.350174    
-trav.impAussi               0.362857    
-trav.impMoins               0.943896    
-trav.impPeu                 0.000325 ***
----
-Signif. codes:  
-0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
-
-Threshold coefficients:
-                         Estimate Std. Error z value
-Insatisfaction|Equilibre  -2.0226     0.4189  -4.829
-Equilibre|Satisfaction     0.3391     0.4113   0.825
-(952 observations deleted due to missingness)
-

Une fois encore, il est possible de faire une sélection descendante pas à pas.

-
rego2 <- step(rego)
-
Start:  AIC=1977.23
-trav.satisf ~ sexe + etud + trav.imp
-
-           Df    AIC
-- sexe      1 1977.0
-<none>        1977.2
-- etud      4 1990.6
-- trav.imp  3 2013.2
-
-Step:  AIC=1976.97
-trav.satisf ~ etud + trav.imp
-
-           Df    AIC
-<none>        1977.0
-- etud      4 1990.6
-- trav.imp  3 2011.6
-

L’extension broom propose une méthode tidy pour les objets clm.

-
tidy(rego2, exponentiate = TRUE, conf.int = TRUE)
-
- -
-

La méthode tidy étant disponible, on peut utiliser ggcoef_model et tbl_regression.

-
library(JLutils)
-library(GGally)
-ggcoef_model(rego2, exponentiate = TRUE)
-
-Coefficients du modèle ordinal -
tbl_regression(rego, exponentiate = TRUE)
+
tbl_regression(regm2, exponentiate = TRUE)
+
i Multinomial models have a different underlying structure than the models
+gtsummary was designed for. Other gtsummary functions designed to work with
+tbl_regression objects may yield unexpected results.
+
Warning: The `.dots` argument of `group_by()` is deprecated
+as of dplyr 1.0.0.
-
+
- + + + + - + - + - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -23986,27 +23926,27 @@

Régression logistique ordinale

- - + + - - - + + + - - - + + + - - - + + + @@ -24022,21 +23962,21 @@

Régression logistique ordinale

- - - + + + - - - + + + - - - + + + @@ -24045,75 +23985,658 @@

Régression logistique ordinale

1 - CI = Confidence Interval + OR = Odds Ratio, CI = Confidence Interval

Characteristicexp(Beta) +OR1 + 95% CI1 p-value
Satisfaction
SexeNiveau d'étude
FemmePrimaire
Homme0.850.67, 1.080.2Secondaire1.050.63, 1.760.9
Technique/Professionnel1.080.67, 1.730.7
Supérieur2.011.24, 3.270.005
manquant0.580.18, 1.860.4
Importance du travail
Le plus
Aussi1.290.56, 2.980.5
Moins0.840.37, 1.880.7
Peu0.550.18, 1.640.3
Insatisfaction
Niveau d'étude
Secondaire1.060.67, 1.670.910.41, 1.99 0.8
Technique/Professionnel1.030.68, 1.570.91.090.54, 2.190.8
Supérieur1.851.20, 2.840.0051.080.51, 2.290.8
manquant0.630.24, 1.660.40.960.18, 4.97>0.9
Importance du travail
Aussi1.420.66, 3.030.40.800.24, 2.690.7
Moins1.030.49, 2.13>0.90.590.18, 1.880.4
Peu0.190.08, 0.47<0.0013.821.05, 13.90.042
+
car::Anova(regm2)
+
+
-
-

Données pondérées et l’extension survey

-

Lorsque l’on utilise des données pondérées, on aura recours à l’extension survey6.

-

Préparons des données d’exemple :

-
library(survey)
-dw <- svydesign(ids = ~1, data = d, weights = ~poids)
-
-

Régression logistique binaire

-

L’extension survey fournit une fonction svyglm permettant de calculer un modèle statistique tout en prenant en compte le plan d’échantillonnage spécifié. La syntaxe de svyglm est proche de celle de glm. Cependant, le cadre d’une régression logistique, il est nécessaire d’utiliser family = quasibinomial() afin d’éviter un message d’erreur indiquant un nombre non entier de succès :

-
reg <- svyglm(sport ~ sexe + age + relig + heures.tv, dw, family = binomial())
-
Warning in eval(family$initialize): non-integer #successes
-in a binomial glm!
-
reg <- svyglm(sport ~ sexe + age + relig + heures.tv, dw, family = quasibinomial())
-reg
-
Independent Sampling design (with replacement)
-svydesign(ids = ~1, data = d, weights = ~poids)
-
-Call:  svyglm(formula = sport ~ sexe + age + relig + heures.tv, design = dw, 
-    family = quasibinomial())
-
-Coefficients:
-                     (Intercept)  
-                         1.53590  
-                       sexeHomme  
-                         0.36526  
-                             age  
-                        -0.04127  
-     religPratiquant occasionnel  
-                         0.05577  
- religAppartenance sans pratique  
-                         0.16367  
-religNi croyance ni appartenance  
-                         0.03988  
-                      religRejet  
-                        -0.14862  
-                religNSP ou NVPR  
-                        -0.22682  
-                       heures.tv  
-                        -0.18204  
-
-Degrees of Freedom: 1994 Total (i.e. Null);  1986 Residual
-  (5 observations deleted due to missingness)
-Null Deviance:      2672 
-Residual Deviance: 2378     AIC: NA
-

Le résultat obtenu est similaire à celui de glm et l’on peut utiliser sans problème les fonctions coef, confint, odds.ratio, predict ou encore tidy, tidy_plus_plus et ggcoef_model.

-
odds.ratio(reg)
+

De même, il est possible de calculer la matrice de confusion :

+
table(predict(regm2, newdata = d), d$trav.satisf)
+
                
+                 Equilibre Satisfaction Insatisfaction
+  Equilibre            262          211             49
+  Satisfaction         171          258             45
+  Insatisfaction        18           11             23
+

La fonction tidy_plus_plus peut s’appliquer au résultat de multinom :

+
library(broom.helpers)
+tidy_plus_plus(regm2, exponentiate = TRUE)
-
tidy_plus_plus(reg, exponentiate = TRUE)
+

On notera la présence d’une colonne supplémentaire, y.level. De fait, la fonction ggcoef_model de GGally ne peut s’appliquer directement, car les coefficients vont se supperposer. On aura dès lors recours à sa variante ggcoef_multinom dédiée aux modèles multinomiax.

+
library(GGally)
+ggcoef_multinom(
+  regm2,
+  exponentiate = TRUE
+)
+

+
ggcoef_multinom(
+  regm2,
+  type = "faceted",
+  exponentiate = TRUE
+)
+
+La fonction ggcoef_multinom +

Il est possible de représenter les effets marginaux du modèle avec la fonction allEffects de l’extension effects.

+
library(effects)
+plot(allEffects(regm2))
+
+Effets marginaux du modèle multinomial +

Une alternative est d’avoir recours à la fonction ggeffect de l’extension ggeffects.

+
library(ggeffects)
+plot(ggeffect(regm2, "trav.imp"))
+

+
plot(ggeffect(regm2, "etud"))
+
+Représentation alternative des effets marginaux du modèle multinomial +
+
+
+

Régression logistique ordinale

+

La régression logistique ordinale s’applique lorsque la variable à expliquer possède trois ou plus modalités qui sont ordonnées (par exemple : modéré, moyen, fort).

+

L’extension la plus utilisée pour réaliser des modèles ordinaux est ordinal et sa fonction clm. Il est même possible de réaliser des modèles ordinaux avec des effets aléatoires (modèles mixtes) à l’aide de la fonction clmm.

+

Pour une bonne introduction à l’extension ordinal, on pourra se référer au tutoriel officiel (en anglais) : https://cran.r-project.org/web/packages/ordinal/vignettes/clm_tutorial.pdf.

+

Une autre introduction pertinente (en français) et utilisant cette fois-ci l’extention VGAM et sa fonction vglm est disponible sur le site de l’université de Lyon : https://eric.univ-lyon2.fr/~ricco/cours/didacticiels/data-mining/didacticiel_Reg_Logistique_Polytomique_Ordinale.pdf.

+

On va reprendre l’exemple précédent puisque la variable trav.satisf est une variable ordonnée.

+
freq(d$trav.satisf)
+
+

ATTENTION : Dans le cas d’une régression logistique ordinale, il importante que les niveaux du facteur soient classés selon leur ordre hiéarchique (du plus faible au plus fort). On va dès lors recoder notre variable à expliquer.

+
d$trav.satisf <- factor(d$trav.satisf, c("Insatisfaction", "Equilibre", "Satisfaction"), ordered = TRUE)
+freq(d$trav.satisf)
+
+ +
+
library(ordinal)
+rego <- clm(trav.satisf ~ sexe + etud + trav.imp, data = d)
+summary(rego)
+
formula: trav.satisf ~ sexe + etud + trav.imp
+data:    d
+
+ link  threshold nobs logLik  AIC     niter max.grad
+ logit flexible  1048 -978.61 1977.23 5(0)  5.41e-09
+ cond.H 
+ 3.9e+02
+
+Coefficients:
+                            Estimate Std. Error z value
+sexeHomme                   -0.16141    0.12215  -1.321
+etudSecondaire               0.05558    0.23220   0.239
+etudTechnique/Professionnel  0.03373    0.21210   0.159
+etudSupérieur                0.61336    0.21972   2.792
+etudmanquant                -0.45555    0.48761  -0.934
+trav.impAussi                0.35104    0.38578   0.910
+trav.impMoins                0.02616    0.37174   0.070
+trav.impPeu                 -1.66062    0.46204  -3.594
+                            Pr(>|z|)    
+sexeHomme                   0.186369    
+etudSecondaire              0.810819    
+etudTechnique/Professionnel 0.873660    
+etudSupérieur               0.005245 ** 
+etudmanquant                0.350174    
+trav.impAussi               0.362857    
+trav.impMoins               0.943896    
+trav.impPeu                 0.000325 ***
+---
+Signif. codes:  
+0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+Threshold coefficients:
+                         Estimate Std. Error z value
+Insatisfaction|Equilibre  -2.0226     0.4189  -4.829
+Equilibre|Satisfaction     0.3391     0.4113   0.825
+(952 observations deleted due to missingness)
+

Une fois encore, il est possible de faire une sélection descendante pas à pas.

+
rego2 <- step(rego)
+
Start:  AIC=1977.23
+trav.satisf ~ sexe + etud + trav.imp
+
+           Df    AIC
+- sexe      1 1977.0
+<none>        1977.2
+- etud      4 1990.6
+- trav.imp  3 2013.2
+
+Step:  AIC=1976.97
+trav.satisf ~ etud + trav.imp
+
+           Df    AIC
+<none>        1977.0
+- etud      4 1990.6
+- trav.imp  3 2011.6
+

L’extension broom propose une méthode tidy pour les objets clm.

+
tidy(rego2, exponentiate = TRUE, conf.int = TRUE)
+
+
-
tbl_regression(reg, exponentiate = TRUE)
+

La méthode tidy étant disponible, on peut utiliser ggcoef_model et tbl_regression.

+
library(JLutils)
+library(GGally)
+ggcoef_model(rego2, exponentiate = TRUE)
+
+Coefficients du modèle ordinal +
tbl_regression(rego, exponentiate = TRUE)
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Characteristicexp(Beta) +95% CI1 +p-value
Sexe
Femme
Homme0.850.67, 1.080.2
Niveau d'étude
Primaire
Secondaire1.060.67, 1.670.8
Technique/Professionnel1.030.68, 1.570.9
Supérieur1.851.20, 2.840.005
manquant0.630.24, 1.660.4
Importance du travail
Le plus
Aussi1.420.66, 3.030.4
Moins1.030.49, 2.13>0.9
Peu0.190.08, 0.47<0.001
+

+ 1 + + + CI = Confidence Interval +

+
+
+
+

Données pondérées et l’extension survey

+

Lorsque l’on utilise des données pondérées, on aura recours à l’extension survey6.

+

Préparons des données d’exemple :

+
library(survey)
+dw <- svydesign(ids = ~1, data = d, weights = ~poids)
+
+

Régression logistique binaire

+

L’extension survey fournit une fonction svyglm permettant de calculer un modèle statistique tout en prenant en compte le plan d’échantillonnage spécifié. La syntaxe de svyglm est proche de celle de glm. Cependant, le cadre d’une régression logistique, il est nécessaire d’utiliser family = quasibinomial() afin d’éviter un message d’erreur indiquant un nombre non entier de succès :

+
reg <- svyglm(sport ~ sexe + age + relig + heures.tv, dw, family = binomial())
+
Warning in eval(family$initialize): non-integer #successes
+in a binomial glm!
+
reg <- svyglm(sport ~ sexe + age + relig + heures.tv, dw, family = quasibinomial())
+reg
+
Independent Sampling design (with replacement)
+svydesign(ids = ~1, data = d, weights = ~poids)
+
+Call:  svyglm(formula = sport ~ sexe + age + relig + heures.tv, design = dw, 
+    family = quasibinomial())
+
+Coefficients:
+                     (Intercept)  
+                         1.53590  
+                       sexeHomme  
+                         0.36526  
+                             age  
+                        -0.04127  
+     religPratiquant occasionnel  
+                         0.05577  
+ religAppartenance sans pratique  
+                         0.16367  
+religNi croyance ni appartenance  
+                         0.03988  
+                      religRejet  
+                        -0.14862  
+                religNSP ou NVPR  
+                        -0.22682  
+                       heures.tv  
+                        -0.18204  
+
+Degrees of Freedom: 1994 Total (i.e. Null);  1986 Residual
+  (5 observations deleted due to missingness)
+Null Deviance:      2672 
+Residual Deviance: 2378     AIC: NA
+

Le résultat obtenu est similaire à celui de glm et l’on peut utiliser sans problème les fonctions coef, confint, odds.ratio, predict ou encore tidy, tidy_plus_plus et ggcoef_model.

+
odds.ratio(reg)
+
+ +
+
tidy_plus_plus(reg, exponentiate = TRUE)
+
+ +
+
tbl_regression(reg, exponentiate = TRUE)
+ -
+
- + + + + - - + + + - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - + + + + + - + + + + + + + + + + + - - - - + + + + + + - - - - + + + + + + - - - - + + + + + + - - - - + + + + + + - + + + + + + + + + + + - - - + + + + + + + + + + + + + + + + + + + + + - - - - + + + + + + - - - - + + + + + + - - - - + + + + + + - - - - + + + + + + - - - - + + + + + + - + + + - - - + + + + + + + + + + + + + + + + + + + + + - - - - + + + + + + - - - - + + + + + + - - - - + + + + + + - - - - + + + + + + - - - - + + + + + + -
CaractéristiqueCharacteristic -OR1 +1, N = 1,0311 -95% CI1 +2, N = 1641 + +3, N = 5531 + +4, N = 2051 + +5, N = 471 p-value
Sexegrpage
Femme[16,25)0 (0%)164 (100%)0 (0%)0 (0%)5 (11%)
[25,45)590 (57%)0 (0%)20 (3.6%)80 (39%)16 (34%)
[45,65)441 (43%)0 (0%)185 (34%)97 (47%)22 (47%)
[65,93]0 (0%)0 (0%)346 (63%)28 (14%)4 (8.5%)
Unknown00200
sexe
Homme1,551,26 – 1,91<0,001429 (42%)74 (45%)220 (40%)161 (79%)15 (32%)
Groupe d'âgesFemme602 (58%)90 (55%)333 (60%)44 (21%)32 (68%)
etud
[16,25)Primaire7 (0.7%)1 (1.3%)402 (73%)50 (25%)6 (14%)
[25,45)0,660,42 – 1,030,065Secondaire267 (26%)15 (19%)65 (12%)35 (17%)5 (12%)
[45,65)0,340,21 – 0,54<0,001Technique/Professionnel406 (40%)48 (62%)48 (8.7%)87 (43%)5 (12%)
[65,99]0,250,15 – 0,43<0,001Supérieur334 (33%)14 (18%)36 (6.5%)30 (15%)27 (63%)
Niveau d'étudeUnknown1786234
peche.chasse
PrimaireNon1,030 (100%)151 (92%)553 (100%)0 (0%)42 (89%)
Oui1 (<0.1%)13 (7.9%)0 (0%)205 (100%)5 (11%)
cinema
Secondaire2,591,77 – 3,83<0,001Non497 (48%)32 (20%)486 (88%)141 (69%)18 (38%)
Technique/Professionnel2,861,98 – 4,17<0,001Oui534 (52%)132 (80%)67 (12%)64 (31%)29 (62%)
Supérieur6,634,55 – 9,80<0,001cuisine
Manquant8,594,53 – 16,6<0,001Non539 (52%)85 (52%)361 (65%)111 (54%)23 (49%)
Nombre d'heures passées devant la télévision par jour0,890,83 – 0,95<0,001Oui492 (48%)79 (48%)192 (35%)94 (46%)24 (51%)
Pratique religieusebricol
Pratiquant regulierNon537 (52%)103 (63%)397 (72%)89 (43%)21 (45%)
Oui494 (48%)61 (37%)156 (28%)116 (57%)26 (55%)
sport
Pratiquant occasionnel0,980,68 – 1,42>0,9Non588 (57%)57 (35%)479 (87%)130 (63%)23 (49%)
Appartenance sans pratique0,990,71 – 1,40>0,9Oui443 (43%)107 (65%)74 (13%)75 (37%)24 (51%)
Ni croyance ni appartenance0,810,55 – 1,180,3lecture.bd
Rejet0,680,39 – 1,190,2Non1,031 (100%)164 (100%)553 (100%)205 (100%)0 (0%)
NSP ou NVPR0,920,40 – 2,020,8Oui0 (0%)0 (0%)0 (0%)0 (0%)47 (100%)
+

1 - OR = rapport de cotes, CI = intervalle de confiance + n (%)

-

Selon les résultats de notre modèle, les hommes pratiquent plus un sport que les femmes et la pratique du sport diminue avec l’âge. Pour représenter les effets différentes variables, on peut avoir recours à la fonction allEffects de l’extension effects.

-
library(effects)
-
Loading required package: carData
-
Registered S3 methods overwritten by 'lme4':
-  method                          from
-  cooks.distance.influence.merMod car 
-  influence.merMod                car 
-  dfbeta.influence.merMod         car 
-  dfbetas.influence.merMod        car 
-
lattice theme set by effectsTheme()
-See ?effectsTheme for details.
-
plot(allEffects(mod))
-
-Représentation graphique des effets du modèle -

Cependant, l’effet de l’âge est-il le même selon le sexe ? Nous allons donc introduire une interaction entre l’âge et le sexe dans notre modèle, ce qui sera représenté par sexe * grpage dans l’équation du modèle.

-
mod2 <- glm(sport ~ sexe * grpage + etud + heures.tv + relig, data = d, family = binomial())
-tbl_regression(mod2, exponentiate = TRUE)
+

On peut également avoir recours à ggtable de GGally pour représenter les résidus du Chi² et mieux repérer les différences.

+
library(GGally)
+d2$typo <- factor(d2$typo)
+ggtable(
+  d2,
+  columnsX = "typo",
+  columnsY = names(d2)[1:9],
+  cells = "col.prop",
+  fill = "std.resid"
+) +
+  labs(fill = "Résidus standardizés du Chi²") +
+  theme(legend.position = "bottom")
+
Warning in chisq.test(xtabs(weight ~ y + x, data = data)):
+Chi-squared approximation may be incorrect
+
+Warning in chisq.test(xtabs(weight ~ y + x, data = data)):
+Chi-squared approximation may be incorrect
+
+Warning in chisq.test(xtabs(weight ~ y + x, data = data)):
+Chi-squared approximation may be incorrect
+
+Warning in chisq.test(xtabs(weight ~ y + x, data = data)):
+Chi-squared approximation may be incorrect
+
+Warning in chisq.test(xtabs(weight ~ y + x, data = data)):
+Chi-squared approximation may be incorrect
+
+Warning in chisq.test(xtabs(weight ~ y + x, data = data)):
+Chi-squared approximation may be incorrect
+
+Résidus du Chi² +
+
+
+

CAH avec l’extension FactoMineR

+

L’extension FactoMineR fournit une fonction HCPC permettant de réaliser une classification hiérarchique à partir du résultats d’une analyse factorielle réalisée avec la même extension (voir la section dédiée du chapitre sur l’ACM).

+

HCPC réalise à la fois le calcul de la matrice des distances, du dendrogramme et le partitionnement de la population en classes. Par défaut, HCPC calcule le dendrogramme à partir du carré des distances du F² et avec la méthode de Ward.

+

Par défaut, l’arbre est affiché à l’écran et l’arbre sera coupé selon la partition ayant la plus grande perte relative d’inertie (comme avec best.cutree). Utilisez graph=FALSE pour ne pas afficher le graphique et l’argument nb.clust pour indiquer le nombre de classes désirées.

+
library(FactoMineR)
+acm2 <- MCA(d2[complete.cases(d2), ], ncp = 5, graph = FALSE)
+cah <- HCPC(acm2, graph = FALSE)
+

On pourra représenter le dendrogramme avec plot et l’argument choice="tree".

+
plot(cah, choice = "tree")
+
+Dendrogramme obtenu avec HCPC (5 axes) +

Il apparait que le dendrogramme obtenu avec HCPC diffère de celui que nous avons calculé précédemment en utilisant la matrice des distances fournies par dist.dudi. Cela est dû au fait que HCPC procède différement pour calculer la matrice des distances en ne prenant en compte que les axes retenus dans le cadre de l’ACM. Pour rappel, nous avions retenu que 5 axes dans le cadre de notre ACM :

+
acm2 <- MCA(d2[complete.cases(d2), ], ncp = 5, graph = FALSE)
+

HCPC n’a donc pris en compte que ces 5 premiers axes pour calculer les distances entre les individus, considérant que les autres axes n’apportent que du « bruit » rendant la classification instable. Cependant, comme le montre summary(acm2), nos cinq premiers axes n’expliquent que 54 % de la variance. Il usuellement préférable de garder un plus grande nombre d’axes afin de couvrir au moins 80 à 90 % de la variance10. De son côté, dist.dudi prends en compte l’ensemble des axes pour calculer la matrice des distances. On peut reproduire cela avec FactoMineR en indiquant ncp=Inf lors du calcul de l’ACM.

+
acm2 <- MCA(d2[complete.cases(d2), ], ncp = Inf, graph = FALSE)
+cah <- HCPC(acm2, nb.clust = -1, graph = FALSE)
+

On obtient bien cette fois-ci le même résultat.

+
plot(cah, choice = "tree")
+
+Dendrogramme obtenu avec HCPC (tous les axes) +

D’autres graphiques sont disponibles, en faisant varier la valeur de l’argument choice :

+
plot(cah, choice = "3D.map")
+
+Représentation en 3 dimensions du dendrogramme +
plot(cah, choice = "bar")
+
+Gains d’inertie +
plot(cah, choice = "map")
+
+Projection des catégories sur le plan factoriel +

L’objet renvoyé par HCPC contient de nombreuses informations. La partition peut notamment être récupérée avec cah$data.clust$clust. Il y a également diverses statistiques pour décrire les catégories.

+
cah
+
**Results for the Hierarchical Clustering on Principal Components**
+   name                   
+1  "$data.clust"          
+2  "$desc.var"            
+3  "$desc.var$test.chi2"  
+4  "$desc.axes$category"  
+5  "$desc.axes"           
+6  "$desc.axes$quanti.var"
+7  "$desc.axes$quanti"    
+8  "$desc.ind"            
+9  "$desc.ind$para"       
+10 "$desc.ind$dist"       
+11 "$call"                
+12 "$call$t"              
+   description                                              
+1  "dataset with the cluster of the individuals"            
+2  "description of the clusters by the variables"           
+3  "description of the cluster var. by the categorical var."
+4  "description of the clusters by the categories."         
+5  "description of the clusters by the dimensions"          
+6  "description of the cluster var. by the axes"            
+7  "description of the clusters by the axes"                
+8  "description of the clusters by the individuals"         
+9  "parangons of each clusters"                             
+10 "specific individuals"                                   
+11 "summary statistics"                                     
+12 "description of the tree"                                
+
freq(cah$data.clust$clust)
+
+ +
+
+
+
+
    +
  1. Pour une présentation de ces différentes distances, on pourra se référer à http://old.biodiversite.wallonie.be/outils/methodo/similarite_distance.htm ou encore à ce support de cours par D. Chessel, J. Thioulouse et A.B. Dufour disponible à http://pbil.univ-lyon1.fr/R/pdf/stage7.pdf.

  2. +
  3. Cette même fonction peut aussi être utilisée pour calculer une distance après une analyse en composantes principales ou une analyse mixte de Hill et Smith.

  4. +
  5. Voir Gower, J. (1971). A General Coefficient of Similarity and Some of Its Properties. Biometrics, 27(4), 857-871. doi:10.2307/2528823 (http://www.jstor.org/stable/2528823).

  6. +
  7. Pour une description mathématique plus détaillée de cette fonction, notamment en cas de valeur manquante, se référer à l’article original de Gower précédemment cité.

  8. +
  9. On pourra consulter le cours de FG Carpentier déjà cité ou bien des ouvrages d’analyse statistique.

  10. +
  11. Ward, J. (1963). Hierarchical Grouping to Optimize an Objective Function. Journal of the American Statistical Association, 58(301), 236-244. doi:10.2307/2282967. (http://www.jstor.org/stable/2282967)

  12. +
  13. Voir par exemple la discussion, en anglais, sur Wikipedia concernant la page présentant la méthode Ward : https://en.wikipedia.org/wiki/Talk:Ward%27s_method

  14. +
  15. Depuis la version 3.1 de R. L’option method = "ward.D" correspondant à la version disponible dans les versions précédentes de R. Mais il est à noter que la méthode décrite par Ward dans son article de 1963 correspond en réalité à method = "ward.D2.

  16. +
  17. Voir http://addicted2or.free.fr/packages/A2R/lastVersion/R/code.R.

  18. +
  19. Voir http://factominer.free.fr/classical-methods/classification-hierarchique-sur-composantes-principales.html

  20. +
+
+ +
+
+ + + +

Effets d’interaction dans un modèle

+ +
+ + + +
+

Ce chapitre est évoqué dans le webin-R #07 (régression logistique partie 2) sur YouTube.

+
+

Dans un modèle statistique classique, on fait l’hypothèse implicite que chaque variable explicative est indépendante des autres. Cependant, cela ne se vérifie pas toujours. Par exemple, l’effet de l’âge peut varier en fonction du sexe. Il est dès lors nécessaire de prendre en compte dans son modèle les effets d’interaction1.

+
+

Exemple d’interaction

+

Reprenons le modèle que nous avons utilisé dans le chapitre sur la régression logistique.

+
library(questionr)
+data(hdv2003)
+d <- hdv2003
+d$sexe <- relevel(d$sexe, "Femme")
+d$grpage <- cut(d$age, c(16, 25, 45, 65, 99), right = FALSE, include.lowest = TRUE)
+d$etud <- d$nivetud
+levels(d$etud) <- c(
+  "Primaire", "Primaire", "Primaire",
+  "Secondaire", "Secondaire", "Technique/Professionnel",
+  "Technique/Professionnel", "Supérieur"
+)
+d$etud <- addNAstr(d$etud, "Manquant")
+library(labelled)
+var_label(d$sport) <- "Pratique du sport ?"
+var_label(d$sexe) <- "Sexe"
+var_label(d$grpage) <- "Groupe d'âges"
+var_label(d$etud) <- "Niveau d'étude"
+var_label(d$relig) <- "Pratique religieuse"
+var_label(d$heures.tv) <- "Nombre d'heures passées devant la télévision par jour"
+

Nous avions alors exploré les facteurs associés au fait de pratiquer du sport.

+
mod <- glm(sport ~ sexe + grpage + etud + heures.tv + relig, data = d, family = binomial())
+library(gtsummary)
+tbl_regression(mod, exponentiate = TRUE)
-
+
- - + + @@ -26439,21 +27251,21 @@

Exemple d’interaction

- - - + + + - - - + + + - - - + + + @@ -26469,26 +27281,26 @@

Exemple d’interaction

- - + + - - + + - - + + - - + + @@ -26511,57 +27323,33 @@

Exemple d’interaction

- - + + - - - + + + - - + + - + - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + @@ -26575,74 +27363,28 @@

Exemple d’interaction

Caractéristique @@ -26421,8 +27233,8 @@

Exemple d’interaction

Homme5,202,46 – 11,71,551,26 – 1,91 <0,001
[25,45)1,020,59 – 1,80>0,90,660,42 – 1,030,065
[45,65)0,610,34 – 1,100,100,340,21 – 0,54<0,001
[65,99]0,460,23 – 0,920,0270,250,15 – 0,43<0,001
Niveau d'étude
Secondaire2,601,77 – 3,852,591,77 – 3,83 <0,001
Technique/Professionnel2,881,99 – 4,212,861,98 – 4,17 <0,001
Supérieur6,774,64 – 10,06,634,55 – 9,80 <0,001
Manquant9,024,68 – 17,88,594,53 – 16,6 <0,001
Pratiquant occasionnel0,990,68 – 1,430,980,68 – 1,42 >0,9
Appartenance sans pratique1,020,73 – 1,440,90,990,71 – 1,40>0,9
Ni croyance ni appartenance0,830,57 – 1,220,810,55 – 1,18 0,3
Rejet 0,680,38 – 1,190,39 – 1,19 0,2
NSP ou NVPR0,930,40 – 2,040,9
Sexe * Groupe d'âges
Homme * [25,45)0,310,13 – 0,700,006
Homme * [45,65)0,240,10 – 0,54<0,001
Homme * [65,99]0,230,09 – 0,590,0030,920,40 – 2,020,8
-

Commençons par regarder les effets du modèle.

-
plot(allEffects(mod2))
-
-Représentation graphique des effets du modèle avec interaction entre le sexe et le groupe d’âge -

Sur ce graphique, on voit que l’effet de l’âge sur la pratique d’un sport est surtout marqué chez les hommes. Chez les femmes, le même effet est observé, mais dans une moindre mesure et seulement à partir de 45 ans.

-

On peut tester si l’ajout de l’interaction améliore significativement le modèle avec anova.

-
anova(mod2, test = "Chisq")
-
- -
-

Jetons maintenant un oeil aux coefficients du modèle. Pour rendre les choses plus visuelles, nous aurons recours à ggcoef_model de l’extension GGally.

-
library(GGally)
-ggcoef_model(mod2, exponentiate = TRUE)
-
-Représentation graphique des coefficients du modèle avec interaction entre le sexe et le groupe d’âge -

Concernant l’âge et le sexe, nous avons trois séries de coefficients : trois coefficients (grpage[25,45), grpage[45,65) et grpage[65,99]) qui correspondent à l’effet global de la variable âge, un coefficient (sexeHomme)pour l’effet global du sexe et trois coefficients qui sont des moficateurs de l’effet d’âge pour les hommes (grpage[25,45), grpage[45,65) et grpage[65,99]).

-

Pour bien interpréter ces coefficients, il faut toujours avoir en tête les modalités choisies comme référence pour chaque variable. Supposons une femme de 60 ans, dont toutes lautres variables correspondent aux modalités de référence (c’est donc une pratiquante régulière, de niveau primaire, qui ne regarde pas la télévision). Regardons ce que prédit le modèle quant à sa probabilité de faire du sport au travers d’une représentation graphique

-
library(breakDown)
-library(ggplot2)
-logit <- function(x) exp(x) / (1 + exp(x))
-nouvelle_observation <- d[1, ]
-nouvelle_observation$sexe[1] <- "Femme"
-nouvelle_observation$grpage[1] <- "[45,65)"
-nouvelle_observation$etud[1] <- "Primaire"
-nouvelle_observation$relig[1] <- "Pratiquant regulier"
-nouvelle_observation$heures.tv[1] <- 0
-plot(
-  broken(mod2, nouvelle_observation, predict.function = betas),
-  trans = logit
-) + ylim(0, 1) + ylab("Probabilité de faire du sport")
-
Scale for 'y' is already present. Adding another scale
-for 'y', which will replace the existing scale.
-
-Représentation graphique de l’estimation de la probabilité de faire du sport pour une femme de 60 ans -

En premier lieu, l’intercept s’applique et permet de déterminer la probabilité de base de faire du sport (si toutes les variables sont à leur valeur de référence). Femme étant la modalité de référence pour la variable sexe, cela ne modifie pas le calcul de la probabilité de faire du sport. Par contre, il y a une modification induite par la modalité 45-65 de la variable grpage.

-

Regardons maintenant la situation d’un homme de 20 ans.

-
nouvelle_observation$sexe[1] <- "Homme"
-nouvelle_observation$grpage[1] <- "[16,25)"
-plot(
-  broken(mod2, nouvelle_observation, predict.function = betas),
-  trans = logit
-) + ylim(0, 1) + ylab("Probabilité de faire du sport")
-
Scale for 'y' is already present. Adding another scale
-for 'y', which will replace the existing scale.
-
-Représentation graphique de l’estimation de la probabilité de faire du sport pour un homme de 20 ans -

Nous sommes à la modalité de référence pour l’âge par contre il y a un effet important du sexe. Le coefficient associé globalement à la variable sexe correspond donc à l’effet du sexe à la modalité de référence du groupe d’âges.

-

La situation est différente pour un homme de 60 ans.

-
nouvelle_observation$grpage[1] <- "[45,65)"
-plot(
-  broken(mod2, nouvelle_observation, predict.function = betas),
-  trans = logit
-) + ylim(0, 1) + ylab("Probabilité de faire du sport")
-
Scale for 'y' is already present. Adding another scale
-for 'y', which will replace the existing scale.
-
-Représentation graphique de l’estimation de la probabilité de faire du sport pour un homme de 60 ans -

Cette fois-ci, il y a plusieurs modifications d’effet. On applique en effet à la fois le coefficient sexe = Homme (effet du sexe pour les 15-24 ans), le coefficient grpage = [45-65) qui est l’effet de l’âge pour les femmes de 45-64 ans et le coefficient sexe:grpage = Homme:[45-65) qui indique l’effet spécifique qui s’applique aux hommes de 45-64, d’une part par rapport aux femmes du même et d’autre part par rapport aux hommes de 16-24 ans. L’effet des coefficients d’interaction doivent donc être interprétés par rapport aux autres coefficients du modèle qui s’appliquent, en tenant compte des modalités de référence.

-

Il est cependant possible d’écrire le même modèle différemment. En effet, sexe * grpage dans la formule du modèle est équivalent à l’écriture sexe + grpage + sexe:grpage, c’est-à-dire à modéliser un coefficient global pour chaque variable plus un des coefficients d’interaction. On aurait pu demander juste des coefficients d’interaction, en ne mettant que sexe:grpage.

-
mod3 <- glm(sport ~ sexe:grpage + etud + heures.tv + relig, data = d, family = binomial())
-tbl_regression(mod3, exponentiate = TRUE)
+

Selon les résultats de notre modèle, les hommes pratiquent plus un sport que les femmes et la pratique du sport diminue avec l’âge. Pour représenter les effets différentes variables, on peut avoir recours à la fonction allEffects de l’extension effects.

+
library(effects)
+
Loading required package: carData
+
Registered S3 methods overwritten by 'lme4':
+  method                          from
+  cooks.distance.influence.merMod car 
+  influence.merMod                car 
+  dfbeta.influence.merMod         car 
+  dfbetas.influence.merMod        car 
+
lattice theme set by effectsTheme()
+See ?effectsTheme for details.
+
plot(allEffects(mod))
+
+Représentation graphique des effets du modèle +

Cependant, l’effet de l’âge est-il le même selon le sexe ? Nous allons donc introduire une interaction entre l’âge et le sexe dans notre modèle, ce qui sera représenté par sexe * grpage dans l’équation du modèle.

+
mod2 <- glm(sport ~ sexe * grpage + etud + heures.tv + relig, data = d, family = binomial())
+tbl_regression(mod2, exponentiate = TRUE)
-
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -27077,52 +27867,22 @@

Exemple d’interaction

- - - - - - - - - - - - - - - - - - - - - - - - - - - + + + - - - - - - - - - + + + - - - + + + @@ -27136,60 +27896,74 @@

Exemple d’interaction

Caractéristique @@ -26987,6 +27729,54 @@

Exemple d’interaction

Sexe
Femme
Homme5,202,46 – 11,7<0,001
Groupe d'âges
[16,25)
[25,45)1,020,59 – 1,80>0,9
[45,65)0,610,34 – 1,100,10
[65,99]0,460,23 – 0,920,027
Niveau d'étude
Femme * [16,25)1,820,92 – 3,580,083
Homme * [16,25)9,464,34 – 21,8<0,001
Femme * [25,45)1,861,17 – 3,000,009
Homme * [25,45)3,021,87 – 4,96<0,001
Femme * [45,65)1,110,69 – 1,800,70,310,13 – 0,700,006
Homme * [45,65)1,350,84 – 2,210,2
Femme * [65,99]0,840,47 – 1,500,60,240,10 – 0,54<0,001
Homme * [65,99]0,230,09 – 0,590,003
-

Au sens strict, ce modèle explique tout autant le phénomène étudié que le modèle précédent. On peut le vérifier facilement avec anova.

-
anova(mod2, mod3, test = "Chisq")
+

Commençons par regarder les effets du modèle.

+
plot(allEffects(mod2))
+
+Représentation graphique des effets du modèle avec interaction entre le sexe et le groupe d’âge +

Sur ce graphique, on voit que l’effet de l’âge sur la pratique d’un sport est surtout marqué chez les hommes. Chez les femmes, le même effet est observé, mais dans une moindre mesure et seulement à partir de 45 ans.

+

On peut tester si l’ajout de l’interaction améliore significativement le modèle avec anova.

+
anova(mod2, test = "Chisq")
-

De même, les effets modélisés sont les mêmes.

-
plot(allEffects(mod3))
-
-Représentation graphique des effets du modèle avec interaction simple entre le sexe et le groupe d’âge -

Par contre, regardons d’un peu plus près les coefficients de ce nouveau modèle. Nous allons voir que leur interprétation est légèrement différente.

-
ggcoef_model(mod3, exponentiate = TRUE)
-
-Représentation graphique des coefficients du modèle avec interaction simple entre le sexe et le groupe d’âge -

Cette fois-ci, il n’y a plus de coefficients globaux pour la variable sexe ni pour grpage mais des coefficients pour chaque combinaison de ces deux variables.

-
plot(
-  broken(mod3, nouvelle_observation, predict.function = betas),
-  trans = logit
-) + ylim(0, 1) + ylab("Probabilité de faire du sport")
+

Jetons maintenant un oeil aux coefficients du modèle. Pour rendre les choses plus visuelles, nous aurons recours à ggcoef_model de l’extension GGally.

+
library(GGally)
+ggcoef_model(mod2, exponentiate = TRUE)
+
+Représentation graphique des coefficients du modèle avec interaction entre le sexe et le groupe d’âge +

Concernant l’âge et le sexe, nous avons trois séries de coefficients : trois coefficients (grpage[25,45), grpage[45,65) et grpage[65,99]) qui correspondent à l’effet global de la variable âge, un coefficient (sexeHomme)pour l’effet global du sexe et trois coefficients qui sont des moficateurs de l’effet d’âge pour les hommes (grpage[25,45), grpage[45,65) et grpage[65,99]).

+

Pour bien interpréter ces coefficients, il faut toujours avoir en tête les modalités choisies comme référence pour chaque variable. Supposons une femme de 60 ans, dont toutes lautres variables correspondent aux modalités de référence (c’est donc une pratiquante régulière, de niveau primaire, qui ne regarde pas la télévision). Regardons ce que prédit le modèle quant à sa probabilité de faire du sport au travers d’une représentation graphique

+
library(breakDown)
+library(ggplot2)
+logit <- function(x) exp(x) / (1 + exp(x))
+nouvelle_observation <- d[1, ]
+nouvelle_observation$sexe[1] <- "Femme"
+nouvelle_observation$grpage[1] <- "[45,65)"
+nouvelle_observation$etud[1] <- "Primaire"
+nouvelle_observation$relig[1] <- "Pratiquant regulier"
+nouvelle_observation$heures.tv[1] <- 0
+plot(
+  broken(mod2, nouvelle_observation, predict.function = betas),
+  trans = logit
+) + ylim(0, 1) + ylab("Probabilité de faire du sport")
Scale for 'y' is already present. Adding another scale
 for 'y', which will replace the existing scale.
-
-Représentation graphique de l’estimation de la probabilité de faire du sport pour un homme de 40 ans -

Cette fois-ci, le coefficient d’interaction fourrnit l’effet global du sexe et de l’âge, et non plus la modification de cette combinaison par rapport aux coefficients globaux. Leur sens est donc différent et il faudra les interpréter en conséquence.

-
-
-

Un second exemple d’interaction

-

Intéressons-nous maintenant à l’interaction entre le sexe et le niveau d’étude. L’effet du niveau d’étude diffère-t-il selon le sexe ?

-
mod4 <- glm(sport ~ sexe * etud + grpage + heures.tv + relig, data = d, family = binomial())
-

Regardons d’abord les effets.

-
plot(allEffects(mod4))
-
-Représentation graphique des effets du modèle avec interaction entre le sexe et le niveau d’étude -

À première vue, l’effet du niveau d’étude semble être le même chez les hommes et chez les femmes. Ceci dit, cela serait peut être plus lisible si l’on superposait les deux sexe sur un même graphique. Nous allons utiliser la fonction ggeffect de l’extension ggeffects qui permets de récupérer les effets calculés avec effect dans un format utilisable avec ggplot2.

-
library(ggeffects)
-

-Attaching package: 'ggeffects'
-
The following object is masked from 'package:cowplot':
-
-    get_title
-
plot(ggeffect(mod4, c("etud", "sexe")))
-
-Effets du niveau d’étude selon le sexe -

Cela confirme ce que l’on suppose. Regardons les coefficients du modèle.

-
ggcoef_model(mod4, exponentiate = TRUE)
-
-Représentation graphique des coefficients du modèle avec interaction simple entre le sexe et le niveau d’étude -
tbl_regression(mod4, exponentiate = TRUE)
+
+Représentation graphique de l’estimation de la probabilité de faire du sport pour une femme de 60 ans +

En premier lieu, l’intercept s’applique et permet de déterminer la probabilité de base de faire du sport (si toutes les variables sont à leur valeur de référence). Femme étant la modalité de référence pour la variable sexe, cela ne modifie pas le calcul de la probabilité de faire du sport. Par contre, il y a une modification induite par la modalité 45-65 de la variable grpage.

+

Regardons maintenant la situation d’un homme de 20 ans.

+
nouvelle_observation$sexe[1] <- "Homme"
+nouvelle_observation$grpage[1] <- "[16,25)"
+plot(
+  broken(mod2, nouvelle_observation, predict.function = betas),
+  trans = logit
+) + ylim(0, 1) + ylab("Probabilité de faire du sport")
+
Scale for 'y' is already present. Adding another scale
+for 'y', which will replace the existing scale.
+
+Représentation graphique de l’estimation de la probabilité de faire du sport pour un homme de 20 ans +

Nous sommes à la modalité de référence pour l’âge par contre il y a un effet important du sexe. Le coefficient associé globalement à la variable sexe correspond donc à l’effet du sexe à la modalité de référence du groupe d’âges.

+

La situation est différente pour un homme de 60 ans.

+
nouvelle_observation$grpage[1] <- "[45,65)"
+plot(
+  broken(mod2, nouvelle_observation, predict.function = betas),
+  trans = logit
+) + ylim(0, 1) + ylab("Probabilité de faire du sport")
+
Scale for 'y' is already present. Adding another scale
+for 'y', which will replace the existing scale.
+
+Représentation graphique de l’estimation de la probabilité de faire du sport pour un homme de 60 ans +

Cette fois-ci, il y a plusieurs modifications d’effet. On applique en effet à la fois le coefficient sexe = Homme (effet du sexe pour les 15-24 ans), le coefficient grpage = [45-65) qui est l’effet de l’âge pour les femmes de 45-64 ans et le coefficient sexe:grpage = Homme:[45-65) qui indique l’effet spécifique qui s’applique aux hommes de 45-64, d’une part par rapport aux femmes du même et d’autre part par rapport aux hommes de 16-24 ans. L’effet des coefficients d’interaction doivent donc être interprétés par rapport aux autres coefficients du modèle qui s’appliquent, en tenant compte des modalités de référence.

+

Il est cependant possible d’écrire le même modèle différemment. En effet, sexe * grpage dans la formule du modèle est équivalent à l’écriture sexe + grpage + sexe:grpage, c’est-à-dire à modéliser un coefficient global pour chaque variable plus un des coefficients d’interaction. On aurait pu demander juste des coefficients d’interaction, en ne mettant que sexe:grpage.

+
mod3 <- glm(sport ~ sexe:grpage + etud + heures.tv + relig, data = d, family = binomial())
+tbl_regression(mod3, exponentiate = TRUE)
-
+
- - - - - - - - - - - - - - - - - - @@ -27565,56 +28321,26 @@

Un second exemple d’interaction

- - - + + + - - + + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + @@ -27637,63 +28363,87 @@

Un second exemple d’interaction

- - - + + + - - - + + + - + - - + + - - - + + + - + - - - - + + + + - - - + + + + + + + + + + + + + + + + + + + + + - - - - + + + + - - - - + + + + + + + + + + @@ -27707,411 +28457,832 @@

Un second exemple d’interaction

Caractéristique @@ -27534,24 +28308,6 @@

Un second exemple d’interaction

Sexe
Femme
Homme1,420,77 – 2,580,3
Niveau d'étude
Secondaire2,251,35 – 3,820,0022,601,77 – 3,85<0,001
Technique/Professionnel3,091,90 – 5,172,881,99 – 4,21 <0,001
Supérieur6,594,02 – 11,16,774,64 – 10,0 <0,001
Manquant5,212,42 – 11,4<0,001
Groupe d'âges
[16,25)
[25,45)0,660,42 – 1,040,071
[45,65)0,340,21 – 0,55<0,001
[65,99]0,250,15 – 0,439,024,68 – 17,8 <0,001
Pratiquant occasionnel0,980,67 – 1,420,90,990,68 – 1,43>0,9
Appartenance sans pratique1,010,72 – 1,43>0,91,020,73 – 1,440,9
Ni croyance ni appartenance 0,830,56 – 1,210,57 – 1,22 0,3
Rejet0,700,40 – 1,230,680,38 – 1,19 0,2
NSP ou NVPR0,900,39 – 1,980,80,930,40 – 2,040,9
Sexe * Niveau d'étudeSexe * Groupe d'âges
Homme * Secondaire1,380,65 – 2,930,4Femme * [16,25)1,820,92 – 3,580,083
Homme * Technique/Professionnel0,870,44 – 1,75Homme * [16,25)9,464,34 – 21,8<0,001
Femme * [25,45)1,861,17 – 3,000,009
Homme * [25,45)3,021,87 – 4,96<0,001
Femme * [45,65)1,110,69 – 1,80 0,7
Homme * Supérieur1,010,49 – 2,07>0,9Homme * [45,65)1,350,84 – 2,210,2
Homme * Manquant4,281,32 – 15,80,020Femme * [65,99]0,840,47 – 1,500,6
Homme * [65,99]
-

Si les coefficients associés au niveau d’étude sont significatifs, ceux de l’interaction ne le sont pas (sauf sexeHomme:etudManquant) et celui associé au sexe, précédemment significatif ne l’est plus. Testons avec anova si l’interaction est belle et bien significative.

-
anova(mod4, test = "Chisq")
+

Au sens strict, ce modèle explique tout autant le phénomène étudié que le modèle précédent. On peut le vérifier facilement avec anova.

+
anova(mod2, mod3, test = "Chisq")
-

L’interaction est bien significative mais faiblement. Vu que l’effet du niveau d’étude reste nénamoins très similaire selon le sexe, on peut se demander s’il est pertinent de la conserver.

+

De même, les effets modélisés sont les mêmes.

+
plot(allEffects(mod3))
+
+Représentation graphique des effets du modèle avec interaction simple entre le sexe et le groupe d’âge +

Par contre, regardons d’un peu plus près les coefficients de ce nouveau modèle. Nous allons voir que leur interprétation est légèrement différente.

+
ggcoef_model(mod3, exponentiate = TRUE)
+
+Représentation graphique des coefficients du modèle avec interaction simple entre le sexe et le groupe d’âge +

Cette fois-ci, il n’y a plus de coefficients globaux pour la variable sexe ni pour grpage mais des coefficients pour chaque combinaison de ces deux variables.

+
plot(
+  broken(mod3, nouvelle_observation, predict.function = betas),
+  trans = logit
+) + ylim(0, 1) + ylab("Probabilité de faire du sport")
+
Scale for 'y' is already present. Adding another scale
+for 'y', which will replace the existing scale.
+
+Représentation graphique de l’estimation de la probabilité de faire du sport pour un homme de 40 ans +

Cette fois-ci, le coefficient d’interaction fourrnit l’effet global du sexe et de l’âge, et non plus la modification de cette combinaison par rapport aux coefficients globaux. Leur sens est donc différent et il faudra les interpréter en conséquence.

-
-

Explorer les différentes interactions possibles

-

Il peut y avoir de multiples interactions dans un modèle, d’ordre 2 (entre deux variables) ou plus (entre trois variables ou plus). Il est dès lors tentant de tester les multiples interactions possibles de manière itératives afin d’identifier celles à retenir. C’est justement le but de la fonction glmulti de l’extension du même nom. glmulti permets de tester toutes les combinaisons d’interactions d’ordre 2 dans un modèle, en retenant le meilleur modèle à partir d’un critère spécifié (par défaut l’AIC). ATTENTION : le temps de calcul de glmulti peut-être long.

-
library(glmulti)
-glmulti(sport ~ sexe + grpage + etud + heures.tv + relig, data = d, family = binomial())
-
Initialization...
-TASK: Exhaustive screening of candidate set.
-Fitting...
+
+

Un second exemple d’interaction

+

Intéressons-nous maintenant à l’interaction entre le sexe et le niveau d’étude. L’effet du niveau d’étude diffère-t-il selon le sexe ?

+
mod4 <- glm(sport ~ sexe * etud + grpage + heures.tv + relig, data = d, family = binomial())
+

Regardons d’abord les effets.

+
plot(allEffects(mod4))
+
+Représentation graphique des effets du modèle avec interaction entre le sexe et le niveau d’étude +

À première vue, l’effet du niveau d’étude semble être le même chez les hommes et chez les femmes. Ceci dit, cela serait peut être plus lisible si l’on superposait les deux sexe sur un même graphique. Nous allons utiliser la fonction ggeffect de l’extension ggeffects qui permets de récupérer les effets calculés avec effect dans un format utilisable avec ggplot2.

+
library(ggeffects)
+

+Attaching package: 'ggeffects'
+
The following object is masked from 'package:cowplot':
 
-After 50 models:
-Best model: sport~1+grpage+heures.tv+sexe:heures.tv+grpage:heures.tv+etud:heures.tv
-Crit= 2284.87861987263
-Mean crit= 2406.80086471225
+    get_title
+
plot(ggeffect(mod4, c("etud", "sexe")))
+
+Effets du niveau d’étude selon le sexe +

Cela confirme ce que l’on suppose. Regardons les coefficients du modèle.

+
ggcoef_model(mod4, exponentiate = TRUE)
+
+Représentation graphique des coefficients du modèle avec interaction simple entre le sexe et le niveau d’étude +
tbl_regression(mod4, exponentiate = TRUE)
+ +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Caractéristique +OR1 + +95% CI1 +p-value
Sexe
Femme
Homme1,420,77 – 2,580,3
Niveau d'étude
Primaire
Secondaire2,251,35 – 3,820,002
Technique/Professionnel3,091,90 – 5,17<0,001
Supérieur6,594,02 – 11,1<0,001
Manquant5,212,42 – 11,4<0,001
Groupe d'âges
[16,25)
[25,45)0,660,42 – 1,040,071
[45,65)0,340,21 – 0,55<0,001
[65,99]0,250,15 – 0,43<0,001
Nombre d'heures passées devant la télévision par jour0,890,83 – 0,95<0,001
Pratique religieuse
Pratiquant regulier
Pratiquant occasionnel0,980,67 – 1,420,9
Appartenance sans pratique1,010,72 – 1,43>0,9
Ni croyance ni appartenance0,830,56 – 1,210,3
Rejet0,700,40 – 1,230,2
NSP ou NVPR0,900,39 – 1,980,8
Sexe * Niveau d'étude
Homme * Secondaire1,380,65 – 2,930,4
Homme * Technique/Professionnel0,870,44 – 1,750,7
Homme * Supérieur1,010,49 – 2,07>0,9
Homme * Manquant4,281,32 – 15,80,020
+

+ 1 + + + OR = rapport de cotes, CI = intervalle de confiance +

+
+

Si les coefficients associés au niveau d’étude sont significatifs, ceux de l’interaction ne le sont pas (sauf sexeHomme:etudManquant) et celui associé au sexe, précédemment significatif ne l’est plus. Testons avec anova si l’interaction est belle et bien significative.

+
anova(mod4, test = "Chisq")
-

Reste à calculer si le rang de naissance de l’enfant est supérieur au nombre idéal d’enfants tel que défini par la mère. On aura recours à la fonction rank appliquée par groupe (ici calculé séparément pour chaque mère). L’argument ties.method permet d’indiquer comment gérer les égalités (ici les naissances multiples, e.g. les jumeaux). Comme nous voulons comparer le rang de l’enfant au nombre idéal d’enfants, nous allons retenir la méthode "max" pour obtenir, dans le cas présent, le nombre total d’enfants déjà nés1. Avant de calculer un rang, il est impératif de trier préalablement le tableau (voir le chapitre Tris).

-
setorder(enfants, id_femme, date_naissance)
-enfants[, rang := rank(date_naissance, ties.method = "max"), by = id_femme]
-enfants[, rang_apres_ideal := "non"]
-# note: unclass() requis en raison d'un bug non corrigé dans haven empéchant de comparer haven_labelled_spss et integer
-enfants[rang > unclass(nb_enf_ideal), rang_apres_ideal := "oui"]
-enfants[, rang_apres_ideal := factor(rang_apres_ideal)]
-enfants[, rang_apres_ideal := relevel(rang_apres_ideal, "non")]
+

L’interaction est bien significative mais faiblement. Vu que l’effet du niveau d’étude reste nénamoins très similaire selon le sexe, on peut se demander s’il est pertinent de la conserver.

-
-

Préparation des données avec dplyr

+
+

Explorer les différentes interactions possibles

+

Il peut y avoir de multiples interactions dans un modèle, d’ordre 2 (entre deux variables) ou plus (entre trois variables ou plus). Il est dès lors tentant de tester les multiples interactions possibles de manière itératives afin d’identifier celles à retenir. C’est justement le but de la fonction glmulti de l’extension du même nom. glmulti permets de tester toutes les combinaisons d’interactions d’ordre 2 dans un modèle, en retenant le meilleur modèle à partir d’un critère spécifié (par défaut l’AIC). ATTENTION : le temps de calcul de glmulti peut-être long.

+
library(glmulti)
+glmulti(sport ~ sexe + grpage + etud + heures.tv + relig, data = d, family = binomial())
+
Initialization...
+TASK: Exhaustive screening of candidate set.
+Fitting...
+
+After 50 models:
+Best model: sport~1+grpage+heures.tv+sexe:heures.tv+grpage:heures.tv+etud:heures.tv
+Crit= 2284.87861987263
+Mean crit= 2406.80086471225
+
+After 100 models:
+Best model: sport~1+etud+heures.tv+grpage:heures.tv
+Crit= 2267.79462883348
+Mean crit= 2360.46497457747
+
+After 150 models:
+Best model: sport~1+grpage+etud+heures.tv+sexe:heures.tv
+Crit= 2228.88574082404
+Mean crit= 2286.60589884071
+
+After 200 models:
+Best model: sport~1+grpage+etud+heures.tv+sexe:heures.tv
+Crit= 2228.88574082404
+Mean crit= 2254.99359340075
+
+After 250 models:
+Best model: sport~1+sexe+grpage+etud+heures.tv+etud:sexe+sexe:heures.tv
+Crit= 2226.00088609349
+Mean crit= 2241.76611580481
+
+After 300 models:
+Best model: sport~1+sexe+grpage+etud+heures.tv+grpage:sexe+sexe:heures.tv
+Crit= 2222.67161519005
+Mean crit= 2234.95020358944
+

On voit qu’au bout d’un moment, l’algorithme se statibilise autour d’un modèle comportant une interaction entre le sexe et l’âge d’une part et entre le sexe et le nombre d’heures passées quotidiennement devant la télé. On voit également que la variable religion a été retirée du modèle final.

+
best <- glm(sport ~ 1 + sexe + grpage + etud + heures.tv + grpage:sexe + sexe:heures.tv, data = d, family = binomial())
+odds.ratio(best)
+
Waiting for profiling to be done...
+
+ +
+
ggcoef_model(best, exponentiate = TRUE)
+
+Représentation graphique des coefficients du modèle avec interaction entre le sexe, le niveau d’étude et le nombre d’heures passées devant la télévision +
plot(allEffects(best))
+
+Représentation graphique des effets du modèle avec interaction entre le sexe, le niveau d’étude et le nombre d’heures passées devant la télévision +
+
+
+

Pour aller plus loin

+

Il y a d’autres extensions dédiées à l’analyse des interactions d’un modèle, de même que de nombreux supports de cours en ligne dédiés à cette question.

+

On pourra en particulier se référer à la vignette inclue avec l’extension phia : https://cran.r-project.org/web/packages/phia/vignettes/phia.pdf.

+
+
+
+
    +
  1. Pour une présentation plus statistique et mathématique des effets d’interaction, on pourra se référer au cours de Jean-François Bickel disponible en ligne.

  2. +
+
+ +
+
+ + + +

Multicolinéarité dans la régression

+ +
+ + + +
+

Ce chapitre est évoqué dans le webin-R #07 (régression logistique partie 2) sur YouTube.

+
+

Dans une régression, la multicolinéarité est un problème qui survient lorsque certaines variables de prévision du modèle mesurent le même phénomène. Une multicolinéarité prononcée s’avère problématique, car elle peut augmenter la variance des coefficients de régression et les rendre instables et difficiles à interpréter. Les conséquences de coefficients instables peuvent être les suivantes :

+
    +
  • les coefficients peuvent sembler non significatifs, même lorsqu’une relation significative existe entre le prédicteur et la réponse ;
  • +
  • les coefficients de prédicteurs fortement corrélés varieront considérablement d’un échantillon à un autre ;
  • +
  • lorsque des termes d’un modèle sont fortement corrélés, la suppression de l’un de ces termes aura une incidence considérable sur les coefficients estimés des autres. Les coefficients des termes fortement corrélés peuvent même présenter le mauvais signe.
  • +
+

La multicolinéarité n’a aucune incidence sur l’adéquation de l’ajustement, ni sur la qualité de la prévision. Cependant, les coefficients individuels associés à chaque variable explicative ne peuvent pas être interprétés de façon fiable.

+
+

Définition

+

Au sens strict, on parle de multicolinéarité parfaite lorsqu’une des variables explicatives d’un modèle est une combinaison linéraire d’une ou plusieurs autres variables explicatives introduites dans le même modèle. L’absence de multicolinéarité parfaite est une des conditions requises pour pouvoir estimer un modèle linéaire et, par extension, un modèle linéaire généralisé (dont les modèles de régression logistique).

+

Dans les faits, une multicolinéarité parfaite n’est quasiment jamais observée. Mais une forte multicolinéarité entre plusieurs variables peut poser problème dans l’estimation et l’interprétation d’un modèle.

+

Une erreur fréquente est de confondre multicolinéarité et corrélation. Si des variables colinéaires sont de facto fortement corrélées entre elles, deux variables corrélées ne sont pas forcément colinéaires. En termes non statistiques, il y a colinéarité lorsque deux ou plusieurs variables mesurent la même chose.

+

Prenons un exemple. Nous étudions les complications après l’accouchement dans différentes maternités d’un pays en développement. On souhaite mettre dans le modèle, à la fois le milieu de résidence (urbain ou rural) et le fait qu’il y ait ou non un médecin dans la clinique. Or, dans la zone d’enquête, les maternités rurales sont dirigées seulement par des sage-femmes tandis que l’on trouve un médecin dans toutes les maternités urbaines sauf une. Dès lors, dans ce contexte précis, le milieu de résidence prédit presque totalement la présence d’un médecin et on se retrouve face à une multicolinéarité (qui serait même parfaite s’il n’y avait pas une clinique urbaine sans médecin). On ne peut donc distinguer l’effet de la présence d’un médecin de celui du milieu de résidence et il ne faut mettre qu’une seule de ces deux variables dans le modèle, sachant que du point de vue de l’interprétation elle capturera à la fois l’effet de la présence d’un médecin et celui du milieu de résidence.

+

Par contre, si dans notre région d’étude, seule la moitié des maternités urbaines disposait d’un médecin, alors le milieu de résidence n’aurait pas été suffisant pour prédire la présence d’un médecin. Certes, les deux variables seraient corrélées mais pas colinéaires. Un autre exemple de corrélation sans colinéarité, c’est la relation entre milieu de résidence et niveau d’instruction. Il y a une corrélation entre ces deux variables, les personnes résidant en ville étant généralement plus instruites. Cependant, il existe également des personnes non instruites en ville et des personnes instruites en milieu rural. Le milieu de résidence n’est donc pas suffisant pour prédire le niveau d’instruction.

+
+
+

Mesure de la colinéarité

+

Il existe différentes mesures de la multicolinéarité. L’extension mctest en fournie plusieurs, mais elle n’est utilisable que si l’ensemble des variables explicatives sont de type numérique.

+

L’approche la plus classique consiste à examiner les facteurs d’inflation de la variance (FIV) ou variance inflation factor (VIF) en anglais. Les FIV estimenent de combien la variance d’un coefficient est augmentée en raison d’une relation linéaire avec d’autres prédicteurs. Ainsi, un FIV de 1,8 nous dit que la variance de ce coefficient particulier est supérieure de 80 % à la variance que l’on aurait dû observer si ce facteur n’est absolument pas corrélé aux autres prédicteurs.

+

Si tous les FIV sont égaux à 1, il n’existe pas de multicolinéarité, mais si certains FIV sont supérieurs à 1, les prédicteurs sont corrélés. Il n’y a pas de consensus sur la valeur au-delà de laquelle on doit considérer qu’il y a multicolinéarité. Certains auteurs, comme Paul Allison1, disent regarder plus en détail les variables avec un FIV supérieur à 2,5. D’autres ne s’inquiètent qu’à partir de 5. Il n’existe pas de test statistique qui permettrait de dire s’il y a colinéarité ou non2.

+

L’extension car fournit une fonction vif permettant de calculer les FIV à partir d’un modèle. Elle implémente même une version généralisée permettant de considérer des facteurs catégoriels et des modèles linéaires généralisés comme la régression logistique.

+

Reprenons, pour exemple, un modèle logistique que nous avons déjà abordé dans d’autres chapitres.

+
library(questionr)
+data(hdv2003)
+d <- hdv2003
+d$sexe <- relevel(d$sexe, "Femme")
+d$grpage <- cut(d$age, c(16, 25, 45, 65, 99), right = FALSE, include.lowest = TRUE)
+d$etud <- d$nivetud
+levels(d$etud) <- c(
+  "Primaire", "Primaire", "Primaire", "Secondaire", "Secondaire",
+  "Technique/Professionnel", "Technique/Professionnel", "Supérieur"
+)
+d$etud <- addNAstr(d$etud, "Manquant")
+mod <- glm(sport ~ sexe + grpage + etud + heures.tv + relig, data = d, family = binomial())
+

Le calcul des FIV se fait simplement en passant le modèle à la fonction vif.

+
library(car)
+

+Attaching package: 'car'
+
The following object is masked _by_ '.GlobalEnv':
+
+    logit
+
The following object is masked from 'package:purrr':
+
+    some
+
The following object is masked from 'package:dplyr':
+
+    recode
+
vif(mod)
+
           GVIF Df GVIF^(1/(2*Df))
+sexe      1.048  1           1.024
+grpage    1.842  3           1.107
+etud      1.848  4           1.080
+heures.tv 1.062  1           1.031
+relig     1.121  5           1.011
+

Dans notre exemple, tous les FIV sont proches de 1. Il n’y a donc pas de problème potentiel de colinéarité à explorer.

+
+
+

La multicolinéarité est-elle toujours un problème ?

+

Là encore, il n’y a pas de consensus sur cette question. Certains analystes considèrent que tout modèle où certains prédicteurs seraient colinéaires n’est pas valable. Dans un billet sur internet, Paul Allison évoque quant à lui des situations où la multicolinéarité peut être ignorée en toute sécurité. Le texte ci-dessous est une traduction du billet de Paul Allison.

+

1. Les variables avec des FIV élevés sont des variables de contrôle, et les variables d’intérêt n’ont pas de FIV élevés.

+

Voici le problème de la multicollinéarité : ce n’est un problème que pour les variables qui sont colinéaires. Il augmente les erreurs-types de leurs coefficients et peut rendre ces coefficients instables de plusieurs façons. Mais tant que les variables colinéaires ne sont utilisées que comme variables de contrôle, et qu’elles ne sont pas colinéaires avec vos variables d’intérêt, il n’y a pas de problème. Les coefficients des variables d’intérêt ne sont pas affectés et la performance des variables de contrôle n’est pas altérée.

+

Voici un exemple tiré de ces propres travaux : l’échantillon est constitué de collèges américains, la variable dépendante est le taux d’obtention de diplôme et la variable d’intérêt est un indicateur (factice) pour les secteurs public et privé. Deux variables de contrôle sont les scores moyens au SAT et les scores moyens à l’ACT pour l’entrée en première année. Ces deux variables ont une corrélation supérieure à ,9, ce qui correspond à des FIV d’au moins 5,26 pour chacune d’entre elles. Mais le FIV pour l’indicateur public/privé n’est que de 1,04. Il n’y a donc pas de problème à se préoccuper et il n’est pas nécessaire de supprimer l’un ou l’autre des deux contrôles, à condition que l’on ne cherche pas à interpréter ou comparer l’un par rapport à l’autre les coefficients de ces deux variables de contrôle.

+

2. Les FIV élevés sont causés par l’inclusion de puissances ou de produits d’autres variables.

+

Si vous spécifiez un modèle de régression avec x et x2, il y a de bonnes chances que ces deux variables soient fortement corrélées. De même, si votre modèle a x, z et xz, x et z sont susceptibles d’être fortement corrélés avec leur produit. Il n’y a pas de quoi s’inquiéter, car la valeur p de xz n’est pas affectée par la multicollinéarité. Ceci est facile à démontrer : vous pouvez réduire considérablement les corrélations en centrant les variables (c’est-à-dire en soustrayant leurs moyennes) avant de créer les puissances ou les produits. Mais la valeur p pour x2 ou pour xz sera exactement la même, que l’on centre ou non. Et tous les résultats pour les autres variables (y compris le R2 mais sans les termes d’ordre inférieur) seront les mêmes dans les deux cas. La multicollinéarité n’a donc pas de conséquences négatives.

+

3. Les variables avec des FIV élevés sont des variables indicatrices (factices) qui représentent une variable catégorielle avec trois catégories ou plus.

+

Si la proportion de cas dans la catégorie de référence est faible, les variables indicatrices auront nécessairement des FIV élevés, même si la variable catégorielle n’est pas associée à d’autres variables dans le modèle de régression.

+

Supposons, par exemple, qu’une variable de l’état matrimonial comporte trois catégories : actuellement marié, jamais marié et anciennement marié. Vous choisissez anciennement marié comme catégorie de référence, avec des variables d’indicateur pour les deux autres. Ce qui se passe, c’est que la corrélation entre ces deux indicateurs devient plus négative à mesure que la fraction de personnes dans la catégorie de référence diminue. Par exemple, si 45 % des personnes ne sont jamais mariées, 45 % sont mariées et 10 % sont anciennement mariées, les valeurs du FIV pour les personnes mariées et les personnes jamais mariées seront d’au moins 3,0.

+

Est-ce un problème ? Eh bien, cela signifie que les valeurs p des variables indicatrices peuvent être élevées. Mais le test global selon lequel tous les indicateurs ont des coefficients de zéro n’est pas affecté par des FIV élevés. Et rien d’autre dans la régression n’est affecté. Si vous voulez vraiment éviter des FIV élevés, il suffit de choisir une catégorie de référence avec une plus grande fraction des cas. Cela peut être souhaitable pour éviter les situations où aucun des indicateurs individuels n’est statistiquement significatif, même si l’ensemble des indicateurs est significatif.

+
+
+
+
    +
  1. https://statisticalhorizons.com/multicollinearity

  2. +
  3. Pour plus de détails, voir ce post de Davig Giles qui explique pourquoi ce n’est pas possible.

  4. +
+
+ +
+
+ + + +

Analyse de survie

+ +
+ + + +
+

Ce chapitre est évoqué dans le webin-R #15 (analyse de survie) sur YouTube.

+
+
+

Ressources en ligne

+

L’extension centrale pour l’analyse de survie est survival.

+

Un très bon tutoriel (en anglais et en 3 étapes), introduisant les concepts de l’analyse de survie, des courbes de Kaplan-Meier et des modèles de Cox et leur mise en oeuvre pratique sous R est disponible en ligne :

+ +

Pour un autre exemple (toujours en anglais) d’analyse de survie avec survival, on pourra se référer à https://rpubs.com/vinubalan/hrsurvival.

+

Pour représenter vos résultats avec ggplot2, on pourra avoir recours à l’extension survminer présentée en détails sur son site officiel (en anglais) : http://www.sthda.com/english/rpkgs/survminer/. On pourra également avoir recours à la fonction ggsurv de l’extension GGally présentée à l’adresse http://ggobi.github.io/ggally/#ggallyggsurv.

+

A noter, il est possible d’utiliser la fonction step sur un modèle de Cox, pour une sélection pas à pas d’un meilleur modèle basé sur une minimisation de l’AIC (voir le chapitre sur la régression logistique).

+

L’excellente extension broom peut également être utilisée sur des modèles de survie (Kaplan-Meier ou Cox) pour en convertir les résultats sous la forme d’un tableau de données.

+

Pour approfondir les possibilités offertes par l’extension survival, on pourra également consulter les différentes vignettes fournies avec l’extension (voir https://cran.r-project.org/package=survival).

+
+
+

Un exemple concret : mortalité infanto-juvénile

+

Dans cet exemple, nous allons utiliser le jeu de données fecondite fourni par l’extension questionr. Ce jeu de données comporte trois tableaux de données : menages, femmes et enfants.

+

Nous souhaitons étudier ici la survie des enfants entre la naissance et l’âge de 5 ans. Dans un premier temps, nous comparerons la survie des jeunes filles et des jeunes garçons. Dans un second temps, nous procéderons à une analyse multivariée en prenant en compte les variables suivantes :

+
    +
  • sexe de l’enfant
  • +
  • milieu de résidence
  • +
  • niveau de vie du ménage
  • +
  • structure du ménage
  • +
  • niveau d’éducation de la mère
  • +
  • âge de la mère à la naissance de l’enfant
  • +
  • enfin, une variable un peu plus compliquée, à savoir si le rang de naissance de l’enfant (second, troisième, quatrième, etc.) est supérieur au nombre idéal d’enfants selon la mère.
  • +
+

Nous allons préparer les données selon deux approches : soit en utilisant l’extension data.table (voir le chapitre dédié à data.table), soit en utilisant l’extension dplyr (voir le chapitre sur dplyr).

+

Chargeons les données en mémoire et listons les variables disponibles.

+
library(questionr, quietly = TRUE)
+data(fecondite)
+lookfor(menages)
+
+ +
+
lookfor(femmes)
+
+ +
+
lookfor(enfants)
+
+ +
+
+
+

Préparation des données avec data.table

Tout d’abord, regardons sous quel format elles sont stockées.

-
data(fecondite)
-class(menages)
+
class(menages)
[1] "tbl_df"     "tbl"        "data.frame"
-
describe(menages)
+
describe(menages)
[1814 obs. x 5 variables] tbl_df tbl data.frame
 
 $id_menage: Identifiant du ménage
@@ -28136,24 +29307,177 @@ 

Préparation des données avec dplyr

labelled double: 1 2 2 1 1 3 2 5 4 3 ... min: 1 - max: 5 - NAs: 0 (0%) - 5 unique values 5 value labels: [1] très pauvre [2] pauvre [3] moyen [4] riche [5] très riche
-

Les tableaux de données sont déjà au format tibble (c’est-à-dire sont de la classe tbl_df)2 et les variables catégorielles sont du type labelled (voir le chapitre sur les vecteurs labellisés). Ce format correspond au format de données si on les avait importées depuis SPSS avec l’extension haven (voir le chapitre sur l’import de données).

-

Nous allons charger en mémoire l’extension labelled pour la gestion des vecteurs labellisés en plus de dplyr.

-
library(dplyr)
-library(labelled)
+

Les tableaux de données sont au format tibble (c’est-à-dire sont de la classe tbl_df) et les variables catégorielles sont du type haven_labelled (voir le chapitre sur les vecteurs labellisés). Ce format correspond au format de données si on les avait importées depuis SPSS avec l’extension haven (voir le chapitre sur l’import de données).

+

En premier lieu, il nous faut convertir les tableaux de données au format data.table, ce qui peut se faire avec la fonction setDT. Par ailleurs, nous allons également charger en mémoire l’extension labelled pour la gestion des vecteurs labellisés.

+
library(labelled)
+library(data.table)
+setDT(menages)
+setDT(femmes)
+setDT(enfants)

En premier lieu, il nous faut calculer la durée d’observation des enfants, à savoir le temps passé entre la date de naissance (variable du fichier enfants) et la date de passation de l’entretien (fournie par le tableau de données femmes). Pour récupérer des variables du fichier femmes dans le fichier enfants, nous allons procéder à une fusion de table (voir le chapitre dédié). Pour le calcul de la durée d’observation, nous allons utiliser le package lubridate (voir le chapitre calculer un âge et celui sur la gestion des dates). Nous effectuerons l’analyse en mois (puisque l’âge au décès est connu en mois). Dès lors, la durée d’observation sera calculée en mois.

-

ATTENTION : les étiquettes de valeurs sont le plus souvent perdus lors des fusions de tables avec dplyr. Pour les récupérer après fusion, nous allons conserver une version originale du tableau de données enfants et utiliser la fonction copy_labels_from de l’extension labelled.

-
enfants_original <- enfants
-
-library(lubridate)
-enfants <- enfants %>%
-  left_join(
-    femmes %>% select(id_femme, date_entretien),
-    by = "id_femme"
-  ) %>%
-  copy_labels_from(enfants_original) %>%
-  mutate(duree_observation = time_length(
-    interval(date_naissance, date_entretien), 
-    unit = "months"
+
enfants <- merge(
+  enfants,
+  femmes[, .(id_femme, date_entretien)],
+  by = "id_femme",
+  all.x = TRUE
+)
+
+# duree observation en mois
+library(lubridate, quietly = TRUE)
+enfants[, duree_observation := time_length(interval(date_naissance, date_entretien), unit = "months")]
+

ATTENTION : il y 11 enfants soi-disant nés après la date d’enquête ! Quelle que soit l’enquête, il est rare de ne pas observer d’incohérences. Dans le cas présent, il est fort possible que la date d’entretien puisse parfois être erronnée (par exemple si l’enquêteur a inscrit une date sur le questionnaire papier le jour du recensement du ménage mais n’ai pu effectué le questionnaire individuel que plus tard). Nous décidons ici de procéder à une correction en ajoutant un mois aux dates d’entretien problématiques. D’autres approches auraient pu être envisagées, comme par exemple exclure ces observations problématiques. Cependant, cela aurait impacté le calcul du range de naissance pour les autres enfants issus de la même mère. Quoiqu’il en soit, il n’y a pas de réponse unique. À vous de vous adapter au contexte particulier de votre analyse.

+
enfants[duree_observation < 0, date_entretien := date_entretien %m+% months(1)]
+enfants[, duree_observation := time_length(interval(date_naissance, date_entretien), unit = "months")]
+

Regardons maintenant comment les âges au décès ont été collectés.

+
freq(enfants$age_deces)
+
+ +
+

Les âges au décès sont ici exprimés en mois révolus. Les décès à un mois révolu correspondent à des décès entre 1 et 2 mois exacts. Par ailleurs, les durées d’observation que nous avons calculées avec time_length sont des durées exactes, c’est-à-dire avec la partie décimale. Pour une analyse de survie, on ne peut mélanger des durées exactes et des durées révolues. Trois approches peuvent être envisagées :

+
    +
  1. faire l’analyse en mois révolus, auquel cas on ne gardera que la partie entière des durées d’observations avec la fonction trunc ;
  2. +
  3. considérer qu’un âge au décès de 3 mois révolus correspond en moyenne à 3,5 mois exacts et donc ajouter 0,5 à tous les âges révolus ;
  4. +
  5. imputer un âge au décès exact en distribuant aléatoirement les décès à 3 mois révolus entre 3 et 4 mois exacts, autrement dit en ajoutant aléatoirement une partie décimale aux âges révolus.
  6. +
+

Nous allons ici adopter la troisième approche en considérant que les décès se répartissent de manière uniforme au sein d’un même mois. Nous aurons donc recours à la fonction runif qui permets de générer des valeurs aléatoires entre 0 et 1 selon une distribustion uniforme.

+
enfants[, age_deces_impute := age_deces + runif(.N)]
+

Pour définir notre objet de survie, il nous faudra deux variables. Une première, temporelle, indiquant la durée à laquelle survient l’évènement étudié (ici le décès) pour ceux ayant vécu l’évènement et la durée d’observation pour ceux n’ayant pas vécu l’évènement (censure à droite). Par ailleurs, une seconde variable indiquant si les individus ont vécu l’évènement (0 pour non, 1 pour oui). Or, ici, la variable survie est codée 0 pour les décès et 1 pour ceux ayant survécu. Pour plus de détails, voir l’aide de la fonction Surv.

+
enfants[, deces := 0]
+enfants[survie == 0, deces := 1]
+var_label(enfants$deces) <- "Est décédé ?"
+val_labels(enfants$deces) <- c(non = 0, oui = 1)
+
+enfants[, time := duree_observation]
+enfants[deces == 1, time := age_deces_impute]
+

Occupons-nous maintenant des variables explicatives que nous allons inclure dans l’analyse. Tout d’abord, ajoutons à la table enfants les variables nécessaires des tables femmes et menages. Notons qu’il nous faudra importer id_menage de la table femmes pour pouvoir fusionner ensuite la table enfants avec la table menages. Par ailleurs, pour éviter une confusion sur la variable date_naissance, nous renommons à la volée cette variable de la table femmes en date_naissance_mere.

+
enfants <- merge(
+  enfants,
+  femmes[, .(
+    id_femme, id_menage, milieu, educ, 
+    date_naissance_mere = date_naissance, nb_enf_ideal
+  )],
+  by = "id_femme",
+  all.x = TRUE
+)
+enfants <- merge(
+  enfants,
+  menages[, .(id_menage, structure, richesse)],
+  by = "id_menage",
+  all.x = TRUE
+)
+

Les variables catégorielles sont pour l’heure sous formes de vecteurs labellisés. Or, dans un modèle, il est impératif de les convertir en facteurs pour qu’elles soient bien traitées comme des variables catégorielles (autrement elles seraient traitées comme des variables continues). On aura donc recours à la fonction to_factor de l’extension labelled.

+
enfants[, sexe := to_factor(sexe)]
+enfants[, richesse := to_factor(richesse)]
+

Regardons plus attentivement, la variable structure.

+
freq(enfants$structure)
+
+ +
+

Tout d’abord, la modalité pas d’adulte n’est pas représentée dans l’échantillon. On aura donc recours à l’argument drop_unused_labels pour ne pas conserver cette modalité. Par ailleurs, nous considérons que la situation familiale à partir de laquelle nous voudrons comparer les autres dans notre modèle, donc celle qui doit être considérée comme la modalité de référence, est celle du ménage nucléaire. Cette modalité (deux adultes de sexe opposé) n’étant pas la première, nous aurons recours à la fonction relevel.

+
enfants[, structure := to_factor(structure, drop_unused_labels = TRUE)]
+enfants[, structure := relevel(structure, "deux adultes de sexe opposé")]
+

Regardons la variable educ.

+
freq(enfants$educ)
+
+ +
+

La modalité supérieur est peu représentée dans notre échantillon. Nous allons la fusionner avec la modalité secondaire (voir la section Regrouper les modalités d’une variable du chapitre Recodage).

+
enfants[, educ2 := educ]
+enfants[educ == 3, educ2 := 2]
+val_label(enfants$educ2, 2) <- "secondaire ou plus"
+val_label(enfants$educ2, 3) <- NULL
+enfants[, educ2 := to_factor(educ2)]
+freq(enfants$educ2)
+
+ +
+

Calculons maintenant l’âge de la mère à la naissance de l’enfant (voir le chapitre Calculer un âge) et découpons le en groupes d’âges (voir la section Découper une variable numérique en classes du chapitre Recodage).

+
enfants[, age_mere_naissance := time_length(
+  interval(date_naissance_mere, date_naissance), 
+  unit = "years"
+  )]
+
+enfants$gpage_mere_naissance <- cut(
+  enfants$age_mere_naissance, 
+  include.lowest = TRUE, right = FALSE,
+  breaks=c(13, 20, 30, 50)
+)
+levels(enfants$gpage_mere_naissance) <- c(
+  "19 ou moins", "20-29", "30 et plus"
+)
+enfants$gpage_mere_naissance <- relevel(enfants$gpage_mere_naissance, "20-29")
+freq(enfants$gpage_mere_naissance)
+
+ +
+

Reste à calculer si le rang de naissance de l’enfant est supérieur au nombre idéal d’enfants tel que défini par la mère. On aura recours à la fonction rank appliquée par groupe (ici calculé séparément pour chaque mère). L’argument ties.method permet d’indiquer comment gérer les égalités (ici les naissances multiples, e.g. les jumeaux). Comme nous voulons comparer le rang de l’enfant au nombre idéal d’enfants, nous allons retenir la méthode "max" pour obtenir, dans le cas présent, le nombre total d’enfants déjà nés1. Avant de calculer un rang, il est impératif de trier préalablement le tableau (voir le chapitre Tris).

+
setorder(enfants, id_femme, date_naissance)
+enfants[, rang := rank(date_naissance, ties.method = "max"), by = id_femme]
+enfants[, rang_apres_ideal := "non"]
+# note: unclass() requis en raison d'un bug non corrigé dans haven empéchant de comparer haven_labelled_spss et integer
+enfants[rang > unclass(nb_enf_ideal), rang_apres_ideal := "oui"]
+enfants[, rang_apres_ideal := factor(rang_apres_ideal)]
+enfants[, rang_apres_ideal := relevel(rang_apres_ideal, "non")]
+
+
+

Préparation des données avec dplyr

+

Tout d’abord, regardons sous quel format elles sont stockées.

+
data(fecondite)
+class(menages)
+
[1] "tbl_df"     "tbl"        "data.frame"
+
describe(menages)
+
[1814 obs. x 5 variables] tbl_df tbl data.frame
+
+$id_menage: Identifiant du ménage
+numeric: 1 2 3 4 5 6 7 8 9 10 ...
+min: 1 - max: 1814 - NAs: 0 (0%) - 1814 unique values
+
+$taille: Taille du ménage (nombre de membres)
+numeric: 7 3 6 5 7 6 15 6 5 19 ...
+min: 1 - max: 31 - NAs: 0 (0%) - 30 unique values
+
+$sexe_chef: Sexe du chef de ménage
+labelled double: 2 1 1 1 1 2 2 2 1 1 ...
+min: 1 - max: 2 - NAs: 0 (0%) - 2 unique values
+2 value labels: [1] homme [2] femme
+
+$structure: Structure démographique du ménage
+labelled double: 4 2 5 4 4 4 5 2 5 5 ...
+min: 1 - max: 5 - NAs: 0 (0%) - 5 unique values
+6 value labels: [0] pas d'adulte [1] un adulte [2] deux adultes de sexe opposé [3] deux adultes de même sexe [4] trois adultes ou plus avec lien de parenté [5] adultes sans lien de parenté
+
+$richesse: Niveau de vie (quintiles)
+labelled double: 1 2 2 1 1 3 2 5 4 3 ...
+min: 1 - max: 5 - NAs: 0 (0%) - 5 unique values
+5 value labels: [1] très pauvre [2] pauvre [3] moyen [4] riche [5] très riche
+

Les tableaux de données sont déjà au format tibble (c’est-à-dire sont de la classe tbl_df)2 et les variables catégorielles sont du type labelled (voir le chapitre sur les vecteurs labellisés). Ce format correspond au format de données si on les avait importées depuis SPSS avec l’extension haven (voir le chapitre sur l’import de données).

+

Nous allons charger en mémoire l’extension labelled pour la gestion des vecteurs labellisés en plus de dplyr.

+
library(dplyr)
+library(labelled)
+

En premier lieu, il nous faut calculer la durée d’observation des enfants, à savoir le temps passé entre la date de naissance (variable du fichier enfants) et la date de passation de l’entretien (fournie par le tableau de données femmes). Pour récupérer des variables du fichier femmes dans le fichier enfants, nous allons procéder à une fusion de table (voir le chapitre dédié). Pour le calcul de la durée d’observation, nous allons utiliser le package lubridate (voir le chapitre calculer un âge et celui sur la gestion des dates). Nous effectuerons l’analyse en mois (puisque l’âge au décès est connu en mois). Dès lors, la durée d’observation sera calculée en mois.

+

ATTENTION : les étiquettes de valeurs sont le plus souvent perdus lors des fusions de tables avec dplyr. Pour les récupérer après fusion, nous allons conserver une version originale du tableau de données enfants et utiliser la fonction copy_labels_from de l’extension labelled.

+
enfants_original <- enfants
+
+library(lubridate)
+enfants <- enfants %>%
+  left_join(
+    femmes %>% select(id_femme, date_entretien),
+    by = "id_femme"
+  ) %>%
+  copy_labels_from(enfants_original) %>%
+  mutate(duree_observation = time_length(
+    interval(date_naissance, date_entretien), 
+    unit = "months"
   ))

ATTENTION : il y 11 enfants soi-disant nés après la date d’enquête ! Quelle que soit l’enquête, il est rare de ne pas observer d’incohérences. Dans le cas présent, il est fort possible que la date d’entretien puisse parfois être erronnée (par exemple si l’enquêteur a inscrit une date sur le questionnaire papier le jour du recensement du ménage mais n’ai pu effectué le questionnaire individuel que plus tard). Nous décidons ici de procéder à une correction en ajoutant un mois aux dates d’entretien problématiques. D’autres approches auraient pu être envisagées, comme par exemple exclure ces observations problématiques. Cependant, cela aurait impacté le calcul du range de naissance pour les autres enfants issus de la même mère. Quoiqu’il en soit, il n’y a pas de réponse unique. À vous de vous adapter au contexte particulier de votre analyse.

enfants$date_entretien[enfants$duree_observation < 0] <-
@@ -28284,24 +29608,31 @@ 

Kaplan-Meier

n events median 0.95LCL 0.95UCL 1584 142 NA NA NA

Pour la représenter, on pourra avoir recours à la fonction ggsurvplot de l’extension survminer.

-
library(survminer, quietly = TRUE)
-ggsurvplot(km_global)
+
library(survminer, quietly = TRUE)
+

+Attaching package: 'ggplot2'
+
The following object is masked from 'package:data.table':
+
+    :=
+
Warning: replacing previous import 'ggplot2:::=' by
+'data.table:::=' when loading 'survMisc'
+
ggsurvplot(km_global)
Courbe de survie de Kaplan-Meier

On peut facilement représenter à la place la courbe cumulée des évènements (l’inverse de la courbe de survie) et la table des effectifs en fonction du temps.

-
ggsurvplot(km_global, fun = "event", risk.table = TRUE, surv.scale = "percent")
+
ggsurvplot(km_global, fun = "event", risk.table = TRUE, surv.scale = "percent")
Courbe cumulée des évènements et table des effectifs

Pour comparer deux groupes (ici les filles et les garçons), il suffit d’indiquer la variable de comparaison à survfit.

-
km_sexe <- survfit(Surv(time, deces) ~ sexe, data = enfants)
-km_sexe
+
km_sexe <- survfit(Surv(time, deces) ~ sexe, data = enfants)
+km_sexe
Call: survfit(formula = Surv(time, deces) ~ sexe, data = enfants)
 
                 n events median 0.95LCL 0.95UCL
 sexe=masculin 762     94     NA      NA      NA
 sexe=féminin  822     48     NA      NA      NA

La fonction survdiff permets de calculer le test du logrank afin de comparer des courbes de survie. La mortalité infanto-juvénile diffère-t-elle significativement selon le sexe de l’enfant ?

-
survdiff(Surv(time, deces) ~ sexe, data = enfants)
+
survdiff(Surv(time, deces) ~ sexe, data = enfants)
Call:
 survdiff(formula = Surv(time, deces) ~ sexe, data = enfants)
 
@@ -28311,9 +29642,7 @@ 

Kaplan-Meier

Chisq= 21.8 on 1 degrees of freedom, p= 3e-06

Une fois encore, on aura recours à ggsurvplot pour représenter les courbes de survie.

-
ggsurvplot(km_sexe, conf.int = TRUE, risk.table = TRUE, pval = TRUE, data = enfants)
-
Warning: Vectorized input to `element_text()` is not officially supported.
-Results may be unexpected or may change in future versions of ggplot2.
+
ggsurvplot(km_sexe, conf.int = TRUE, risk.table = TRUE, pval = TRUE, data = enfants)
Courbes de Kaplan-Meier selon le sexe
@@ -28321,12 +29650,12 @@

Kaplan-Meier

Modèle de Cox

Un modèle de Cox se calcule aisément avec coxph{survival}.

-
mod1 <- coxph(
-  Surv(time, deces) ~ sexe + milieu + richesse + 
-  structure + educ2 + gpage_mere_naissance + rang_apres_ideal, 
-  data = enfants
-)
-mod1
+
mod1 <- coxph(
+  Surv(time, deces) ~ sexe + milieu + richesse + 
+  structure + educ2 + gpage_mere_naissance + rang_apres_ideal, 
+  data = enfants
+)
+mod1
Call:
 coxph(formula = Surv(time, deces) ~ sexe + milieu + richesse + 
     structure + educ2 + gpage_mere_naissance + rang_apres_ideal, 
@@ -28416,7 +29745,7 @@ 

Modèle de Cox

Likelihood ratio test=38.16 on 15 df, p=0.0008546 n= 1584, number of events= 142

De nombreuses variables ne sont pas significatives. Voyons si nous pouvons, avec la fonction step, améliorer notre modèle par minimisation de l’AIC ou Akaike Information Criterion (voir la section Sélection de modèles du chapitre sur la Régression logistique).

-
mod2 <- step(mod1)
+
mod2 <- step(mod1)
Start:  AIC=2027.07
 Surv(time, deces) ~ sexe + milieu + richesse + structure + educ2 + 
     gpage_mere_naissance + rang_apres_ideal
@@ -28475,23 +29804,23 @@ 

Modèle de Cox

- milieu 1 2013.9 - sexe 1 2031.6

On peut obtenir facilement les coefficients du modèle avec l’excellente fonction tidy de l’extension broom. Ne pas oublier de préciser exponentiate = TRUE. En effet, dans le cas d’un modèle de Cox, l’exponentiel des coefficients corresponds au ratio des risques instantannés ou hazard ratio (HR) en anglais.

-
library(broom, quietly = TRUE)
-tidy(mod2, exponentiate = TRUE)
+
library(broom, quietly = TRUE)
+tidy(mod2, exponentiate = TRUE)

Pour représenter ces rapports de risque, on peut ici encore avoir recours à la fonction ggcoef_model de l’extension GGally.

-
library(GGally, quietly = TRUE)
+
library(GGally, quietly = TRUE)
Registered S3 method overwritten by 'GGally':
   method from   
   +.gg   ggplot2
-
ggcoef_model(mod2, exponentiate = TRUE)
+
ggcoef_model(mod2, exponentiate = TRUE)
Coefficients du modèle avec ggcoef_model

L’extension survminer fournit également une fonction ggforest qui permet de représenter de manière plus esthétique et complète les coefficients d’un modèle de Cox.

-
ggforest(mod2)
+
ggforest(mod2)
Coefficients du modèle avec ggforest
@@ -28499,8 +29828,8 @@

Modèle de Cox

Vérification de la validité du modèle

Un modèle de Cox n’est valable que sous l’hypothèse de la proportionnalité des risques relatifs. Selon cette hypothèse les résidus de Schoenfeld ne dépendent pas du temps. Cette hypothèse peut être testée avec la fonction cox.zph.

-
test <- cox.zph(mod2)
-test
+
test <- cox.zph(mod2)
+test
                 chisq df    p
 sexe             0.505  1 0.48
 milieu           0.136  1 0.71
@@ -28508,7 +29837,7 @@ 

Vérification de la validité du modèle

GLOBAL 0.805 3 0.85

Une valeur de p inférieure à 5 % indique que l’hypothèse n’est pas vérifiée. Il apparaît que p est supérieur à 5 % globalement et pour chaque variable prise individuellement. Notre modèle est donc valide.

Il est possible de représenter la distribution des résidus de Schoenfeld à l’aide de ggcoxzph de l’extension survminer, afin de voir si leur répartition change au cours du temps.

-
ggcoxzph(test)
+
ggcoxzph(test)
Warning in regularize.values(x, y, ties, missing(ties),
 na.rm = na.rm): collapsing to unique 'x' values
@@ -28536,7 +29865,7 @@

Données pondérées

-
+
@@ -28744,58 +30073,48 @@

Représentations graphiques

Tapis des séquences triés par multidimensional scaling

On voit mieux apparaître ainsi l’hétérogénéité de certaines classes. Les classes 1, 3 et 4, par exemple, semblent regrouper des carrières relativement stables (respectivement de professions intermédiaires, d’employés et de cadres) et des carrières plus « mobiles » commencées comme ouvrier (classes 1 et 3, en orange) ou comme profession intermédiaire (classe 4, en rouge). De même, la majorité des membres de la dernière classe commencent leur carrière dans un groupe professionnel distinct de celui qu’ils occuperont par la suite (indépendants). Ces distinctions apparaissent d’ailleurs si on relance le programme avec un nombre plus élevé de classes (en remplaçant le 5 de la ligne nbcl <- 5 par 7, seconde inflexion de la courbe des sauts d’inertie, et en exécutant de nouveau le programme à partir de cette ligne) : les stables et les mobiles se trouvent alors dans des classes distinctes.

-

Le package JLutils, disponible sur GitHub, propose une fonction seq_heatmap permettant de représenter le tapis de l’ensemble des séquences selon l’ordre du dendrogramme.

-

Pour installer JLutils, on aura recours au package devtools et à sa fonction install_github :

-
library(devtools)
-install_github("larmarange/JLutils")
-

On peut ensuite générer le graphique ainsi :

-
library(JLutils)
-
Loading required package: ggplot2
-
Loading required package: plyr
-
Loading required package: magrittr
-
Registered S3 method overwritten by 'GGally':
-  method from   
-  +.gg   ggplot2
-
seq_heatmap(seq, seq.dist, labCol = 14:50)
-
+

Le package seqhandbook propose une fonction seq_heatmap permettant de représenter le tapis de l’ensemble des séquences selon l’ordre du dendrogramme.

+
library(seqhandbook)
+

+Attaching package: 'seqhandbook'
+
The following object is masked from 'package:JLutils':
+
+    seq_heatmap
+
seq_heatmap(seq, seq.dist, labCol = 14:50)
+
Tapis des séquences trié selon le dendrogramme

Il est possible de reproduire un tapis de séquence avec ggplot2. Outre le fait que cela fournit plus d’options de personnalisation du graphique, cela permets également à ce que la hauteur de chaque classe sur le graphique soit proportionnelle aux nombre d’invidus.

En premier lieu, on a va ajouter à notre fichier de données des identifiants individuels, la typologie crée et l’ordre obtenu par multidimensional scaling.

-
donnees$id <- row.names(donnees)
-donnees$classe <- seq.part
-donnees$ordre <- rank(ordre, ties.method = "random")
+
donnees$id <- row.names(donnees)
+donnees$classe <- seq.part
+donnees$ordre <- rank(ordre, ties.method = "random")

Ensuite, il est impératif que nos données soient dans un format long et tidy, c’est-à-dire avec une ligne par individu et par pas de temps. Pour cela on aura recours à la fonction gather (voir le chapitre dédié).

-
library(tidyr)
-

-Attaching package: 'tidyr'
-
The following object is masked from 'package:magrittr':
-
-    extract
-
long <- donnees %>% gather(csp1:csp37, key = annee, value = csp)
+
library(tidyr)
+long <- donnees %>% gather(csp1:csp37, key = annee, value = csp)

On va mettre en forme la variable csp sous forme de facteur, récupérer l’année grace à la fonction str_sub de l’extension stringr (voir le chapitre sur la manipulation de texte) et recalculer l’âge.

-
long$csp <- factor(long$csp, labels = c("agriculteur", "art./com./chefs", "cadres", "prof. int.", "employés", "ouvriers", "étudiants", "inactifs", "serv. militaire"))
-library(stringr)
-long$annee <- as.integer(str_sub(long$annee, 4))
-long$age <- long$annee + 13
+
long$csp <- factor(long$csp, labels = c("agriculteur", "art./com./chefs", "cadres", "prof. int.", "employés", "ouvriers", "étudiants", "inactifs", "serv. militaire"))
+library(stringr)
+long$annee <- as.integer(str_sub(long$annee, 4))
+long$age <- long$annee + 13

Il n’y a plus qu’à faire notre graphique grace à geom_raster qui permet de colorier chaque pixel. Techniquement, pour un tapis de séquence, il s’agit de représenter le temps sur l’axe horizontal et les individus sur l’axe vertical. Petite astuce : plutôt que d’utiliser id pour l’axe vertical, nous utilisons ordre afin de trier les observations. Par ailleurs, il est impératif de transformer au passage ordre en facteur afin que ggplot2 puisse recalculer proprement et séparément les axes pour chaque facette15, à condition de ne pas oublier l’option scales = "free_y" dans l’appel à facet_grid. Les autres commandes ont surtout pour vocation d’améliorer le rendu du graphique (voir le chapitre dédié à ggplot2).

-
library(ggplot2)
-ggplot(long) +
-  aes(x = age, y = factor(ordre), fill = csp) +
-  geom_raster() +
-  ylab("") +
-  scale_y_discrete(label = NULL) +
-  theme_bw() +
-  theme(legend.position = "bottom") +
-  scale_fill_brewer(palette = "Set3") +
-  facet_grid(classe ~ ., scales = "free_y", space = "free_y") +
-  scale_x_continuous(limits = c(14, 50), breaks = c(14, 20, 25, 30, 35, 40, 45, 50), expand = c(0, 0))
+
library(ggplot2)
+ggplot(long) +
+  aes(x = age, y = factor(ordre), fill = csp) +
+  geom_raster() +
+  ylab("") +
+  scale_y_discrete(label = NULL) +
+  theme_bw() +
+  theme(legend.position = "bottom") +
+  scale_fill_brewer(palette = "Set3") +
+  facet_grid(classe ~ ., scales = "free_y", space = "free_y") +
+  scale_x_continuous(limits = c(14, 50), breaks = c(14, 20, 25, 30, 35, 40, 45, 50), expand = c(0, 0))
Warning: Removed 2000 rows containing missing values
 (geom_raster).
-

+

La distance des séquences d’une classe au centre de cette classe, obtenue avec disscenter, permet de mesurer plus précisément l’homogénéité des classes. Nous utilisons ici aggregate pour calculer la moyenne par classe :

-
aggregate(disscenter(as.dist(seq.om), group = seq.part), list(seq.part), mean)
+
aggregate(disscenter(as.dist(seq.om), group = seq.part), list(seq.part), mean)

On poursuit ensuite la description des classes en croisant la typologie avec la variable generation :

-
cprop(table(seq.part, donnees$generation))
+
cprop(table(seq.part, donnees$generation))
          
 seq.part   1930-38 1939-45 1946-50 Ensemble
   classe.1  35.6    32.5    40.8    36.6   
@@ -28844,7 +30163,7 @@ 

Distribution de la typologie

classe.4 31.8 29.2 27.9 29.6 classe.5 6.5 6.1 3.0 5.1 Total 100.0 100.0 100.0 100.0
-
chisq.test(table(seq.part, donnees$generation))
+
chisq.test(table(seq.part, donnees$generation))

     Pearson's Chi-squared test
 
@@ -28916,7 +30235,7 @@ 

Bibliographie

-
+
@@ -28941,88 +30260,203 @@

Trajectoires de soins : un exemple de données lon +
+

Une version de ce chapitre ustilisant l’extension data.table plutôt que dplyr est également disponible.

+

Dans ce chapitre, nous allons aborder plusieurs méthodes d’analyse à partir d’un jeu de données longitudinales. Tout d’abord, importons les données dans R avec la commande suivante :

load(url("http://larmarange.github.io/analyse-R/data/care_trajectories.RData"))
class(care_trajectories)
[1] "data.table" "data.frame"
-

Nous obtenons un objet appelé care_trajectories. La fonction class nous montre qu’il s’agit d’un tableau de données au format data.table (voir le chapitre dédié). Chargeons donc cette extension ainsi que le tidyverse.

+

Nous obtenons un objet appelé care_trajectories. La fonction class nous montre qu’il s’agit d’un tableau de données au format data.table (voir le chapitre dédié). Chargeons le tidyverse et utilisons as_tibble pour convertir le tableau de données.

library(tidyverse, quietly = TRUE)
-library(data.table, quietly = TRUE)
+care_trajectories <- as_tibble(care_trajectories)

Première description des données

Jetons un premier regard aux données.

head(care_trajectories)
- - - - - - - - - + + + + + + + + + - - - - - - - - - + + + + + + + + + - - - - - - - - - + + + + + + + + + - - - - - - - - - + + + + + + + + + - - - - - - - - - + + + + + + + + + - - - - - - - - - + + + + + + + + + - - - - - - - - - + + + + + + + + +
idmonthcare_statussexageeducationwealthdistance_clinic
+id + +month + +care_status + +sex + +age + +education + +wealth + +distance_clinic +
30D11221
+3 + +0 + +D + +1 + +1 + +2 + +2 + +1 +
31D11221
+3 + +1 + +D + +1 + +1 + +2 + +2 + +1 +
32D11221
+3 + +2 + +D + +1 + +1 + +2 + +2 + +1 +
33D11221
+3 + +3 + +D + +1 + +1 + +2 + +2 + +1 +
34D11221
+3 + +4 + +D + +1 + +1 + +2 + +2 + +1 +
35D11221
+3 + +5 + +D + +1 + +1 + +2 + +2 + +1 +
@@ -29105,6 +30539,192 @@

Première description des données

[1] less than 10 km 26804 54.3 [2] 10 km or more 22561 45.7 Total 49365 100.0
+

Nous pouvons également utiliser look_for de labelled.

+
care_trajectories %>% look_for()
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+pos + +variable + +label + +col_type + +levels + +value_labels +
+1 + +id + +patient identifier + +int + +NULL + +NULL +
+2 + +month + +month(s) since diagnosis + +dbl + +NULL + +NULL +
+3 + +care_status + +care status + +chr+lbl + +NULL + +D, C, T, S +
+4 + +sex + +sex + +dbl+lbl + +NULL + +0, 1 +
+5 + +age + +age group + +dbl+lbl + +NULL + +1, 2, 3 +
+6 + +education + +education level + +dbl+lbl + +NULL + +1, 2, 3 +
+7 + +wealth + +wealth group (assets score) + +dbl+lbl + +NULL + +1, 2, 3 +
+8 + +distance_clinic + +distance to nearest clinic + +dbl+lbl + +NULL + +1, 2 +

Dans cette étude, on a suivi des patients à partir du moment où ils ont été diagnostiqués pour une pathologie grave et chronique et on a suivi leurs parcours de soins chaque mois à partir du diagnostic. La variable status contient le statut dans les soins de chaque individu pour chaque mois de suivi :

  • @@ -29119,66 +30739,56 @@

    Première description des données

    Il est important de noter que nous avons ici des statuts hiérarchiquement ordonnés (D < C < T < S), ce qui aura son importance pour les choix méthodologiques que nous aurons à faire.

    Nous disposons également d’autres variables (âge, sexe, niveau d’éducation…) qui sont ici dépendantes du temps, c’est-à-dire que le cas échéant, elles peuvent varier d’un mois à l’autre en cas de changement.

    Avant de démarrer les analyses, françisons certaines de ces variables.

    -
    var_label(care_trajectories$sex) <- "Sexe"
    -val_labels(care_trajectories$sex) <- c(homme = 0, femme = 1)
    -var_label(care_trajectories$age) <- "Âge"
    -var_label(care_trajectories$education) <- "Education"
    -val_labels(care_trajectories$education) <- c(
    -  primaire = 1,
    -  secondaire = 2,
    -  supérieur = 3
    -)
    -

    Le fichier contient 49 365 lignes, ce qui ne veut pas dire qu’il y a ce nombre d’invidus suivis au cours du temps, puisque plusieurs lignes correspondent à un même individu. On peut obtenir le nombre d’individus différents assez facilement avec la commande :

    -
    length(unique(care_trajectories$id))
    +
    var_label(care_trajectories$sex) <- "Sexe"
    +val_labels(care_trajectories$sex) <- c(homme = 0, femme = 1)
    +var_label(care_trajectories$age) <- "Âge"
    +var_label(care_trajectories$education) <- "Education"
    +val_labels(care_trajectories$education) <- c(
    +  primaire = 1,
    +  secondaire = 2,
    +  supérieur = 3
    +)
    +

    Le fichier contient 49365 lignes, ce qui ne veut pas dire qu’il y a ce nombre d’invidus suivis au cours du temps, puisque plusieurs lignes correspondent à un même individu. On peut obtenir le nombre d’individus différents assez facilement avec la commande :

    +
    length(unique(care_trajectories$id))
    [1] 2929

    Précision : dans ce fichier, tous les individus ne sont pas suivis pendant la même durée, car ils n’ont pas tous été diagnostiqués au même moment. Cependant, il n’y a pas de trous dans le suivi (ce qui serait le cas si certains individus sortaient de l’observation pendant quelques mois puis re-rentraient dans la cohorte de suivi).

    Avant d’aller plus avant, il nous faut avoir une idée du nombre d’individus observé au cours du temps, ce que l’on peut obtenir avec :

    -
    ggplot(care_trajectories) +
    -  aes(x = month) +
    -  geom_bar()
    -

    -

    Améliorons ce graphique en y ajoutant la distribution selon le statut dans les soins chaque mois, en améliorant l’axe du temps (tous les 6 mois est plus facile à lire) et en y ajoutant un titre et des étiquettes appropriées. Afin de disposer d’une palette de couleurs à fort contraste, nous allons utiliser l’extension viridis. Enfin, nous allons utiliser une petite astuce pour indiquer les effectifs sur l’axe horizontal. Au passage, nous allons également franciser les étiquettes de la variable care_status avec val_labels (notez aussi le recours à to_factor dans aes qui nous permet de transformer à la volée la variable en facteur, format attendu par ggplot2 pour les variables catégorielles). On se référera au chapitre dédié à ggplot2 pour plus de détails sur les différentes fonctions de cette extension graphique.

    -
    library(viridis)
    -n <- care_trajectories[month %in% (0:8*6), .(n = .N), by = month]$n
    -etiquettes <- paste0("M", 0:8*6, "\n(n=", n, ")")
    -val_labels(care_trajectories$care_status) <- c(
    -  "diagnostiqué, mais pas suivi" = "D",
    -  "suivi, mais pas sous traitement" = "C",
    -  "sous traitement, mais infection non contrôlée" = "T",
    -  "sous traitement et infection contrôlée" = "S"
    -)
    -ggplot(care_trajectories) +
    -  aes(x = month, fill = to_factor(care_status)) +
    -  geom_bar(color = "gray50", width = 1) +
    -  scale_x_continuous(breaks = 0:8*6, labels = etiquettes) +
    -  ggtitle("Distribution du statut dans les soins chaque mois") +
    -  xlab("") + ylab("") +
    -  theme_light() +
    -  theme(legend.position = "bottom") +
    -  labs(fill = "Statut dans les soins") + 
    -  scale_fill_viridis(discrete = TRUE, direction = -1) +
    -  guides(fill = guide_legend(nrow = 2))
    +
    ggplot(care_trajectories) +
    +  aes(x = month) +
    +  geom_bar()

    +

    Améliorons ce graphique en y ajoutant la distribution selon le statut dans les soins chaque mois, en améliorant l’axe du temps (tous les 6 mois est plus facile à lire) et en y ajoutant un titre et des étiquettes appropriées. Afin de disposer d’une palette de couleurs à fort contraste, nous allons utiliser l’extension viridis. Enfin, nous allons utiliser une petite astuce pour indiquer les effectifs sur l’axe horizontal. Au passage, nous allons également franciser les étiquettes de la variable care_status avec val_labels (notez aussi le recours à to_factor dans aes qui nous permet de transformer à la volée la variable en facteur, format attendu par ggplot2 pour les variables catégorielles). On se référera au chapitre dédié à ggplot2 pour plus de détails sur les différentes fonctions de cette extension graphique.

    +
    library(viridis)
    +n <- care_trajectories %>%
    +  filter(month %in% (0:8*6)) %>%
    +  group_by(month) %>%
    +  count() %>%
    +  pluck("n")
    +etiquettes <- paste0("M", 0:8*6, "\n(n=", n, ")")
    +val_labels(care_trajectories$care_status) <- c(
    +  "diagnostiqué, mais pas suivi" = "D",
    +  "suivi, mais pas sous traitement" = "C",
    +  "sous traitement, mais infection non contrôlée" = "T",
    +  "sous traitement et infection contrôlée" = "S"
    +)
    +ggplot(care_trajectories) +
    +  aes(x = month, fill = to_factor(care_status)) +
    +  geom_bar(color = "gray50", width = 1) +
    +  scale_x_continuous(breaks = 0:8*6, labels = etiquettes) +
    +  ggtitle("Distribution du statut dans les soins chaque mois") +
    +  xlab("") + ylab("") +
    +  theme_light() +
    +  theme(legend.position = "bottom") +
    +  labs(fill = "Statut dans les soins") + 
    +  scale_fill_viridis(discrete = TRUE, direction = -1) +
    +  guides(fill = guide_legend(nrow = 2))
    +

    On s’aperçoit qu’une majorité des personnes suivies ne l’ont été que peu de temps, avec une décroissance rapide des effectifs.

Évolution de la cascade de soins au cours du temps

On nomme communément cascade de soins la proportion d’individus dans chaque statut à un moment du temps donné. On peut facilement obtenir celle-ci à partir du code du graphique précédent en ajoutant l’option position = fill à geom_bar.

-
ggplot(care_trajectories) +
-  aes(x = month, fill = to_factor(care_status)) +
-  geom_bar(color = "gray50", width = 1, position = "fill") +
-  scale_x_continuous(breaks = 0:8*6, labels = etiquettes) +
-  scale_y_continuous(labels = scales::percent) +
-  ggtitle("Cascade des soins observée, selon le temps depuis le diagnostic") +
-  xlab("") + ylab("") +
-  theme_light() +
-  theme(legend.position = "bottom") +
-  labs(fill = "Statut dans les soins") + 
-  scale_fill_viridis(discrete = TRUE, direction = -1) +
-  guides(fill = guide_legend(nrow = 2))
-

-

Les effectifs sont très faibles au-delà de 36 mois et il serait préférable de couper la cascade au-delà de M36, ce que l’on peut faire aisément ne gardant que les lignes correspondantes de care_trajectories.

-
casc_obs <- ggplot(care_trajectories[month <= 36]) +
+
ggplot(care_trajectories) +
   aes(x = month, fill = to_factor(care_status)) +
   geom_bar(color = "gray50", width = 1, position = "fill") +
   scale_x_continuous(breaks = 0:8*6, labels = etiquettes) +
@@ -29189,9 +30799,23 @@ 

Évolution de la cascade de soins au cours du temps

theme(legend.position = "bottom") + labs(fill = "Statut dans les soins") + scale_fill_viridis(discrete = TRUE, direction = -1) + - guides(fill = guide_legend(nrow = 2)) -casc_obs
+ guides(fill = guide_legend(nrow = 2))

+

Les effectifs sont très faibles au-delà de 36 mois et il serait préférable de couper la cascade au-delà de M36, ce que l’on peut faire aisément ne gardant que les lignes correspondantes de care_trajectories.

+
casc_obs <- ggplot(care_trajectories %>% filter(month <= 36)) +
+  aes(x = month, fill = to_factor(care_status)) +
+  geom_bar(color = "gray50", width = 1, position = "fill") +
+  scale_x_continuous(breaks = 0:8*6, labels = etiquettes) +
+  scale_y_continuous(labels = scales::percent) +
+  ggtitle("Cascade des soins observée, selon le temps depuis le diagnostic") +
+  xlab("") + ylab("") +
+  theme_light() +
+  theme(legend.position = "bottom") +
+  labs(fill = "Statut dans les soins") + 
+  scale_fill_viridis(discrete = TRUE, direction = -1) +
+  guides(fill = guide_legend(nrow = 2))
+casc_obs
+

Analyse de survie classique

@@ -29204,106 +30828,70 @@

Analyse de survie classique

En toute rigueur, il faudrait également considérer les transitions inverses (sortie de soins, arrêt du traitement, échec virologique). De même, il est possible que certains aient vécus plusieurs transitions successives (entrée en soin, initiation du traitement, sortie de soins et arrêt du traitement, nouvelle entrée en soins…).

Pour le moment, contentons-nous de regarder la première entrée en soins, la première initiation du traitement et la première atteinte du contrôle de l’infection et de calculer la date de ces trois événements, dans un fichier ind contenant une ligne par individu.

-
ind <- care_trajectories[month == 0]
-ind$diagnostic <- 0
-ind <- merge(
-  ind,
-  care_trajectories[
-    care_status %in% c("C", "T", "S"), 
-    .(entree_soins = min(month)),
-    by = id
-  ],
-  by = "id", 
-  all.x = TRUE
-)
-ind <- merge(
-  ind,
-  care_trajectories[
-    care_status %in% c("T", "S"), 
-    .(initiation_tt = min(month)),
-    by = id
-  ],
-  by = "id", 
-  all.x = TRUE
-)
-ind <- merge(
-  ind,
-  care_trajectories[
-    care_status == "S", 
-    .(controle = min(month)),
-    by = id
-  ],
-  by = "id", 
-  all.x = TRUE
-)
+
ind <- care_trajectories %>% filter(month == 0)
+ind$diagnostic <- 0
+ind <- ind %>%
+  left_join(
+    care_trajectories %>%
+      filter(care_status %in% c("C", "T", "S")) %>%
+      group_by(id) %>%
+      dplyr::summarise(entree_soins = min(month)),
+    by = "id"
+  ) %>%
+  left_join(
+    care_trajectories %>%
+      filter(care_status %in% c("T", "S")) %>%
+      group_by(id) %>%
+      dplyr::summarise(initiation_tt = min(month)),
+    by = "id"
+  ) %>%
+  left_join(
+    care_trajectories %>%
+      filter(care_status == "S") %>%
+      group_by(id) %>%
+      dplyr::summarise(controle = min(month)),
+    by = "id"
+  )

Il nous faut également la durée de suivi par individu.

-
ind <- merge(
-  ind,
-  care_trajectories[, .(suivi = max(month)), by = id],
-  by = "id", 
-  all.x = TRUE
-)
+
ind <- ind %>%
+  left_join(
+    care_trajectories %>%
+      group_by(id) %>%
+      dplyr::summarise(suivi = max(month)),
+    by = "id"
+  )

Pour faciliter la suite des analyses, nous allons nous créer une petite fonction qui, en fonction de la date d’origine et la date d’événement retenues, calculera la courbe de Kaplan-Meier correspondante (voir le chapitre sur l’analyse de suivie pour le calcul de la courbe de survie et celui dédié à l’écriture de fonctions).

-
km <- function(date_origine, date_evenement, nom) {
-  library(survival)
-  
-  # ne garder que les observations avec date d'origine
-  tmp <- ind[!is.na(ind[[date_origine]]), ]
-  
-  # pre-remplir la variable time avec duree de suivi
-  # depuis date d'origine
-  tmp$time <- tmp$suivi - tmp[[date_origine]]
-  # et considérer que l'événement n'a pas été vécu
-  tmp$event <- FALSE
-  
-  # si date_evement documentée, événement vécu
-  tmp[!is.na(tmp[[date_evenement]]), ]$event <- TRUE
-  tmp[tmp$event == TRUE, ]$time <- 
-    tmp[tmp$event == TRUE, ][[date_evenement]] -
-    tmp[tmp$event == TRUE, ][[date_origine]]
-  
-  kaplan <- survfit(Surv(time, event) ~ 1, data = tmp)
-  res <- broom::tidy(kaplan, conf.int = TRUE)
-  res$nom <- nom
-  res
-}
+
km <- function(date_origine, date_evenement, nom) {
+  library(survival)
+  
+  # ne garder que les observations avec date d'origine
+  tmp <- ind[!is.na(ind[[date_origine]]), ]
+  
+  # pre-remplir la variable time avec duree de suivi
+  # depuis date d'origine
+  tmp$time <- tmp$suivi - tmp[[date_origine]]
+  # et considérer que l'événement n'a pas été vécu
+  tmp$event <- FALSE
+  
+  # si date_evement documentée, événement vécu
+  tmp[!is.na(tmp[[date_evenement]]), ]$event <- TRUE
+  tmp[tmp$event == TRUE, ]$time <- 
+    tmp[tmp$event == TRUE, ][[date_evenement]] -
+    tmp[tmp$event == TRUE, ][[date_origine]]
+  
+  kaplan <- survfit(Surv(time, event) ~ 1, data = tmp)
+  res <- broom::tidy(kaplan, conf.int = TRUE)
+  res$nom <- nom
+  res
+}

Une première approche consiste à regarder la survenue de chacun des trois événements mentions plus haut en fonction du temps depuis le diagnostic.

-
depuis_diag <- dplyr::bind_rows(
-  km("diagnostic", "entree_soins", "entrée en soins"),
-  km("diagnostic", "initiation_tt", "initiation du traitement"),
-  km("diagnostic", "controle", "contrôle de l'infection")
-)
-
-g_diag <- ggplot(data = depuis_diag) +
-  aes(x = time, y = 1 - estimate, 
-      color = as_factor(nom), fill = as_factor(nom),
-      ymin = 1 - conf.high, ymax = 1 - conf.low) +
-  geom_ribbon(alpha = .25, mapping = aes(color = NULL)) +
-  geom_line(size = 1) +
-  theme_classic() +
-  theme(
-    legend.position = "bottom",
-    panel.grid.major.y = element_line(colour = "grey")
-  ) +
-  scale_x_continuous(breaks = 0:6*6, limits = c(0, 36)) +
-  scale_y_continuous(labels = scales::percent, limits = c(0, 1)) +
-  xlab("mois depuis le diagnostic") + 
-  ylab("") + labs(color = "", fill = "")
-g_diag
-

-

Ce graphique ressemble à la cascade des soins observée que nous avions calculée plus haut, à quelques différences près :

-
    -
  • avec la méthode de Kaplan-Meier, la censure à droite, i.e. le fait que tous les individus n’ont pas la même durée de suivi, est correctement prise en compte et la courbe est corrigée en conséquence ;
  • -
  • par contre, les transitions inverses ne sont pas considérées : lorsqu’un individu a atteint une étape, on ne regarde pas s’il en ressort.
  • -
-

Une autre manière d’appréhender nos trajectoires est de considérer le temps requis pour atteindre une étape une fois la précédente étape atteinte. Ce qu’on obtient facilement en adaptant légèrement notre code précédent.

-
depuis_prec <- dplyr::bind_rows(
+
depuis_diag <- dplyr::bind_rows(
   km("diagnostic", "entree_soins", "entrée en soins"),
-  km("entree_soins", "initiation_tt", "initiation du traitement"),
-  km("initiation_tt", "controle", "contrôle de l'infection")
+  km("diagnostic", "initiation_tt", "initiation du traitement"),
+  km("diagnostic", "controle", "contrôle de l'infection")
 )
 
-g_prec <- ggplot(data = depuis_prec) +
+g_diag <- ggplot(data = depuis_diag) +
   aes(x = time, y = 1 - estimate, 
       color = as_factor(nom), fill = as_factor(nom),
       ymin = 1 - conf.high, ymax = 1 - conf.low) +
@@ -29316,14 +30904,43 @@ 

Analyse de survie classique

) + scale_x_continuous(breaks = 0:6*6, limits = c(0, 36)) + scale_y_continuous(labels = scales::percent, limits = c(0, 1)) + - xlab("mois depuis l'étape précédente") + + xlab("mois depuis le diagnostic") + ylab("") + labs(color = "", fill = "") - -g_prec
+g_diag

-

Attention : cette représentation graphique peut éventuellement prêter à confusion dans sa lecture car l’échelle de temps n’est pas tout à fait la même pour chaque courbe, dans la mesure où la date d’origine diffère pour chacune. Dès lors, il peut être plus pertinent de présenter chaque courbe l’une à côté de l’autre.

-
g_prec + facet_grid(~ as_factor(nom))
+

Ce graphique ressemble à la cascade des soins observée que nous avions calculée plus haut, à quelques différences près :

+
    +
  • avec la méthode de Kaplan-Meier, la censure à droite, i.e. le fait que tous les individus n’ont pas la même durée de suivi, est correctement prise en compte et la courbe est corrigée en conséquence ;
  • +
  • par contre, les transitions inverses ne sont pas considérées : lorsqu’un individu a atteint une étape, on ne regarde pas s’il en ressort.
  • +
+

Une autre manière d’appréhender nos trajectoires est de considérer le temps requis pour atteindre une étape une fois la précédente étape atteinte. Ce qu’on obtient facilement en adaptant légèrement notre code précédent.

+
depuis_prec <- dplyr::bind_rows(
+  km("diagnostic", "entree_soins", "entrée en soins"),
+  km("entree_soins", "initiation_tt", "initiation du traitement"),
+  km("initiation_tt", "controle", "contrôle de l'infection")
+)
+
+g_prec <- ggplot(data = depuis_prec) +
+  aes(x = time, y = 1 - estimate, 
+      color = as_factor(nom), fill = as_factor(nom),
+      ymin = 1 - conf.high, ymax = 1 - conf.low) +
+  geom_ribbon(alpha = .25, mapping = aes(color = NULL)) +
+  geom_line(size = 1) +
+  theme_classic() +
+  theme(
+    legend.position = "bottom",
+    panel.grid.major.y = element_line(colour = "grey")
+  ) +
+  scale_x_continuous(breaks = 0:6*6, limits = c(0, 36)) +
+  scale_y_continuous(labels = scales::percent, limits = c(0, 1)) +
+  xlab("mois depuis l'étape précédente") + 
+  ylab("") + labs(color = "", fill = "")
+
+g_prec

+

Attention : cette représentation graphique peut éventuellement prêter à confusion dans sa lecture car l’échelle de temps n’est pas tout à fait la même pour chaque courbe, dans la mesure où la date d’origine diffère pour chacune. Dès lors, il peut être plus pertinent de présenter chaque courbe l’une à côté de l’autre.

+
g_prec + facet_grid(~ as_factor(nom))
+

Ici, on voit plus clairement que l’étape où il y a le plus de perdition est celle de l’entrée en soins, moins des trois quarts des personnes diagnostiquées étant venu en clinique au mois une fois dans les trois ans suivant le diagnostic. Par contre, l’initiation du traitement une fois entré en clinique et le contrôle de l’infection une fois le traitement initié sont beaucoup plus rapide.

Pour aller plus loin avec les outils de l’analyse de survie classique, il serait possible de faire des analyses bivariées (Kaplan-Meier) ou multivariées (Cox) pour chacune de ces étapes. Cependant, il serait plus intéressant de trouver une approache statistique permettant de considérer dans un même modèle l’ensemble des transitions possibles.

@@ -29331,407 +30948,1130 @@

Analyse de survie classique

Une première analyse de séquences sur l’ensemble du fichier

L’analyse de séquences permet d’appréhender l’ensemble de la trajectoire de soins à travers la succession des états dans lesquels se trouvent les patients observés.

Nous allons donc réaliser une analyse de séquences (voir le chapitre dédié) sur l’ensemble de notre fichier. Pour cela, il va falloir préalable que nous transformions nos donnée actuellement dans un format long en un tableau large, c’est-à-dire avec une ligne par individu et une variable différentes par pas de temps. On peut réaliser cela facilement avec pivot_wider de tidyr (voir le chapitre dédié à tidyr). Il faut noter que le résultat ne sera pas un tableau data.table, d’où le recours à setDT pour convertir le résultat.

-
library(tidyr)
-large <- care_trajectories %>%
-  dplyr::select(id, m = month, care_status) %>%
-  pivot_wider(names_from = m, values_from = care_status, names_prefix = "m") 
-setDT(large)
-head(large)
+
library(tidyr)
+large <- care_trajectories %>%
+  dplyr::select(id, m = month, care_status) %>%
+  pivot_wider(names_from = m, values_from = care_status, names_prefix = "m") 
+head(large)
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
idm0m1m2m3m4m5m6m7m8m9m10m11m12m13m14m15m16m17m18m19m20m21m22m23m24m25m26m27m28m29m30m31m32m33m34m35m36m37m38m39m40m41m42m43m44m45m46m47m48m49m50
+id + +m0 + +m1 + +m2 + +m3 + +m4 + +m5 + +m6 + +m7 + +m8 + +m9 + +m10 + +m11 + +m12 + +m13 + +m14 + +m15 + +m16 + +m17 + +m18 + +m19 + +m20 + +m21 + +m22 + +m23 + +m24 + +m25 + +m26 + +m27 + +m28 + +m29 + +m30 + +m31 + +m32 + +m33 + +m34 + +m35 + +m36 + +m37 + +m38 + +m39 + +m40 + +m41 + +m42 + +m43 + +m44 + +m45 + +m46 + +m47 + +m48 + +m49 + +m50 +
3DDDDDDNANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANA
9DDNANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANA
+3 + +D + +D + +D + +D + +D + +D + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA +
13DDDDDDDDNANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANA
+9 + +D + +D + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA +
15DDDDTTTCDDDDDDDCCCCCCCCCTTTTTTTTTNANANANANANANANANANANANANANANANANANA
+13 + +D + +D + +D + +D + +D + +D + +D + +D + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA +
18DDSSSSSSSSSSSSSSSSSNANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANA
+15 + +D + +D + +D + +D + +T + +T + +T + +C + +D + +D + +D + +D + +D + +D + +D + +C + +C + +C + +C + +C + +C + +C + +C + +C + +T + +T + +T + +T + +T + +T + +T + +T + +T + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA +
21DDDDDDNANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANANA
+18 + +D + +D + +S + +S + +S + +S + +S + +S + +S + +S + +S + +S + +S + +S + +S + +S + +S + +S + +S + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA +
+21 + +D + +D + +D + +D + +D + +D + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA + +NA +

On utilise seqdef de TraMineR pour créer nos séquences, avec les arguments alphabet pour forcer l’ordre de l’alphabet, states pour spécifier des étiquettes courtes à chaque état et cpal pour indiquer le code couleur de chaque état (et être raccord avec nos graphiques précédents).

-
library(TraMineR, quietly = TRUE)
-

-TraMineR stable version 2.2-1 (Built: 2020-11-02)
-
Website: http://traminer.unige.ch
-
Please type 'citation("TraMineR")' for citation information.
-
seq_all <- seqdef(
-  large[, m0:m50],
-  id = large$id,
-  alphabet = c("D", "C", "T", "S"),
-  states = c("diagnostiqué", "en soins", "sous traitement", "inf. contrôlée"),
-  cpal = viridis(4, direction = -1)
-)
+
library(TraMineR, quietly = TRUE)
+seq_all <- seqdef(
+  large %>% dplyr::select(m0:m50),
+  id = large$id,
+  alphabet = c("D", "C", "T", "S"),
+  states = c("diagnostiqué", "en soins", "sous traitement", "inf. contrôlée"),
+  cpal = viridis(4, direction = -1)
+)
 [>] found missing values ('NA') in sequence data
 [>] preparing 2929 sequences
 [>] coding void elements with '%' and missing values with '*'
@@ -29744,207 +32084,556 @@

Une première analyse de séquences sur l’ensemble du fichier

 [>] 2929 sequences in the data set
 [>] min/max sequence length: 1/51

On peut retrouver la cascade de soins avec seqdplot.

-
seqdplot(seq_all, legend.prop = .25)
-

+
seqdplot(seq_all, legend.prop = .25)
+

Nous allons maintenant calculer une matrice des distances entre individus par optimal matching. Dans le cas présent, nos différents status sont hiérarchiquement ordonnés. Il n’est donc pas raisonnable de penser que les coûts sont constants entre les différents statuts, puisqu’en un sens, passer directement de D à T peut être considéré comme être passé d’abord de D à C puis de C à D. Nous allons donc faire une matrice de coûts hiérarchisée. seqcost nous permets de produire une matrice de coûts constants, que nous allons ensuite modifier manuellement. Pour le coût indel, le plus simple est de considérer la moitié du coût de substitution maximum.

-
couts <- seqcost(seq_all, method = "CONSTANT")
+
couts <- seqcost(seq_all, method = "CONSTANT")
 [>] creating 4x4 substitution-cost matrix using 2 as constant value
-
couts
+
couts
$indel
 [1] 1
 
-$sm
-                  diagnostiqué-> en soins->
-diagnostiqué->                 0          2
-en soins->                     2          0
-sous traitement->              2          2
-inf. contrôlée->               2          2
-                  sous traitement-> inf. contrôlée->
-diagnostiqué->                    2                2
-en soins->                        2                2
-sous traitement->                 0                2
-inf. contrôlée->                  2                0
-
couts$sm[1, ] <- c(0, 1, 2, 3)
-couts$sm[2, ] <- c(1, 0, 1, 2)
-couts$sm[3, ] <- c(2, 1, 0, 1)
-couts$sm[4, ] <- c(3, 2, 1, 0)
-couts$indel <- max(couts$sm) / 2
-couts
-
$indel
-[1] 1.5
+$sm
+                  diagnostiqué-> en soins->
+diagnostiqué->                 0          2
+en soins->                     2          0
+sous traitement->              2          2
+inf. contrôlée->               2          2
+                  sous traitement-> inf. contrôlée->
+diagnostiqué->                    2                2
+en soins->                        2                2
+sous traitement->                 0                2
+inf. contrôlée->                  2                0
+
couts$sm[1, ] <- c(0, 1, 2, 3)
+couts$sm[2, ] <- c(1, 0, 1, 2)
+couts$sm[3, ] <- c(2, 1, 0, 1)
+couts$sm[4, ] <- c(3, 2, 1, 0)
+couts$indel <- max(couts$sm) / 2
+couts
+
$indel
+[1] 1.5
+
+$sm
+                  diagnostiqué-> en soins->
+diagnostiqué->                 0          1
+en soins->                     1          0
+sous traitement->              2          1
+inf. contrôlée->               3          2
+                  sous traitement-> inf. contrôlée->
+diagnostiqué->                    2                3
+en soins->                        1                2
+sous traitement->                 0                1
+inf. contrôlée->                  1                0
+
dist_all <- seqdist(seq_all, method = "OM", sm = couts$sm, indel = couts$indel)
+
 [>] 2929 sequences with 4 distinct states
+
 [>] checking 'sm' (size and triangle inequality)
+
 [>] 1370 distinct  sequences 
+
 [>] min/max sequence lengths: 1/51
+
 [>] computing distances using the OM metric
+
 [>] elapsed time: 2.95 secs
+

Calculons le dendrogramme et représentons le avec le tapis de séquence grace à seq_heatmap de l’extension seqhandbook.

+
arbre_all <- hclust(as.dist(dist_all), method = "ward.D2")
+library(seqhandbook, quietly = TRUE)
+

+Attaching package: 'seqhandbook'
+
The following object is masked from 'package:JLutils':
+
+    seq_heatmap
+
seq_heatmap(seq_all, arbre_all)
+

+

Il apparaît que les différentes séquences sont principalement regroupées en fonction de leur longueur. En effet, pour passer d’une séquence courte à une séquence longue il faut ajouter des statuts pour compléter la séquence ce qui induit de facto une distance élevée (en raison du coût indel). Dès lors, lorsque l’on travaille avec des séquences aux longueurs très disparates, une classification ascendante hiérarchique va produire une typologie de séquences courtes et de séquences longues, ce qui n’est pas forcément ce que l’on recherche.

+

Dans notre exemple, nous pouvons considérer que les séquences courtes ne sont pas pertinentes à retenir dans l’analyse car l’observation n’est pas assez longue pour voir le parcours de soins des patients. Une solution consiste à ne retenir que les individus observées au moins n mois et analyser leur trajectoire sur seulement n mois, ce qui permet de n’avoir que des séquences de même longueur. Dès lors, la distance entre deux séquences ne dépendra plus que des différences de parcours. On serait tenté de prendre un n élévé pour avoir ainsi des parcours de soins longs. Mais dans ce cas là, l’analyse ne se fera que sur un tout petit nombre d’individus et on manquera de puissance. Si, à l’inverse, on prends un n petit, nous aurons des effectifs élevés mais les séquences seront peut-être trop courtes pour mettre en évidence la variété des trajectoires. Il faut dès lors trouver un compromis entre ces deux contraintes.

+

Si l’on regarde notre premier graphique montrant le nombre d’observations au cours du temps, il apparaît une sorte de point d’inflexion au niveau de M18 avec un brusque décrochage. D’un autre côté, 18 mois offre un minimum de durée d’observations pour espérer voir émerger des trajectoires plus complexes.

+
+
+

Une seconde analyse de séquences limitées aux 18 premiers mois

+

Reprenons notre analyse en se limitant aux individus observés au moins 18 mois (soit 19 status entre M0 et M18) et en se limitant aux 18 premiers mois pour modéliser les séquences. La fonction seqlength permets de récupérer la longueur de chaque séquence.

+
large$seq_length <- seqlength(seq_all)
+large_m18 <- large %>%
+  dplyr::filter(seq_length >= 19) %>%
+  dplyr::select(id:m18)
+  
+seq_m18 <- seqdef(
+  large_m18 %>% dplyr::select(m0:m18),
+  id = large_m18$id,
+  alphabet = c("D", "C", "T", "S"),
+  states = c("diagnostiqué", "en soins", "sous traitement", "inf. contrôlée"),
+  cpal = viridis(4, direction = -1)
+)
+
 [>] state coding:
+
       [alphabet]  [label]         [long label] 
+
     1  D           diagnostiqué    diagnostiqué
+
     2  C           en soins        en soins
+
     3  T           sous traitement sous traitement
+
     4  S           inf. contrôlée  inf. contrôlée
+
 [>] 1317 sequences in the data set
+
 [>] min/max sequence length: 19/19
+
dist_m18 <- seqdist(seq_m18, method = "OM", sm = couts$sm, indel = couts$indel)
+
 [>] 1317 sequences with 4 distinct states
+
 [>] checking 'sm' (size and triangle inequality)
+
 [>] 578 distinct  sequences 
+
 [>] min/max sequence lengths: 19/19
+
 [>] computing distances using the OM metric
+
 [>] elapsed time: 0.42 secs
+
arbre_m18 <- hclust(as.dist(dist_m18), method = "ward.D2")
+seq_heatmap(seq_m18, arbre_m18)
+

+

Reste maintenant à décider du nombre de classes à retenir. Encore une fois, c’est un équilibre à trouver entre le niveau de détails voulus et le niveau de simplification requis pour permettre l’analyse.

+

Pour faciliter ce choix, on peut avoir recours à la fonction as.seqtree de l’extension WeightedCluster, couplée à la fonction seqtreedisplay. ATTENTION : pour que le graphique puisse être produit, il faut que le logiciel libre GraphViz (https://graphviz.gitlab.io/) soit installé sur votre PC. On peut également installer GraphViz avec le code ci-dessous :

+
if (!requireNamespace("BiocManager", quietly = TRUE))
+    install.packages("BiocManager")
+BiocManager::install("Rgraphviz")
+

La combinaison des deux fonctions va permettre de représenter l’évolution des catégories au fur-et-à-mesure que l’on coupe le dendrogramme plus bas. On peut choisir le type de graphique utilisé avec l’argument type (voir l’aide de seqplot) et le nombre maximum de clusters avec nclust.

+
library(WeightedCluster, quietly = TRUE)
+seqtree_m18 <- as.seqtree(arbre_m18, seqdata = seq_m18, diss = dist_m18, ncluster = 7)
+seqtreedisplay(seqtree_m18, type="I", border=NA, show.depth=TRUE)
+
+

Représentation graphique produite par seqtreedisplay

+
+

Afin d’éviter de multiplier les sous-groupes, nous n’allons conserver que 4 catégories.

+
large_m18$typo_cah <- cutree(arbre_m18, 4)
+
+

Il est aussi possible de se baser sur divers indicateurs statistiques sur la qualité de chaque partition. Pour cela, on pourra par exemple avoir recours à la fonction as.clustrange de l’extension WeightedCluster. Essayez par exemple les commandes ci-après :

+
nc <- as.clustrange(arbre_m18, dist_m18)
+summary(nc, max.rank = 3)
+plot(nc, norm = "zscore")
+

Pour plus d’informations, voir le manuel de la librairie WeightedCluster, chapitre 7.

+
+

On peut représenter le découpage du dendrogramme avec fviz_dend fournie par factoextra

+
library(factoextra)
+
Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
+
fviz_dend(arbre_m18, k = 4, show_labels = FALSE, rect = TRUE)
+

+

Comme expliqué par Matthias Studer dans le manuel de la librairie WeightedCluster, plusieurs critiques peuvent être adressées aux procédures hiérarchiques, en particulier le fait que la fusion de deux groupes se fait en maximisant un critère local.

+

L’algorithme PAM pour Partitioning Around Medoids suit une autre logique que les algorithmes hiérarchiques et vise à obtenir la meilleure partition d’un ensemble de données en un nombre prédéfini de groupes. Il a l’avantage de maximiser un critère global et non uniquement un critère local. Par contre, le nombre de classes doit être fixé à l’avance.

+

Ayant décidé de retenir 4 classes au regard de notre classification ascendante hiérarchique, nous pouvons voir si l’algorithme PAM permets d’améliorer nos 4 classes. Nous allons utiliser la fonction wcKMedoids de l’extension WeightedCluster en lui indiquant comme partition initiale celle obtenue avec la classigication hiérarchique.

+
pam_m18 <- wcKMedoids(dist_m18, k = 4, initialclust = arbre_m18)
+large_m18$typo_pam <- pam_m18$clustering
+

Un tableau croisé nous permets de voir que les deux typologies restent proches.

+
library(gtsummary)
+large_m18 %>% 
+  tbl_cross(row = typo_cah, col = typo_pam)
+ +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -
Characteristic + typo_pam + Total
62385410
typo_cah
15224039565
2033303336
312035913276
42305112140
Total5462103941671,317
+

Regardons les tapis de séquence des deux typologies.

-
large_m18$ordre_cmd <- cmdscale(as.dist(dist_m18), k = 1)
-seqIplot(seq_m18, group = large_m18$typo_cah, sortv = large_m18$ordre_cmd)
-

-
seqIplot(seq_m18, group = large_m18$typo_pam, sortv = large_m18$ordre_cmd)
-

+
large_m18$ordre_cmd <- cmdscale(as.dist(dist_m18), k = 1)
+seqIplot(seq_m18, group = large_m18$typo_cah, sortv = large_m18$ordre_cmd)
+

+
seqIplot(seq_m18, group = large_m18$typo_pam, sortv = large_m18$ordre_cmd)
+

Comme on le voit les deux typologies obtenues sont très proches. Suivant le cas, à vous de choisir celle qui semble la plus pertinente d’un point de vue sociologique. Il existe également divers indicateurs statisques pour mesurer la qualité d’une partition (voir le manuel de la librairie WeightedCluster de Matthias Studer). Ils peuvent être calculés avec la fonction wcClusterQuality. Comparons les deux typologies obtenues.

-
tab <- tibble(
-  stat = names(wcClusterQuality(dist_m18, large_m18$typo_cah)$stats),
-  cah = wcClusterQuality(dist_m18, large_m18$typo_cah)$stats,
-  pam = wcClusterQuality(dist_m18, large_m18$typo_pam)$stats
-)
-gt::gt(tab) %>% gt::fmt_number(2:3, decimals = 2, sep_mark = " ")
+
tab <- tibble(
+  stat = names(wcClusterQuality(dist_m18, large_m18$typo_cah)$stats),
+  cah = wcClusterQuality(dist_m18, large_m18$typo_cah)$stats,
+  pam = wcClusterQuality(dist_m18, large_m18$typo_pam)$stats
+)
+gt::gt(tab) %>% gt::fmt_number(2:3, decimals = 2, sep_mark = " ")
-
+
@@ -30337,9 +33026,9 @@

Une seconde analyse de séquences limitées aux 18 premiers mois

stat cah

Selon ces indicateurs calculés, l’approche PAM obtiendrait une partition légèrement de meilleure qualité que celle obtenuepar CAH.

L’extension WeightedCluster fournie aussi une fonction wcSilhouetteObs permettant de mesurer la silhouette de chaque séquence. Plus cette métrique est élevée et proche de 1, plus la séquence est proche du centre de classe et caractéristique de la classe. On peut utiliser cette métrique pour classer les séquences sur le tapis de séquences.

-
large_m18$sil <- wcSilhouetteObs(dist_m18, large_m18$typo_pam)
-seqIplot(seq_m18, group = large_m18$typo_pam, sortv = large_m18$sil)
-

+
large_m18$sil <- wcSilhouetteObs(dist_m18, large_m18$typo_pam)
+seqIplot(seq_m18, group = large_m18$typo_pam, sortv = large_m18$sil)
+

Nous voyons émerger quatre groupes distincts :

  • les rapides, qui entrent en soins et initient le traitement dès les premiers mois suivant le diagnostic ;
  • @@ -30348,75 +33037,78 @@

    Une seconde analyse de séquences limitées aux 18 premiers mois

  • les hors soins, qui ne sont pas entrés en soins où n’y sont pas restés.

Le graphique obtenu avec seqIplot affiche visuellement chaque groupe avec la même hauteur, pouvant laisser accroire que chaque groupe a le même poids dans l’échantillon. Pour produire une représentation graphique des tapis de séquences plus correcte, où chaque la hauteur de chaque groupe correspondrait à son poids dans l’échantillon, nous allons passer par ggplot2. Un tapis de séquences peut-être vu comme un raster et dès lors représenté avec geom_raster. Pour travailler avec ggplot2, nos données doivent être au format tidy, c’est-à-dire avec une ligne par point d’observation, soit une ligne par personne et par jour. Nous allons donc repartir du fichier care_trajectories. Le mois d’observation indiquera la position en abscisse. Quant à la position en ordonnée, il faudra que nous la calculions, séparément pour chaque groupe, afin d’éviter des lignes vides dans le graphique.

-
# nommer les groupes
-large_m18$groupe <- factor(
-  large_m18$typo_pam,
-  c(85, 23, 410, 6),
-  c("Rapides", "Lents", "Inaboutis", "Hors soins")
-)
-
-# calculer le rang des individus dans chaque groupe
-setorder(large_m18, "ordre_cmd")
-large_m18[, rang_cmd := 1:.N, by = groupe]
-
-# créer un fichier long
-long_m18 <- care_trajectories[id %in% large_m18$id & month <= 18]
-long_m18 <- merge(
-  long_m18,
-  large_m18[, .(id, groupe, rang_cmd)],
-  by = "id",
-  all.x = TRUE
-)
-long_m18$care_statusF <- to_factor(long_m18$care_status)
-
-# calculer les effectifs par groupe
-tmp <- large_m18[, .(n = .N), by = groupe]
-tmp[, groupe_n := paste0(groupe, "\n(n=", n, ")")]
-long_m18 <- merge(
-  long_m18,
-  tmp[, .(groupe, groupe_n)],
-  by = "groupe",
-  all.x = TRUE
-)
-
# graphique des tapis de séquences
-ggplot(long_m18) +
-  aes(x = month, y = rang_cmd, fill = care_statusF) +
-  geom_raster() +
-  facet_grid(groupe_n ~ ., space = "free", scales = "free") +
-  scale_x_continuous(breaks = 0:6*3, labels = paste0("M", 0:6*3)) +
-  scale_y_continuous(breaks = 0:5*100, minor_breaks = NULL) +
-  xlab("") + ylab("") +
-  theme_light() +
-  theme(legend.position = "bottom") +
-  labs(fill = "Statut dans les soins") + 
-  scale_fill_viridis(discrete = TRUE, direction = -1) +
-  guides(fill = guide_legend(nrow = 2))
-

+
# nommer les groupes
+large_m18$groupe <- factor(
+  large_m18$typo_pam,
+  c(85, 23, 410, 6),
+  c("Rapides", "Lents", "Inaboutis", "Hors soins")
+)
+
+# calculer le rang des individus dans chaque groupe
+large_m18 <- large_m18 %>%
+  group_by(groupe) %>%
+  arrange(ordre_cmd) %>%
+  mutate(rang_cmd = rank(ordre_cmd, ties.method = "first"))
+
+# créer un fichier long
+long_m18 <- care_trajectories %>%
+  filter(id %in% large_m18$id & month <= 18) %>%
+  left_join(
+    large_m18 %>% dplyr::select(id, groupe, rang_cmd),
+    by = "id"
+  )
+
+long_m18$care_statusF <- to_factor(long_m18$care_status)
+
+# calculer les effectifs par groupe
+tmp <- large_m18 %>% 
+  dplyr::count(groupe) %>%
+  mutate(groupe_n = paste0(groupe, "\n(n=", n, ")"))
+
+long_m18 <- long_m18 %>%
+  left_join(
+    tmp %>% dplyr::select(groupe, groupe_n),
+    by = "groupe"
+  )
+
# graphique des tapis de séquences
+ggplot(long_m18) +
+  aes(x = month, y = rang_cmd, fill = care_statusF) +
+  geom_raster() +
+  facet_grid(groupe_n ~ ., space = "free", scales = "free") +
+  scale_x_continuous(breaks = 0:6*3, labels = paste0("M", 0:6*3)) +
+  scale_y_continuous(breaks = 0:5*100, minor_breaks = NULL) +
+  xlab("") + ylab("") +
+  theme_light() +
+  theme(legend.position = "bottom") +
+  labs(fill = "Statut dans les soins") + 
+  scale_fill_viridis(discrete = TRUE, direction = -1) +
+  guides(fill = guide_legend(nrow = 2))
+

Facteurs associés à l’appartenance à chaque groupe

Une fois les différents groupes de trajectoires identifiés, il est courant de vouloir regarder si certains facteurs influencent l’appartenance à un groupe plutôt qu’un autre. Dans nos données d’exemple, nous nous intéresserons aux variables suivantes : sexe, groupe d’âges et niveau d’éducation.

Ces différentes variables sont renseignées pour chaque mois dans le tableau de données care_trajectories, en tenant compte des éventuels changements au cours du temps. Ici, notre analyse est menée au niveau individuel. Nous allons donc récupérer la valeur de ces différentes variables au moment du diagnostic, à savoir à M0.

-
large_m18 <- merge(
-  large_m18,
-  care_trajectories[
-    month == 0, 
-    .(id, sex, age, education)
-  ],
-  by = "id",
-  all.x = TRUE
-)
+
large_m18 <- large_m18 %>%
+  left_join(
+    care_trajectories %>%
+      dplyr::filter(month == 0) %>%
+      dplyr::select(id, sex, age, education),
+    by = "id"
+  )

La fonction tbl_summary de l’extension gtsummary permets de produire aisément une série de tableaux croisés. À noter le recours à add_p() pour ajouter les p-valeurs au test du Chi².1 La fonction add_overall permets d’ajouter une colonne avec l’ensemble de l’échantillon. Notez que nous avons utiliser unlabelled de l’extension labelled pour convertir en amont les vecteurs labellisés en facteurs.

-
library(gtsummary)
-unlabelled(large_m18) %>% 
-  tbl_summary(by = "groupe", include = c("groupe", "sex", "age", "education")) %>%
-  add_p() %>%
-  add_overall(last = TRUE)
+
library(gtsummary)
+large_m18 %>%
+  ungroup() %>%
+  unlabelled() %>% 
+  tbl_summary(by = "groupe", include = c("groupe", "sex", "age", "education")) %>%
+  add_p() %>%
+  add_overall(last = TRUE)
-
+
- + @@ -30767,7 +33459,7 @@

Facteurs associés à l’appartenance à chaque groupe

p-value2 @@ -30777,7 +33469,7 @@

Facteurs associés à l’appartenance à chaque groupe

- + @@ -30804,7 +33496,7 @@

Facteurs associés à l’appartenance à chaque groupe

- + @@ -30827,12 +33519,12 @@

Facteurs associés à l’appartenance à chaque groupe

- - - - + + + + - + @@ -30840,7 +33532,7 @@

Facteurs associés à l’appartenance à chaque groupe

- + @@ -30877,114 +33569,118 @@

Facteurs associés à l’appartenance à chaque groupe

1 - Statistique présentée: n (%) + n (%)

2 - Test statistique réalisé: test du khi-deux d'indépendance + Pearson's Chi-squared test

CaractéristiqueCharacteristic Rapides, N = 3941 -Total, N = 1 3171 +Overall, N = 1,3171
<0,001<0.001
<0,001<0.001
60+29 (7,4%)11 (5,2%)14 (8,4%)30 (5,5%)29 (7.4%)11 (5.2%)14 (8.4%)30 (5.5%) 84 (6,4%)84 (6.4%)
Education 0,0020.002

Une manière de présenter ces mêmes données de manière plus visuelle consiste à réaliser un diagramme en barres cumulées (voir le chapitre sur les graphiques bivariés). Ici, nous utilisons une boucle for (voir le chapitre sur les structures conditionnelles) pour calculer les différents tableaux croisés et les fusionner avec bind_rows (voir la section concaténation de tables du chapitre dédié à dplyr). Nous en profitions également pour calculer le test du Chi² et l’afficher avec le nom de la variable sur le graphique.

Note : pour afficher les proportions sur le graphique, aurons recours recours à la statistique stat_prop de l’extension GGally.

-
res <- tibble()
-explanatory <- c(
-  "sex" = "Sexe", 
-  "age" = "Âge",
-  "education" = "Education"
-)
-for (v in names(explanatory)) {
-  tmp <- tibble::as_tibble(table(large_m18$groupe, to_factor(large_m18[[v]])), .name_repair = "unique")
-  names(tmp) <- c("groupe", "level", "n")
-  test <- chisq.test(large_m18$groupe, to_factor(large_m18[[v]]))
-  tmp$var <- paste0(
-    explanatory[v],
-    "\n",
-    scales::pvalue(test$p.value, add_p = TRUE)
-  )
-  res <- bind_rows(res, tmp)
-}
-
-
-# stat_prop() a besoin d'un facteur
-res$level <- factor(res$level)
-
-library(GGally)
-ggplot(res) +
-  aes(x = level, fill = groupe, weight = n) +
-  geom_bar(position = "fill") +
-  geom_text(
-    aes(by = level, label = scales::percent(..prop.., accuracy = 1)), 
-    stat = "prop", position = position_fill(.5)
-  ) +
-  facet_grid(var ~ ., scales = "free", space = "free") +
-  scale_y_continuous(labels = scales::percent, breaks = 0:5/5) +
-  coord_flip() +
-  theme(legend.position = "bottom") +
-  xlab("") + ylab("") + labs(fill = "")
-

Un graphique similaire peut s’obtenir très facilement en ayant recours à la fonction ggbivariate de l’extension GGally2.

-
library(GGally)
-ggbivariate(
-  unlabelled(large_m18), 
-  outcome = "groupe", 
-  explanatory = c("sex", "age", "education"),
-  columnLabelsY = c("Sex", "Âge", "Éducation")
-) + labs(fill = "")
-

-

Pour mieux visualiser les relations entre les variables, on peut avoir recours à la fonction ggtable de l’extension GGally qui permets de représenter les résidus du Chi².

-
library(GGally)
-ggtable(
-  unlabelled(large_m18), 
-  columnsX = "groupe", 
-  columnsY = c("sex", "age", "education"),
-  cells = "col.prop",
-  fill = "std.resid",
-  columnLabelsX = "Type de trajectoire", 
-  columnLabelsY = c("Sex", "Âge", "Éducation"),
-  legend = 1
-) + 
-  labs(fill = "Résidus standardizés du Chi²") +
-  theme(legend.position = "bottom")
+
res <- tibble()
+explanatory <- c(
+  "sex" = "Sexe", 
+  "age" = "Âge",
+  "education" = "Education"
+)
+for (v in names(explanatory)) {
+  tmp <- tibble::as_tibble(table(large_m18$groupe, to_factor(large_m18[[v]])), .name_repair = "unique")
+  names(tmp) <- c("groupe", "level", "n")
+  test <- chisq.test(large_m18$groupe, to_factor(large_m18[[v]]))
+  tmp$var <- paste0(
+    explanatory[v],
+    "\n",
+    scales::pvalue(test$p.value, add_p = TRUE)
+  )
+  res <- bind_rows(res, tmp)
+}
+
+
+# stat_prop() a besoin d'un facteur
+res$level <- factor(res$level)
+
+library(GGally)
+ggplot(res) +
+  aes(x = level, fill = groupe, weight = n) +
+  geom_bar(position = "fill") +
+  geom_text(
+    aes(by = level, label = scales::percent(..prop.., accuracy = 1)), 
+    stat = "prop", position = position_fill(.5)
+  ) +
+  facet_grid(var ~ ., scales = "free", space = "free") +
+  scale_y_continuous(labels = scales::percent, breaks = 0:5/5) +
+  coord_flip() +
+  theme(legend.position = "bottom") +
+  xlab("") + ylab("") + labs(fill = "")
+

Un graphique similaire peut s’obtenir très facilement en ayant recours à la fonction ggbivariate de l’extension GGally2.

+
library(GGally)
+ggbivariate(
+  large_m18 %>% ungroup() %>% unlabelled(), 
+  outcome = "groupe", 
+  explanatory = c("sex", "age", "education"),
+  columnLabelsY = c("Sex", "Âge", "Éducation")
+) + labs(fill = "")

+

Pour mieux visualiser les relations entre les variables, on peut avoir recours à la fonction ggtable de l’extension GGally qui permets de représenter les résidus du Chi².

+
library(GGally)
+ggtable(
+  large_m18 %>% ungroup() %>% unlabelled(), 
+  columnsX = "groupe", 
+  columnsY = c("sex", "age", "education"),
+  cells = "col.prop",
+  fill = "std.resid",
+  columnLabelsX = "Type de trajectoire", 
+  columnLabelsY = c("Sex", "Âge", "Éducation"),
+  legend = 1
+) + 
+  labs(fill = "Résidus standardizés du Chi²") +
+  theme(legend.position = "bottom")
+

On considère qu’une cellule est surreprésentée si son résidu standardisé du Chi² est supérieur à 2 ou 3, et qu’elle est sous-représentée si le résidu est inférieur à -2 ou -3.

On peut ainsi noter que les hommes, les jeunes et ceux vivant à plus de 10 kilomètres d’une clinique sont plus souvent dans le groupe Hors soins. Inversement, les femmes et les plus éduqués sont plus souvent dans le groupe des Rapides. Résultat inattendu, les ménages les plus riches sont moins souvent dans les groupes ayant initiés un traitement (Rapides et Lents), ce résultat pouvant s’expliquer en partie par le fait que les plus aisés peuvent plus facilement accéder à des soins dans le secteur privé, et donc faussement apparaître Hors soins, car seuls les soins reçus dans le secteur public ont été mesurés dans cette étude.

Pour affiner les résultats, on aura recours à un modèle multivarié en exécutant une régression logistique multinomiale avec multinom de l’extension nnet (pour plus de détails, voir le chapitre dédié).

-
library(nnet)
-large_m18$groupe2 <- relevel(large_m18$groupe, "Hors soins")
-regm <- multinom(
-  groupe2 ~ sex + age + education, 
-  data = to_factor(large_m18)
-)
-
library(GGally)
-ggcoef_multinom(regm, exponentiate = TRUE)
-

+
library(nnet)
+large_m18 <- large_m18 %>% ungroup()
+large_m18$groupe2 <- relevel(large_m18$groupe, "Hors soins")
+regm <- multinom(
+  groupe2 ~ sex + age + education, 
+  data = to_factor(large_m18)
+)
+
library(GGally)
+ggcoef_multinom(regm, exponentiate = TRUE)
+

Nous pouvons représenter les effets des variables du modèle avec la fonction ggeffect de ggeffects.

-
library(ggeffects)
-cowplot::plot_grid(plotlist = plot(ggeffect(regm)), ncol = 3)
-

+
library(ggeffects)
+cowplot::plot_grid(plotlist = plot(ggeffect(regm)), ncol = 3)
+

Modèle mixte à classes latentes

Un autre type d’approche envisageable pour identifier des classes de trajectoires est celle des modèles mixtes à classes latentes. Ce type de modèles peut prendre en compte une grande variété d’indicateurs, continus, binaires ou ordinaux. On peut y intégrer des co-variables et il n’est pas nécessaire de disposer du même nombre d’observations par individu.

Nous n’aborderons que brièvement ici ce type de modèles complexes. Sous R, ils peuvent être réalisés via l’extension lcmm et sa fonction homonyme lcmm.

Commençons par préparer les données.

-
care_trajectories$num_status <- as.integer(to_factor(care_trajectories$care_status))
-care_trajectories[, sexF := to_factor(sex)]
-care_trajectories[, ageF := to_factor(age)]
-care_trajectories[, educationF := to_factor(education)]
+
care_trajectories <- care_trajectories %>%
+  mutate(
+    num_status = as.integer(to_factor(care_status)),
+    sexF = to_factor(sex),
+    ageF = to_factor(age),
+    educationF = to_factor(education)
+  )

Ici, nous allons modéliser le statut dans les soins en fonction du temps. Il faut indiquer au modèle, via le paramètre ng le nombre de groupes ou classes latentes souhaité. Ici, nous avons retenu 4 en lien avec les résultats de notre analyse de séquences. L’argument link = "thresholds" permets d’indiquer que notre variable d’intérêt est ordinale. Les modèles lcmm peuvent également prendre en compte des variables continues.

Attention : le temps de calcul de ce type de modèle peut être long (plusieurs heures dans notre exemple), suivant le nombre de paramètres, le nombre d’observations et la puissance de votre machine.

-
library(lcmm)
-mod4 <-lcmm(
-  num_status ~ month, random = ~ month, subject = 'id', 
-  mixture = ~ month, ng = 4, idiag = TRUE, data = care_trajectories, 
-  link = "thresholds"
-)
+
library(lcmm)
+mod4 <-lcmm(
+  num_status ~ month, random = ~ month, subject = 'id', 
+  mixture = ~ month, ng = 4, idiag = TRUE, data = care_trajectories, 
+  link = "thresholds"
+)

Voyons comment se présentent les résultats.

-
summary(mod4)
+
summary(mod4)
General latent class mixed model 
      fitted by maximum likelihood method 
  
@@ -31066,7 +33762,7 @@ 

Modèle mixte à classes latentes

thresh. parm3 1.08980 0.00727 149.816 0.00000

On dispose d’un AIC et d’un BIC. Ainsi, une stratégie possible pour déterminer le nombre de classes consiste à calculer un modèle différent pour chaque nombre de classes envisagé puis à retenir le modèle ayant le plus faible AIC ou BIC.

Pour chaque observation, le modèle a calculé la probabilité qu’elle appartienne à chacune des 4 classes identifiées. La fonction postprob fournit des statistiques sur cette classification.

-
postprob(mod4)
+
postprob(mod4)
 
 Posterior classification: 
   class1 class2 class3  class4
@@ -31088,152 +33784,251 @@ 

Modèle mixte à classes latentes

prob>0.9 11.26 33.99 21.93 3.51

Les classes et les probabilités d’appartenance à chacune sont disponibles aisément.

-
head(mod4$pprob)
+
head(mod4$pprob)
- - - - - - - + + + + + + + - - - - - - - + + + + + + + - - - - - - - + + + + + + + - - - - - - - + + + + + + + - - - - - - - + + + + + + + - - - - - - - + + + + + + + - - - - - - - + + + + + + +
idclassprob1prob2prob3prob4
+id + +class + +prob1 + +prob2 + +prob3 + +prob4 +
340.16866290.22185690.20162420.4078560
+3 + +4 + +0.1686629 + +0.2218569 + +0.2016242 + +0.4078560 +
940.21237590.20519870.23290090.3495245
+9 + +4 + +0.2123759 + +0.2051987 + +0.2329009 + +0.3495245 +
1340.15902130.22602050.18796100.4269972
+13 + +4 + +0.1590213 + +0.2260205 + +0.1879610 + +0.4269972 +
1510.99921060.00000000.00000040.0007890
+15 + +1 + +0.9992106 + +0.0000000 + +0.0000004 + +0.0007890 +
1810.56163440.04729770.34788220.0431858
+18 + +1 + +0.5616344 + +0.0472977 + +0.3478822 + +0.0431858 +
2140.16866290.22185690.20162420.4078560
+21 + +4 + +0.1686629 + +0.2218569 + +0.2016242 + +0.4078560 +

Récupérons la classe dans notre fichier de données.

-
care_trajectories <- merge(
-  care_trajectories,
-  mod4$pprob %>% dplyr::select(id, mod4_class = class),
-  by = "id",
-  all.x = TRUE
-)
+
care_trajectories <- care_trajectories %>%
+  left_join(
+    mod4$pprob %>% dplyr::select(id, mod4_class = class),
+    by = "id"
+  )

Améliorons les intitulés des classes et ajoutons le nombre d’individu par classes.

-
n_par_classe <- table(mod4$pprob$class)
-n_par_classe
+
n_par_classe <- table(mod4$pprob$class)
+n_par_classe
- - - - - + + + + + - - - - - + + + + +
1234
+1 + +2 + +3 + +4 +
8441534241508
+844 + +153 + +424 + +1508 +
-
care_trajectories$mod4_class2 <- factor(
-  care_trajectories$mod4_class,
-  levels = 1:4,
-  labels = paste0(
-    "Classe ",
-    1:4,
-    " (n=",
-    n_par_classe,
-    ")"
-  )
-)
+
care_trajectories$mod4_class2 <- factor(
+  care_trajectories$mod4_class,
+  levels = 1:4,
+  labels = paste0(
+    "Classe ",
+    1:4,
+    " (n=",
+    n_par_classe,
+    ")"
+  )
+)

Représentons la cascade observée dans chacune de ces classes.

-
care_trajectories$care_statusF <- to_factor(care_trajectories$care_status)
-ggplot(care_trajectories[month <= 36]) +
-  aes(x = month, fill = care_statusF) +
-  geom_bar(color = "gray50", width = 1, position = "fill") +
-  scale_x_continuous(breaks = 0:6*6, labels = paste0("M", 0:6*6)) +
-  scale_y_continuous(labels = scales::percent) +
-  xlab("") + ylab("") +
-  theme_light() +
-  theme(legend.position = "bottom") +
-  labs(fill = "Statut dans les soins") + 
-  scale_fill_viridis(discrete = TRUE, direction = -1) +
-  guides(fill = guide_legend(nrow = 2)) +
-  facet_grid(~ mod4_class2)
-

+
care_trajectories$care_statusF <- to_factor(care_trajectories$care_status)
+ggplot(care_trajectories %>% filter(month <= 36)) +
+  aes(x = month, fill = care_statusF) +
+  geom_bar(color = "gray50", width = 1, position = "fill") +
+  scale_x_continuous(breaks = 0:6*6, labels = paste0("M", 0:6*6)) +
+  scale_y_continuous(labels = scales::percent) +
+  xlab("") + ylab("") +
+  theme_light() +
+  theme(legend.position = "bottom") +
+  labs(fill = "Statut dans les soins") + 
+  scale_fill_viridis(discrete = TRUE, direction = -1) +
+  guides(fill = guide_legend(nrow = 2)) +
+  facet_grid(~ mod4_class2)
+

Une manière alternative de présenter les classes consiste à représenter chaque mois, non pas la distribution dans chaque état, mais un état moyen en considérant que le statut dans les soins peut être assimilé à un score allant de 1 à 4.

-
moyennes_mensuelles <- care_trajectories[
-  month <= 36, 
-  .(status_moyen = mean(num_status)), 
-  by = .(month, mod4_class2)
-]
-
ggplot(moyennes_mensuelles) + 
-  aes(x = month, y = status_moyen, color = mod4_class2) +
-  geom_line(size = 2) +
-  scale_x_continuous(breaks = 0:6*6, labels = paste0("M", 0:6*6)) +
-  scale_y_continuous(
-    breaks = 1:4, limits = c(1, 4),
-    labels = c("diagnostiqué", "suivi", "sous traitement", "contrôlé")
-  ) +
-  xlab("") + ylab("Statut moyen") + labs(color = "") +
-  theme_classic() +
-  theme(
-    legend.position = "bottom", 
-    panel.grid.major = element_line(colour = "grey80")
-  )
+

Les valeurs moyennes seront calculées à la volée grace à la statistique stat_weighted_mean de GGally.

+
library(GGally)
+ggplot(care_trajectories %>% filter(month <= 36)) + 
+  aes(x = month, y = num_status, color = mod4_class2) +
+  geom_line(stat = "weighted_mean", size = 1.5) +
+  scale_x_continuous(breaks = 0:6*6, labels = paste0("M", 0:6*6)) +
+  scale_y_continuous(
+    breaks = 1:4, limits = c(1, 4),
+    labels = c("diagnostiqué", "suivi", "sous traitement", "contrôlé")
+  ) +
+  xlab("") + ylab("Statut moyen") + labs(color = "") +
+  theme_classic() +
+  theme(
+    legend.position = "bottom", 
+    panel.grid.major = element_line(colour = "grey80")
+  )

Il faut cependant rester vigilant, dans la mesure où ce type de représentation synthétique peut masquer la diversité des trajectoires sous-jacentes, notamment en termes de durée ou d’enchaînement des événements. Même si cela est peut-être plus difficile à lire, il est toujours bon de regarder les tapis de séquences.

-
care_trajectories[, tmp_rang := as.integer(fct_infreq(factor(id))), by = mod4_class]
-
ggplot(care_trajectories[month <= 36]) +
-  aes(x = month, y = tmp_rang, fill = care_statusF) +
-  geom_raster() +
-  facet_grid(mod4_class2 ~ ., space = "free", scales = "free") +
-  scale_x_continuous(breaks = 0:6*6, labels = paste0("M", 0:6*6)) +
-  scale_y_continuous(breaks = 0:5*200, minor_breaks = NULL) +
-  xlab("") + ylab("") +
-  theme_light() +
-  theme(legend.position = "bottom") +
-  labs(fill = "Statut dans les soins") + 
-  scale_fill_viridis(discrete = TRUE, direction = -1) +
-  guides(fill = guide_legend(nrow = 2))
+
care_trajectories <- care_trajectories %>%
+  group_by(mod4_class) %>%
+  mutate(tmp_rang = as.integer(fct_infreq(factor(id)))) %>%
+  ungroup()
+
ggplot(care_trajectories %>% filter(month <= 36)) +
+  aes(x = month, y = tmp_rang, fill = care_statusF) +
+  geom_raster() +
+  facet_grid(mod4_class2 ~ ., space = "free", scales = "free") +
+  scale_x_continuous(breaks = 0:6*6, labels = paste0("M", 0:6*6)) +
+  scale_y_continuous(breaks = 0:5*200, minor_breaks = NULL) +
+  xlab("") + ylab("") +
+  theme_light() +
+  theme(legend.position = "bottom") +
+  labs(fill = "Statut dans les soins") + 
+  scale_fill_viridis(discrete = TRUE, direction = -1) +
+  guides(fill = guide_legend(nrow = 2))

@@ -31242,24 +34037,28 @@

Modèle à observations répétées

Il s’agit de modèles classiques sauf qu’au lieu de considérer une ligne par individu, nous allons intégrer dans le modèle une ligne par individu et par pas de temps. Dans la mesure où nous avons plusieurs observations pour une même personne, cela doit être pris en compte par l’ajout d’un effet aléatoire dans le cadre d’un modèle mixte ou en ayant recours à un (voir le chapitre sur les modèles à effets aléatoires).

Vue la nature de notre variable d’intérêt (plusieurs modalités ordonnées), nous aurons recours à une régression logistique ordinale (voir le chapitre dédié). Pour un modèle mixte ordinal on peut utiliser la fonction clmm de l’extension ordinal. Pour un modèle GEE ordinal, citons ordgee de l’extension geepack ou encore ordLORgee de multgee. Il importe également que la dimension temporelle soit inclue dans les variables du modèle.

Ici, nous allons utiliser ordgee. Il nous faut tout d’abord transformer notre variable d’intérêt en un facteur ordonné.

-
care_trajectories[, care_statusF := to_factor(care_status, ordered = TRUE)]
+
care_trajectories$care_statusF <- care_trajectories$care_status %>%
+  to_factor(ordered = TRUE)

Nous allons transformer nos variables explicatives en facteurs. Pour le temps, dans la mesure où sont effet n’est pas forcément linéaire, nous allons l’intégrer en tant que variable catégorielle. Par contre, comme nous n’avons que très peu d’observations individuelles après 3 ans, nous ne prendrons en compte que les observations des 36 premiers mois. Nous allons aussi retirer les observations à M0 puisqu’à ce moment précis tous les individus sont dans la même situation (diagnostiqués mais pas en soins.)

-
ct36 <- care_trajectories[month > 0 & month <= 36, ]
-ct36[, sexF := to_factor(sex)]
-ct36[, ageF := to_factor(age)]
-ct36[, educationF := to_factor(education)]
-ct36[, monthF := to_factor(month)]
+
ct36 <- care_trajectories %>%
+  filter(month > 0 & month <= 36) %>%
+  mutate(
+    sexF = to_factor(sex),
+    ageF = to_factor(age),
+    educationF = to_factor(education),
+    monthF = to_factor(month)
+  )

Calculons notre modèle.

-
library(geepack)
-mod_td <- ordgee(
-  care_statusF ~ sexF + ageF + educationF + monthF,
-  data = ct36,
-  id = ct36$id
-)
+
library(geepack)
+mod_td <- ordgee(
+  care_statusF ~ sexF + ageF + educationF + monthF,
+  data = ct36,
+  id = ct36$id
+)

Les coefficients du modèle s’obtiennent avec summary. Malheureusement, il n’existe pas de tieder pour ce type de modèle. Nous allons donc procéder manuellement.

-
res <- summary(mod_td)$mean
-res$term <- rownames(res)
-head(res)
+
res <- summary(mod_td)$mean
+res$term <- rownames(res)
+head(res)
@@ -31321,26 +34120,26 @@

Modèle à observations répétées

Les intervalles de confiance à 95% ne sont pas déjà calculés. Faisons-le donc nous même.

-
mult <- stats::qnorm((1 + .95) / 2)
-res$conf.low <- res$estimate - mult * res$san.se
-res$conf.high <- res$estimate + mult * res$san.se
+
mult <- stats::qnorm((1 + .95) / 2)
+res$conf.low <- res$estimate - mult * res$san.se
+res$conf.high <- res$estimate + mult * res$san.se

Enfin, nous souhaitons disposer des odds ratios et non des coefficients bruts. Il faut avoir recours à la fonction exp (exponentielle).

-
res$estimate <- exp(res$estimate)
-res$conf.low <- exp(res$conf.low)
-res$conf.high <- exp(res$conf.high)
+
res$estimate <- exp(res$estimate)
+res$conf.low <- exp(res$conf.low)
+res$conf.high <- exp(res$conf.high)

Préparons un tableau avec les résultats. Pour le rendre plus lisible, nous allons mettre en forme les odds ratios avec une seule décimale. Améliorer le rendu des p-values et nous allons utiliser la virgule comme séparateur de décimal, comme il se doit. Nous aurons recours aux fonctions number et pvalue de l’extension scales (voir le chapitre sur la mise en forme des nombres).

-
tab <- res %>% 
-  mutate (
-    estimate = scales::number(estimate, accuracy = .01, decimal.mark = ","),
-    p = scales::pvalue(p, decimal.mark = ","),
-    conf.low = scales::number(conf.low, accuracy = .1, decimal.mark = ","),
-    conf.high = scales::number(conf.high, accuracy = .1, decimal.mark = ",")
-  ) %>%
-  dplyr::select(
-    Facteur = term, OR = estimate, "p-value" = p, 
-    "IC 95% bas" = conf.low, "IC 95% haut" = conf.high
-  )
-
knitr::kable(tab, row.names = FALSE, align = "lrrrr")
+
tab <- res %>% 
+  mutate (
+    estimate = scales::number(estimate, accuracy = .01, decimal.mark = ","),
+    p = scales::pvalue(p, decimal.mark = ","),
+    conf.low = scales::number(conf.low, accuracy = .1, decimal.mark = ","),
+    conf.high = scales::number(conf.high, accuracy = .1, decimal.mark = ",")
+  ) %>%
+  dplyr::select(
+    Facteur = term, OR = estimate, "p-value" = p, 
+    "IC 95% bas" = conf.low, "IC 95% haut" = conf.high
+  )
+
knitr::kable(tab, row.names = FALSE, align = "lrrrr")
@@ -31654,57 +34453,52 @@

Modèle à observations répétées

Facteur

On peut facilement représenter tout cela graphiquement. On va supprimer les termes seuils, grâce à str_detect de stringr. On notera le recours à fct_inorder de forcats pour conserver l’ordre des termes selon leur ordre d’apparition.

-
res <- res[!str_detect(res$term, "Inter"),]
-res$term <- fct_inorder(res$term)
-res$term <- fct_recode(res$term,
-               "femme vs. homme" = "sexFfemme",
-               "âge : 30-59 vs. 16-29" = "ageF30-59",
-               "âge : 60+ vs 16-29" = "ageF60+",
-               "éducation : secondaire vs. primaire" = "educationFsecondaire",
-               "éducation : supérieure vs. primaire" = "educationFsupérieur",
-               "M2" = "monthF2",
-               "M3" = "monthF3",
-               "M4" = "monthF4",
-               "M5" = "monthF5",
-               "M6" = "monthF6",
-               "M7" = "monthF7",
-               "M8" = "monthF8",
-               "M9" = "monthF9",
-               "M10" = "monthF10",
-               "M11" = "monthF11",
-               "M12" = "monthF12",
-               "M13" = "monthF13",
-               "M14" = "monthF14",
-               "M15" = "monthF15",
-               "M16" = "monthF16",
-               "M17" = "monthF17",
-               "M18" = "monthF18",
-               "M19" = "monthF19",
-               "M20" = "monthF20",
-               "M21" = "monthF21",
-               "M22" = "monthF22",
-               "M23" = "monthF23",
-               "M24" = "monthF24",
-               "M25" = "monthF25",
-               "M26" = "monthF26",
-               "M27" = "monthF27",
-               "M28" = "monthF28",
-               "M29" = "monthF29",
-               "M30" = "monthF30",
-               "M31" = "monthF31",
-               "M32" = "monthF32",
-               "M33" = "monthF33",
-               "M34" = "monthF34",
-               "M35" = "monthF35",
-               "M36" = "monthF36")
-res$var_group <- c("a", "b", "b", "c", "c", rep("d", 35))
-
-GGally::ggcoef(
-    res, exponentiate = TRUE, 
-    mapping = aes(x = estimate, y = fct_rev(term), color = var_group)
-  ) +
-  theme_classic() + ylab("") + xlab("Odds Ratio") +
-  theme(legend.position = "none")
+
res <- res[!str_detect(res$term, "Inter"),]
+res$term <- fct_inorder(res$term)
+res$term <- fct_recode(res$term,
+               "femme vs. homme" = "sexFfemme",
+               "âge : 30-59 vs. 16-29" = "ageF30-59",
+               "âge : 60+ vs 16-29" = "ageF60+",
+               "éducation : secondaire vs. primaire" = "educationFsecondaire",
+               "éducation : supérieure vs. primaire" = "educationFsupérieur",
+               "M2" = "monthF2",
+               "M3" = "monthF3",
+               "M4" = "monthF4",
+               "M5" = "monthF5",
+               "M6" = "monthF6",
+               "M7" = "monthF7",
+               "M8" = "monthF8",
+               "M9" = "monthF9",
+               "M10" = "monthF10",
+               "M11" = "monthF11",
+               "M12" = "monthF12",
+               "M13" = "monthF13",
+               "M14" = "monthF14",
+               "M15" = "monthF15",
+               "M16" = "monthF16",
+               "M17" = "monthF17",
+               "M18" = "monthF18",
+               "M19" = "monthF19",
+               "M20" = "monthF20",
+               "M21" = "monthF21",
+               "M22" = "monthF22",
+               "M23" = "monthF23",
+               "M24" = "monthF24",
+               "M25" = "monthF25",
+               "M26" = "monthF26",
+               "M27" = "monthF27",
+               "M28" = "monthF28",
+               "M29" = "monthF29",
+               "M30" = "monthF30",
+               "M31" = "monthF31",
+               "M32" = "monthF32",
+               "M33" = "monthF33",
+               "M34" = "monthF34",
+               "M35" = "monthF35",
+               "M36" = "monthF36")
+res$variable <- c("sexe", "âge", "âge", "éducation", "éducation", rep("mois", 35))
+
+res %>% GGally::ggcoef_plot(y = "term", facet_row = "variable", colour = "variable")

Sur ce graphique, on visualise bien l’évolution temporelle traduite par les odds ratios associés à chaque mois, ainsi que les effets globaux de nos covariables : les femmes ont une meilleure progression dans la cascade de soins que les hommes, de même que les plus éduqués et les plus âgés.

@@ -31712,13 +34506,15 @@

Modèle à observations répétées

Modèle de survie multi-états

Depuis la fin du XXe siècle, de nombreux développements ont réalisés pour étendre les modèles de survie à des processus multi-états. Ces modèles permettent de considérer une grande variété de processus. Plusieurs implémentations existent dans R3. Ici, nous allons utiliser l’extension msm qui repose sur des modèles de Markov multi-états et peut prendre en compte des co-variables dans le modèle.

En premier lieu, pour cette extension, ils nous faut disposer des données sous une forme longue, c’est-à-dire avec une ligne par individu et point d’observation dans le temps, ce qui est déjà le cas du fichier care_trajectories. Les différents status possibles doivent également être codés sous la forme de nombres entiers croissants (ici 1 correspondra à D, 2 à C, 3 à T et 4 à S).

-
library(msm)
-care_trajectories$status <- as.integer(to_factor(care_trajectories$care_status))
-setorder(care_trajectories, id, month)
-

Par ailleurs, nous n’allons concerver dans l’analyse que les individus avec au moins deux points d’observation, ici ceux observés au moins jusqu’à un mois.

-
ct <- care_trajectories[id %in% care_trajectories[month == 1, id]]
+
library(msm)
+care_trajectories$status <- as.integer(to_factor(care_trajectories$care_status))
+care_trajectories <- care_trajectories %>%
+  arrange(id, month)
+

Par ailleurs, nous n’allons conserver dans l’analyse que les individus avec au moins deux points d’observation, ici ceux observés au moins jusqu’à un mois.

+
ct <- care_trajectories %>%
+  filter(id %in% (care_trajectories %>% filter(month == 1) %>% pluck("id")))

La fonction statetable.msm permet de calculer le nombre et le type de transitions observées dans les données.

-
statetable.msm(status, id, data = ct)
+
statetable.msm(status, id, data = ct)
@@ -31759,49 +34555,49 @@

Modèle de survie multi-états

from/to

Il faut ensuite définir les transitions possibles dans le modèle en faisant une matrice carrée. On indiquera 0 si la transition n’est pas possible, une valeur positive sinon.

-
tr <- rbind(
-  c(0, 1, 0, 0), # de 1 : vers 2
-  c(1, 0, 1, 0), # de 2 : vers 1 ou vers 3
-  c(0, 1, 0, 1), # de 3 : vers 2 ou vers 4
-  c(0, 0, 1, 0)  # de 4 : vers 3
-)
+
tr <- rbind(
+  c(0, 1, 0, 0), # de 1 : vers 2
+  c(1, 0, 1, 0), # de 2 : vers 1 ou vers 3
+  c(0, 1, 0, 1), # de 3 : vers 2 ou vers 4
+  c(0, 0, 1, 0)  # de 4 : vers 3
+)

Dans notre matrice de transitions, nous n’avons pas défini de transition directe entre le statut 1 et le statut 3, alors que de telles transitions sont pourtant observées dans notre fichier. En fait, nous pouvons considérer qu’une transition de 1 vers 3 correspond en fait à deux transitions successives, de 1 vers 2 puis de 2 vers 3. La fonction msm s’aura identifier d’elle-mêmes ces doubles, voire triples, transitions.

On peut facilement représenter notre matrice de transition sous forme de schéma à l’aide de l’excellente extension DiagrammeR.

-
library(DiagrammeR)
-mermaid("
-graph TD
-1[diagnostiqué, mais pas suivi]
-2[suivi, mais pas sous traitement]
-3[sous traitement, mais infection non contrôlée]
-4[sous traitement et infection contrôlée]
-
-1--entrée<br />en soins-->2
-2--initiation<br />traitement-->3
-2--sortie<br />de soins-->1
-3--contrôle<br />infection-->4
-3--arrêt<br />traitement-->2
-4--échec<br/>virologique-->3
-", height = 300)
+
library(DiagrammeR)
+mermaid("
+graph TD
+1[diagnostiqué, mais pas suivi]
+2[suivi, mais pas sous traitement]
+3[sous traitement, mais infection non contrôlée]
+4[sous traitement et infection contrôlée]
+
+1--entrée<br />en soins-->2
+2--initiation<br />traitement-->3
+2--sortie<br />de soins-->1
+3--contrôle<br />infection-->4
+3--arrêt<br />traitement-->2
+4--échec<br/>virologique-->3
+", height = 300)

Il ne nous reste plus qu’à spécifier notre modèle. L’option obstype = 1 indique à msm que nos données correspondent à des snapshots à certains moments donnés (ici tous les mois) et donc que les transitions d’un état à un autre ont eu lieu entre nos points d’observation. Les types 2 et 3 correspondent à des dates de transition exactes (voir l’aide la fonction pour plus de détails).

-
ms_mod <- msm(
-  status ~ month, subject = id, data = ct, qmatrix = tr, obstype = 1
-)
+
ms_mod <- msm(
+  status ~ month, subject = id, data = ct, qmatrix = tr, obstype = 1
+)

En exécutant cette commande, vous risquez d’obtenir le message d’erreur suivant :

Error in Ccall.msm(params, do.what = "lik", ...) : numerical overflow in calculating likelihood

Cela est dû à un problème d’échelle dans l’optimisation du modèle qui génère des nombres plus grands que ce que peux gérer l’ordinateur. Il peut être résolu de la manière suivante. Tout d’abord, on reexécute le modèle avec l’option control = list(trace = TRUE).

-
ms_mod <- msm(
-  status ~ month, subject = id, data = ct, qmatrix = tr, obstype = 1, 
-  control = list(trace = TRUE)
-)
+
ms_mod <- msm(
+  status ~ month, subject = id, data = ct, qmatrix = tr, obstype = 1, 
+  control = list(trace = TRUE)
+)

On obtient le message suivant :

initial  value 74796.800445 
 Error in Ccall.msm(params, do.what = "lik", ...) : numerical overflow in calculating likelihood

Ce qui importe de retenir, c’est la valeur initiale du paramètre d’optimisation avant que l’erreur ne se produise. On va l’utiliser (ou une valeur proche) comme paramètre d’échelle pour l’optimation avec l’option fnscale :

-
ms_mod <- msm(
-  status ~ month, subject = id, data = ct, qmatrix = tr, obstype = 1, 
-  control = list(fnscale = 75000, trace = TRUE)
-)
+
ms_mod <- msm(
+  status ~ month, subject = id, data = ct, qmatrix = tr, obstype = 1, 
+  control = list(fnscale = 75000, trace = TRUE)
+)
initial  value 0.997291 
 iter  10 value 0.520302
 iter  20 value 0.497598
@@ -31810,19 +34606,19 @@ 

Modèle de survie multi-états

converged Used 39 function and 37 gradient evaluations

On peut comparer la prévalence dans chaque état au cours du temps telle que modélisée par le modèle avec les valeurs observées avec la fonction plot.prevalence.msm.

-
plot.prevalence.msm(ms_mod)
+
plot.prevalence.msm(ms_mod)

Par défaut, msm considère que les intensités de transition d’un état à un autre sont constantes au cours du temps. Or, dans notre example, il apparait que les prévalences observées varient différemment pendant les premiers mois après le diagnostic. Nous allons donc recalculer le modèle en spécifiant avec le paramètre pci que nous souhaitons considérer des intensités de transition différentes pour les trois premiers mois, la première année, la seconde année et après la seconde année. Comme il faudra plus d’itérations pour faire converger notre modèle, nous avons également augmenter la valeur du paramètre maxit (100 par défaut).

-
ms_mod <- msm(
-  status ~ month, subject = id, data = ct, qmatrix = tr, obstype = 1, 
-  pci = c(3, 12, 24),
-  control = list(fnscale = 75000, trace = TRUE, maxit = 500)
-)
+
ms_mod <- msm(
+  status ~ month, subject = id, data = ct, qmatrix = tr, obstype = 1, 
+  pci = c(3, 12, 24),
+  control = list(fnscale = 75000, trace = TRUE, maxit = 500)
+)

Comparons à nouveau les prévalences estimées avec les prévalences observées.

-
plot.prevalence.msm(ms_mod)
+
plot.prevalence.msm(ms_mod)

Comme on peut le voir, l’ajustement entre les deux a été amélioré. Les prévalences elles-mêmes peuvent s’obtenir avec prevalence.msm.

-
prevalence.msm(ms_mod)
+
prevalence.msm(ms_mod)
$Observed
    State 1 State 2 State 3 State 4 Total
 0     2799      24       0       7  2830
@@ -31878,10 +34674,10 @@ 

Modèle de survie multi-états

40 37.64960 8.0867671 5.120553 49.1430833 45 36.34877 7.8878542 5.099838 50.6635426 50 35.15898 7.7253409 5.092087 52.0235901
-

Ceci dit, le format dans lequel sont renvoyées les prévalences n’est que peu pratique pour les exploiter ensuite, par exemple avec ggplot2. L’extension JLutils fournit une fonction expérimentale tidy.prevalence.msm4 permettant de transformer ce résultat dans un format tidy.

-
library(JLutils)
-prev <- tidy.prevalence.msm(prevalence.msm(ms_mod, times = 0:36))
-head(prev)
+

Ceci dit, le format dans lequel sont renvoyées les prévalences n’est que peu pratique pour les exploiter ensuite, par exemple avec ggplot2. L’extension JLutils fournit une fonction expérimentale tidy.prevalence.msm4 permettant de transformer ce résultat dans un format tidy. JLutils est seulement disponible sur GitHub. On l’installera donc (ou on la mettra à jour) avec la commande devtools::install_github("larmarange/JLutils").

+
library(JLutils)
+prev <- tidy.prevalence.msm(prevalence.msm(ms_mod, times = 0:36))
+head(prev)
@@ -31942,43 +34738,43 @@

Modèle de survie multi-états

time
-
prev$status <- to_factor(prev$status)
-casc_status <- c(
-  "diagnostiqué, mais pas suivi",
-  "suivi, mais pas sous traitement",
-  "sous traitement, mais infection non contrôlée",
-  "sous traitement et infection contrôlée"
-)
-levels(prev$status) <- casc_status
+
prev$status <- to_factor(prev$status)
+casc_status <- c(
+  "diagnostiqué, mais pas suivi",
+  "suivi, mais pas sous traitement",
+  "sous traitement, mais infection non contrôlée",
+  "sous traitement et infection contrôlée"
+)
+levels(prev$status) <- casc_status

Il est alors ensuite facile de produire le graphique de la cascade de soins, estimée par le modèle, que l’on pourra mettre en comparaison de la cascade observée que nous avions calculé tout à l’heure.

-
casc_est <- ggplot(prev) +
-  aes(x = time, fill = status, weight = expected) +
-  geom_bar(color = "gray50", width = 1, position = "fill") +
-  scale_x_continuous(breaks = 0:6*6, labels = paste0("M", 0:6*6)) +
-  scale_y_continuous(labels = scales::percent) +
-  ggtitle("Cascade des soins estimée, selon le temps depuis le diagnostic") +
-  xlab("") + ylab("") +
-  theme_light() +
-  theme(legend.position = "bottom") +
-  labs(fill = "Statut dans les soins") + 
-  scale_fill_viridis(discrete = TRUE, direction = -1) +
-  guides(fill = guide_legend(nrow = 2))
-multiplot(casc_obs, casc_est)
+
casc_est <- ggplot(prev) +
+  aes(x = time, fill = status, weight = expected) +
+  geom_bar(color = "gray50", width = 1, position = "fill") +
+  scale_x_continuous(breaks = 0:6*6, labels = paste0("M", 0:6*6)) +
+  scale_y_continuous(labels = scales::percent) +
+  ggtitle("Cascade des soins estimée, selon le temps depuis le diagnostic") +
+  xlab("") + ylab("") +
+  theme_light() +
+  theme(legend.position = "bottom") +
+  labs(fill = "Statut dans les soins") + 
+  scale_fill_viridis(discrete = TRUE, direction = -1) +
+  guides(fill = guide_legend(nrow = 2))
+cowplot::plot_grid(casc_obs, casc_est, ncol = 1)

Comme on peut le voir, dans le modèle, l’évolution est plus lissée comparativement aux données brutes observées.

Un des intérêts de msm est la possibilité d’y intégrer des covariables, permettant ainsi de calculer un modèle multivarié. Les variables peuvent être dépendantes du temps, puisqu’il suffit de renseigner leur valeur à chaque point d’observation.

-
ct$sex <- to_factor(ct$sex)
-ct$age <- to_factor(ct$age)
-ct$education <- to_factor(ct$education)
-
ms_mod_mult <- msm(
-  status ~ month, subject = id, data = ct, qmatrix = tr, obstype = 1, 
-  pci = c(3, 12, 24),
-  control = list(fnscale = 75000, trace = TRUE, maxit = 500),
-  covariates = ~ sex + age + education
-)
+
ct$sex <- to_factor(ct$sex)
+ct$age <- to_factor(ct$age)
+ct$education <- to_factor(ct$education)
+
ms_mod_mult <- msm(
+  status ~ month, subject = id, data = ct, qmatrix = tr, obstype = 1, 
+  pci = c(3, 12, 24),
+  control = list(fnscale = 75000, trace = TRUE, maxit = 500),
+  covariates = ~ sex + age + education
+)

Les risques relatifs, ou hazard ratios en anglais, associés à chaque covariable et à chaque transition s’obtiennent avec hazard.msm. Une fois encore, le format de sortie n’est pas le plus adapté pour un traitement graphique, mais on pourra avoir recours à tidy.hazard.msm de JLutils.

-
hr <- tidy.hazard.msm(hazard.msm(ms_mod_mult))
-head(hr)
+
hr <- tidy.hazard.msm(hazard.msm(ms_mod_mult))
+head(hr)
@@ -32047,130 +34843,241 @@

Modèle de survie multi-états

term

On va recoder certaines étiquettes en vue de faire un graphique des résultats.

-
hr$type <- "Transition ascendante"
-hr[hr$transition == c("State 2 - State 1"),]$type <- "Transition descendante"
-hr[hr$transition == c("State 3 - State 2"),]$type <- "Transition descendante"
-hr[hr$transition == c("State 4 - State 3"),]$type <- "Transition descendante"
-
-hr$term <- fct_recode(
-  fct_inorder(hr$term),
-  "femme vs. homme" = "sexfemme",
-  "30-59 vs. 16-29" = "age30-59",
-  "60+ vs. 16-29" = "age60+",
-  "éduc. secondaire vs. primaire" = "educationsecondaire",
-  "éduc. supérieure vs. primaire" = "educationsupérieur"
-)
-
-hr$transition <- fct_recode(
-  fct_inorder(hr$transition),
-  "entrée en soins" = "State 1 - State 2",
-  "sortie de soins" = "State 2 - State 1",
-  "initiation traitement" = "State 2 - State 3",
-  "arrêt traitement" = "State 3 - State 2",
-  "contrôle infection" = "State 3 - State 4",
-  "échec virologique" = "State 4 - State 3"
-)
-
-head(hr)
+
hr$type <- case_when(
+  hr$transition == c("State 2 - State 1") ~ "Transition descendante",
+  hr$transition == c("State 3 - State 2") ~ "Transition descendante",
+  hr$transition == c("State 4 - State 3") ~ "Transition descendante",
+  TRUE ~"Transition ascendante"
+)
+
+hr$term <- hr$term %>%
+  fct_inorder() %>%
+  fct_recode(
+    "femme vs. homme" = "sexfemme",
+    "30-59 vs. 16-29" = "age30-59",
+    "60+ vs. 16-29" = "age60+",
+    "éduc. secondaire vs. primaire" = "educationsecondaire",
+    "éduc. supérieure vs. primaire" = "educationsupérieur"
+  )
+
+hr$transition <- hr$transition %>%
+  fct_inorder() %>%
+  fct_recode(
+    "entrée en soins" = "State 1 - State 2",
+    "sortie de soins" = "State 2 - State 1",
+    "initiation traitement" = "State 2 - State 3",
+    "arrêt traitement" = "State 3 - State 2",
+    "contrôle infection" = "State 3 - State 4",
+    "échec virologique" = "State 4 - State 3"
+  )
+
+head(hr)
- - - - - - - - - + + + + + + + + + - - - - - - - - - + + + + + + + + + - - - - - - - - - + + + + + + + + + - - - - - - - - - + + + + + + + + + - - - - - - - - - + + + + + + + + + - - - - - - - - - + + + + + + + + + - - - - - - - - - + + + + + + + + +
termtransitionfromtoestimateconf.lowconf.hightype
+term + +transition + +from + +to + +estimate + +conf.low + +conf.high + +type +
femme vs. hommeentrée en soinsState 1State 21.88552321.70596122.083985Transition ascendante
+femme vs. homme + +entrée en soins + +State 1 + +State 2 + +1.8855232 + +1.7059612 + +2.083985 + +Transition ascendante +
femme vs. hommesortie de soinsState 2State 10.92456600.76559971.116540Transition descendante
+femme vs. homme + +sortie de soins + +State 2 + +State 1 + +0.9245660 + +0.7655997 + +1.116540 + +Transition descendante +
femme vs. hommeinitiation traitementState 2State 30.90159130.80444581.010468Transition ascendante
+femme vs. homme + +initiation traitement + +State 2 + +State 3 + +0.9015913 + +0.8044458 + +1.010468 + +Transition ascendante +
femme vs. hommearrêt traitementState 3State 21.09598100.88549661.356498Transition descendante
+femme vs. homme + +arrêt traitement + +State 3 + +State 2 + +1.0959810 + +0.8854966 + +1.356498 + +Transition descendante +
femme vs. hommecontrôle infectionState 3State 41.39854431.23009801.590057Transition ascendante
+femme vs. homme + +contrôle infection + +State 3 + +State 4 + +1.3985443 + +1.2300980 + +1.590057 + +Transition ascendante +
femme vs. hommeéchec virologiqueState 4State 30.86101440.66789181.109979Transition descendante
+femme vs. homme + +échec virologique + +State 4 + +State 3 + +0.8610144 + +0.6678918 + +1.109979 + +Transition descendante +

Vu le nombre de coefficients (un risque relatif par covariable et par transition), on va organiser le graphique en distinguant les transitions acsendantes et les transitions descendantes, d’une part, et en regroupant les risques relatifs d’une même covariable, d’autre part. Pour alléger le graphique, nous allons également retirer la covariable timeperiod créé par l’argument pci, en ayant recours à str_detect de l’extension stringr pour repérer les lignes en questions (voir le chapitre sur la manipulation de texte).

-
ggplot(data = hr[!str_detect(hr$term, "time"), ]) +
-  aes(
-    x = fct_rev(term), y = estimate, color = fct_rev(transition),
-    ymin = conf.low, ymax = conf.high 
-  ) +
-  geom_hline(yintercept = 1, color = "gray25", linetype = "dotted") +
-  geom_errorbar(position = position_dodge(0.5), width = 0) +
-  geom_point(position = position_dodge(0.5)) + 
-  scale_y_log10() + 
-  facet_grid(~ type) +
-  coord_flip() +
-  theme_classic() +
-  theme(legend.position = "bottom") +
-  ylab("risque relatif") + xlab("") +
-  labs(color = "Transition") +
-  scale_color_brewer(palette = "Paired") +
-  guides(color = guide_legend(reverse = TRUE))
+
ggplot(data = hr %>% filter(!str_detect(term, "time"))) +
+  aes(
+    x = fct_rev(term), y = estimate, color = fct_rev(transition),
+    ymin = conf.low, ymax = conf.high 
+  ) +
+  geom_hline(yintercept = 1, color = "gray25", linetype = "dotted") +
+  geom_errorbar(position = position_dodge(0.5), width = 0) +
+  geom_point(position = position_dodge(0.5)) + 
+  scale_y_log10() + 
+  facet_grid(~ type) +
+  coord_flip() +
+  theme_classic() +
+  theme(legend.position = "bottom") +
+  ylab("risque relatif") + xlab("") +
+  labs(color = "Transition") +
+  scale_color_brewer(palette = "Paired") +
+  guides(color = guide_legend(reverse = TRUE))

Ce modèle de survie multi-états permet de mettre en évidence des effets différenciés selon la transition considérée. Par exemple, les femmes sont plus rapides en matière d’entrée en soins et de contrôle de l’infection (une fois le traitement initié) mais plus lentes à démarrer le traitement (une fois entrées en soins). Par contre, le sexe ne semble pas jouer sur les transitions descendantes (échec virologique, arrête du traitement ou sortie de soins).

-

@@ -32183,7 +35090,7 @@

Modèle de survie multi-états

-
+ -
+
@@ -32223,7 +35130,7 @@

Analyse spatiale

Enfin, le site Awesome R fournit une sélection d’extensions dédiées à l’analyse spatiale.

-
+
@@ -32275,7 +35182,7 @@

Assistants pour ggplot2

-
+
+
+

Ce chapitre est évoqué dans le webin-R #13 (exemples de graphiques avancés) sur YouTube.

+

Ce chapitre est évoqué dans le webin-R #14 (exemples de graphiques avancés - 2) sur YouTube.

+

De nombreuses extensions permettent d’étendre les possibilités graphiques de ggplot2. Certaines ont déjà été abordées dans les différents chapitres d’analyse-R. Le présent chapitre ne se veut pas exhaustif et ne présente qu’une sélection choisie d’extensions.

Le site ggplot2 extensions (https://exts.ggplot2.tidyverse.org/gallery/) recense diverses extensions pour ggplot2.

Pour une présentation des fonctions de base et des concepts de ggplot2, on pourra se référer au chapitre dédié ainsi qu’au deux chapitres introductifs : introduction à ggplot2 et graphiques bivariés avec ggplot2.

@@ -32420,99 +35334,106 @@

Graphique d’haltères (dumbbell)

theme_minimal()

+
+

Points reliés (pointpath)

+

L’extension ggh4x propose une géométrie geom_pointpath pour afficher des points reliés entre eux par un tiret. La géométrie geom_pointpath est également proposée par l’extension lemon.

+
library(ggh4x)
+

+Attaching package: 'ggh4x'
+
The following objects are masked from 'package:lemon':
+
+    geom_pointpath, GeomPointPath
+
ggplot(pressure) +
+  aes(x = temperature, y = pressure) +
+  geom_pointpath()
+

+

Accolades de comparaison (bracket)

La géométrie geom_braket de l’extension ggpubr permets d’ajouter sur un graphique des accolades de comparaison entre groupes.

-
library(ggpubr)
-df <- ToothGrowth
-df$dose <- factor(df$dose)
-
-ggplot(df) +
-  aes(x = dose, y = len) +
-  geom_boxplot() +
-  geom_bracket(
-    xmin = "0.5", xmax = "1", y.position = 30,
-    label = "t-test, p < 0.05"
-  )
-

-
ggplot(df) +
-  aes(x = dose, y = len) +
-  geom_boxplot() +
-  geom_bracket(
-    xmin = c("0.5", "1"),
-    xmax = c("1", "2"),
-    y.position = c(30, 35),
-    label = c("***", "**"),
-    tip.length = 0.01
-  )
-

+
library(ggpubr)
+df <- ToothGrowth
+df$dose <- factor(df$dose)
+
+ggplot(df) +
+  aes(x = dose, y = len) +
+  geom_boxplot() +
+  geom_bracket(
+    xmin = "0.5", xmax = "1", y.position = 30,
+    label = "t-test, p < 0.05"
+  )
+

+
ggplot(df) +
+  aes(x = dose, y = len) +
+  geom_boxplot() +
+  geom_bracket(
+    xmin = c("0.5", "1"),
+    xmax = c("1", "2"),
+    y.position = c(30, 35),
+    label = c("***", "**"),
+    tip.length = 0.01
+  )
+

Plus d’informations : https://rpkgs.datanovia.com/ggpubr/

Diagramme en crêtes (ridges)

L’extension ggridges fournit une géométrie geom_density_ridges_gradient pour la création de diagramme en crêtes.

-
library(ggridges)
-ggplot(lincoln_weather, aes(x = `Mean Temperature [F]`, y = Month, fill = stat(x))) +
-  geom_density_ridges_gradient(scale = 3, rel_min_height = 0.01) +
-  scale_fill_viridis_c(name = "Temp. [F]", option = "C") +
-  labs(title = "Temperatures in Lincoln NE in 2016") +
-  theme_ridges()
+
library(ggridges)
+ggplot(lincoln_weather, aes(x = `Mean Temperature [F]`, y = Month, fill = stat(x))) +
+  geom_density_ridges_gradient(scale = 3, rel_min_height = 0.01) +
+  scale_fill_viridis_c(name = "Temp. [F]", option = "C") +
+  labs(title = "Temperatures in Lincoln NE in 2016") +
+  theme_ridges()
Picking joint bandwidth of 3.37
-

+

Plus d’informations : https://wilkelab.org/ggridges/

Graphique en gaufres (waffle)

L’extension waffle propose geom_waffle pour des graphiques dits en gaufres.

ATTENTION : elle s’installe avec la commande install.packages("waffle", repos = "https://cinc.rud.is").

-
library(waffle)
-xdf <- data.frame(
-  parts = factor(rep(month.abb[1:3], 3), levels = month.abb[1:3]),
-  vals = c(10, 20, 30, 6, 14, 40, 30, 20, 10),
-  fct = c(rep("Thing 1", 3), rep("Thing 2", 3), rep("Thing 3", 3))
-)
-
-ggplot(xdf) +
-  aes(fill = parts, values = vals) +
-  geom_waffle() +
-  facet_wrap(~fct) +
-  scale_fill_manual(
-    name = NULL,
-    values = c("#a40000", "#c68958", "#ae6056"),
-    labels = c("Fruit", "Sammich", "Pizza")
-  ) +
-  coord_equal() +
-  theme_minimal() +
-  theme_enhance_waffle()
-

+
library(waffle)
+xdf <- data.frame(
+  parts = factor(rep(month.abb[1:3], 3), levels = month.abb[1:3]),
+  vals = c(10, 20, 30, 6, 14, 40, 30, 20, 10),
+  fct = c(rep("Thing 1", 3), rep("Thing 2", 3), rep("Thing 3", 3))
+)
+
+ggplot(xdf) +
+  aes(fill = parts, values = vals) +
+  geom_waffle() +
+  facet_wrap(~fct) +
+  scale_fill_manual(
+    name = NULL,
+    values = c("#a40000", "#c68958", "#ae6056"),
+    labels = c("Fruit", "Sammich", "Pizza")
+  ) +
+  coord_equal() +
+  theme_minimal() +
+  theme_enhance_waffle()
+

Plus d’informations : https://github.com/hrbrmstr/waffle

Graphique en mosaïque (mosaic plot)

L’extension ggmosaic permets de réaliser des graphiques en mosaïque avec geom_mosaic.

-
library(ggmosaic)
-ggplot(data = fly) +
-  geom_mosaic(
-    aes(x = product(RudeToRecline), fill = RudeToRecline),
-    na.rm = TRUE
-  )
-

-
ggplot(data = fly) +
-  geom_mosaic(
-    aes(x = product(DoYouRecline, RudeToRecline), fill = DoYouRecline),
-    na.rm = TRUE
-  )
+
library(ggmosaic)
+data(titanic)
+
+ggplot(data = titanic) +
+  geom_mosaic(aes(x = product(Class), fill = Survived))

Plus d’informations : https://cran.r-project.org/web/packages/ggmosaic/vignettes/ggmosaic.html

Graphique de pirates : alternative aux boîtes à moustache (pirat plot)

Cette représentation alternative aux boîtes à moustache s’obtient avec la géométrie geom_pirate de l’extension ggpirate1.

-
library(ggplot2)
-library(ggpirate)
-ggplot(mpg, aes(x = class, y = cty)) +
-  geom_pirate(aes(colour = class, fill = class)) +
-  theme_bw()
+
library(ggplot2)
+library(ggpirate)
+ggplot(mpg, aes(x = class, y = cty)) +
+  geom_pirate(aes(colour = class, fill = class)) +
+  theme_bw()

Pour plus d’informations : https://github.com/mikabr/ggpirate

@@ -32523,35 +35444,83 @@

Axes, légende et facettes

Axes limités

coord_capped_cart et coord_capped_flip de l’extension lemon permet de limiter le dessin des axes au minimum et au maximum. Voir l’exemple ci-dessous.

-
library(ggplot2)
-library(lemon)
-p <- ggplot(mtcars) +
-  aes(x = cyl, y = mpg) +
-  geom_point() +
-  theme_classic() +
-  ggtitle("Axes classiques")
-pcapped <- p +
-  coord_capped_cart(bottom = "both", left = "both") +
-  ggtitle("Axes limités")
-cowplot::plot_grid(p, pcapped, nrow = 1)
+
library(ggplot2)
+library(lemon)
+p <- ggplot(mtcars) +
+  aes(x = cyl, y = mpg) +
+  geom_point() +
+  theme_classic() +
+  ggtitle("Axes classiques")
+pcapped <- p +
+  coord_capped_cart(bottom = "both", left = "both") +
+  ggtitle("Axes limités")
+cowplot::plot_grid(p, pcapped, nrow = 1)

+

Une autre possibilité est d’avoir recours à la fonction guide_axis_truncated de l’extension ggh4x.

+
library(ggh4x)
+ggplot(mtcars) +
+  aes(x = cyl, y = mpg) +
+  geom_point() +
+  theme_classic() +
+  scale_y_continuous(breaks = c(15, 20, 25, 30)) +
+  guides(
+    x = guide_axis_truncated(trunc_lower = 5, trunc_upper = 7),
+    y = guide_axis_truncated()
+  )
+

Répéter les étiquettes des axes sur des facettes

Lorsque l’on réalise des facettes, les étiquettes des axes ne sont pas répétées.

-
library(ggplot2)
-ggplot(mpg) +
-  aes(displ, cty) +
-  geom_point() +
-  facet_wrap(~cyl)
-

-

L’extension lemon propose facet_rep_grid et facet_rep_wrap qui répètent les axes sur chaque facette.

-
library(lemon)
-ggplot(mpg) +
-  aes(displ, cty) +
-  geom_point() +
-  facet_rep_wrap(~cyl, repeat.tick.labels = TRUE)
+
library(ggplot2)
+ggplot(mpg) +
+  aes(displ, cty) +
+  geom_point() +
+  facet_wrap(~cyl)

+

L’extension lemon propose facet_rep_grid et facet_rep_wrap qui répètent les axes sur chaque facette.

+
library(lemon)
+ggplot(mpg) +
+  aes(displ, cty) +
+  geom_point() +
+  facet_rep_wrap(~cyl, repeat.tick.labels = TRUE)
+

+
+
+

Encoches mineures sur les axes

+

Par défaut, des encoches (ticks) sont dessinées sur les axes uniquement pour la grille principale (major breaks). La fonction guide_axis_minor de l’extension ggh4x permet de rajouter des encoches aux points de la grille mineure (minor breaks).

+
p <- ggplot(mtcars) +
+  aes(x = cyl, y = mpg) +
+  geom_point() +
+  theme_classic()
+p
+

+
library(ggh4x)
+p +
+  scale_x_continuous(
+    minor_breaks = 16:32 / 4,
+    guide = guide_axis_minor()
+  ) +
+  # to control relative length of minor ticks
+  theme(ggh4x.axis.ticks.length.minor = rel(.8))
+

+
+
+

Relations imbriquées

+

La fonction guide_axis_nested de l’extension ggh4x permet d’afficher sur un axe des relations imbriquées.

+
library(ggh4x)
+df <- data.frame(
+  item = c("Coffee", "Tea", "Apple", "Pear", "Car"),
+  type = c("Drink", "Drink", "Fruit", "Fruit", ""),
+  amount = c(5, 1, 2, 3, 1),
+  stringsAsFactors = FALSE
+)
+
+ggplot(df) +
+  aes(x = interaction(item, type), y = amount) +
+  geom_col() +
+  guides(x = guide_axis_nested())
+

@@ -32563,26 +35532,26 @@

Graphiques complexes

Graphiques divergents

L’extension ggcharts fournit plusieurs fonctions de haut niveau pour faciliter la réalisation de graphiques divergents en barres (diverging_bar_chart), en sucettes (diverging_lollipop_chart) voire même une pyramide des âges (pyramid_chart).

-
library(ggcharts)
-data(mtcars)
-mtcars_z <- dplyr::transmute(
-  .data = mtcars,
-  model = row.names(mtcars),
-  hpz = scale(hp)
-)
-
-diverging_bar_chart(data = mtcars_z, x = model, y = hpz)
-

-
diverging_lollipop_chart(
-  data = mtcars_z,
-  x = model,
-  y = hpz,
-  lollipop_colors = c("#006400", "#b32134"),
-  text_color = c("#006400", "#b32134")
-)
-

-
data("popch")
-pyramid_chart(data = popch, x = age, y = pop, group = sex)
+
library(ggcharts)
+data(mtcars)
+mtcars_z <- dplyr::transmute(
+  .data = mtcars,
+  model = row.names(mtcars),
+  hpz = scale(hp)
+)
+
+diverging_bar_chart(data = mtcars_z, x = model, y = hpz)
+

+
diverging_lollipop_chart(
+  data = mtcars_z,
+  x = model,
+  y = hpz,
+  lollipop_colors = c("#006400", "#b32134"),
+  text_color = c("#006400", "#b32134")
+)
+

+
data("popch")
+pyramid_chart(data = popch, x = age, y = pop, group = sex)
Warning: `expand_scale()` is deprecated; use `expansion()`
 instead.
 
@@ -32594,7 +35563,7 @@ 

Graphiques divergents

Warning: `expand_scale()` is deprecated; use `expansion()` instead.
-

+

Graphiques interactifs

@@ -32604,227 +35573,53 @@

Graphiques interactifs

Graphiques animés

L’extension gganimate permets de réaliser des graphiques animés.

Voici un exemple :

-
library(ggplot2)
-library(gganimate)
-library(gapminder)
-
-ggplot(gapminder, aes(gdpPercap, lifeExp, size = pop, colour = country)) +
-  geom_point(alpha = 0.7, show.legend = FALSE) +
-  scale_colour_manual(values = country_colors) +
-  scale_size(range = c(2, 12)) +
-  scale_x_log10() +
-  facet_wrap(~continent) +
-  # Here comes the gganimate specific bits
-  labs(title = "Year: {frame_time}", x = "GDP per capita", y = "life expectancy") +
-  transition_time(year) +
-  ease_aes("linear")
-

-Rendering [------------------------] at 2.1 fps ~ eta: 47s
-Rendering [------------------------] at 1.8 fps ~ eta:  1m
-Rendering [>-----------------------] at 1.7 fps ~ eta:  1m
-Rendering [>-----------------------] at 1.8 fps ~ eta:  1m
-Rendering [>-----------------------] at 1.7 fps ~ eta:  1m
-Rendering [=>----------------------] at 1.7 fps ~ eta:  1m
-Rendering [==>---------------------] at 1.6 fps ~ eta:  1m
-Rendering [===>--------------------] at 1.6 fps ~ eta:  1m
-Rendering [====>-------------------] at 1.6 fps ~ eta:  1m
-Rendering [====>-------------------] at 1.5 fps ~ eta:  1m
-Rendering [=====>------------------] at 1.5 fps ~ eta:  1m
-Rendering [=====>------------------] at 1.5 fps ~ eta: 49s
-Rendering [=====>------------------] at 1.5 fps ~ eta: 48s
-Rendering [=====>------------------] at 1.6 fps ~ eta: 47s
-Rendering [======>-----------------] at 1.6 fps ~ eta: 46s
-Rendering [======>-----------------] at 1.6 fps ~ eta: 45s
-Rendering [======>-----------------] at 1.6 fps ~ eta: 44s
-Rendering [======>-----------------] at 1.6 fps ~ eta: 43s
-Rendering [=======>----------------] at 1.6 fps ~ eta: 42s
-Rendering [=======>----------------] at 1.6 fps ~ eta: 41s
-Rendering [=======>----------------] at 1.6 fps ~ eta: 40s
-Rendering [=======>----------------] at 1.6 fps ~ eta: 39s
-Rendering [========>---------------] at 1.7 fps ~ eta: 39s
-Rendering [========>---------------] at 1.7 fps ~ eta: 38s
-Rendering [========>---------------] at 1.6 fps ~ eta: 37s
-Rendering [=========>--------------] at 1.6 fps ~ eta: 37s
-Rendering [=========>--------------] at 1.6 fps ~ eta: 36s
-Rendering [==========>-------------] at 1.6 fps ~ eta: 36s
-Rendering [==========>-------------] at 1.6 fps ~ eta: 35s
-Rendering [==========>-------------] at 1.6 fps ~ eta: 34s
-Rendering [===========>------------] at 1.5 fps ~ eta: 34s
-Rendering [===========>------------] at 1.5 fps ~ eta: 33s
-Rendering [===========>------------] at 1.5 fps ~ eta: 32s
-Rendering [===========>------------] at 1.5 fps ~ eta: 31s
-Rendering [============>-----------] at 1.5 fps ~ eta: 30s
-Rendering [============>-----------] at 1.6 fps ~ eta: 30s
-Rendering [============>-----------] at 1.6 fps ~ eta: 29s
-Rendering [============>-----------] at 1.6 fps ~ eta: 28s
-Rendering [=============>----------] at 1.6 fps ~ eta: 28s
-Rendering [=============>----------] at 1.6 fps ~ eta: 27s
-Rendering [=============>----------] at 1.6 fps ~ eta: 26s
-Rendering [==============>---------] at 1.6 fps ~ eta: 25s
-Rendering [==============>---------] at 1.6 fps ~ eta: 24s
-Rendering [==============>---------] at 1.6 fps ~ eta: 23s
-Rendering [===============>--------] at 1.6 fps ~ eta: 22s
-Rendering [===============>--------] at 1.6 fps ~ eta: 21s
-Rendering [===============>--------] at 1.6 fps ~ eta: 20s
-Rendering [================>-------] at 1.6 fps ~ eta: 19s
-Rendering [================>-------] at 1.6 fps ~ eta: 18s
-Rendering [================>-------] at 1.6 fps ~ eta: 17s
-Rendering [=================>------] at 1.6 fps ~ eta: 16s
-Rendering [=================>------] at 1.7 fps ~ eta: 16s
-Rendering [=================>------] at 1.7 fps ~ eta: 15s
-Rendering [=================>------] at 1.7 fps ~ eta: 14s
-Rendering [==================>-----] at 1.7 fps ~ eta: 13s
-Rendering [==================>-----] at 1.7 fps ~ eta: 12s
-Rendering [==================>-----] at 1.7 fps ~ eta: 11s
-Rendering [===================>----] at 1.7 fps ~ eta: 11s
-Rendering [===================>----] at 1.7 fps ~ eta: 10s
-Rendering [===================>----] at 1.7 fps ~ eta:  9s
-Rendering [====================>---] at 1.7 fps ~ eta:  8s
-Rendering [====================>---] at 1.7 fps ~ eta:  7s
-Rendering [====================>---] at 1.7 fps ~ eta:  6s
-Rendering [=====================>--] at 1.7 fps ~ eta:  6s
-Rendering [=====================>--] at 1.7 fps ~ eta:  5s
-Rendering [=====================>--] at 1.7 fps ~ eta:  4s
-Rendering [======================>-] at 1.7 fps ~ eta:  3s
-Rendering [======================>-] at 1.7 fps ~ eta:  2s
-Rendering [=======================>] at 1.8 fps ~ eta:  1s
-Rendering [========================] at 1.8 fps ~ eta:  0s
-                                                          
-

-Frame 1 (1%)
-Frame 2 (2%)
-Frame 3 (3%)
-Frame 4 (4%)
-Frame 5 (5%)
-Frame 6 (6%)
-Frame 7 (7%)
-Frame 8 (8%)
-Frame 9 (9%)
-Frame 10 (10%)
-Frame 11 (11%)
-Frame 12 (12%)
-Frame 13 (13%)
-Frame 14 (14%)
-Frame 15 (15%)
-Frame 16 (16%)
-Frame 17 (17%)
-Frame 18 (18%)
-Frame 19 (19%)
-Frame 20 (20%)
-Frame 21 (21%)
-Frame 22 (22%)
-Frame 23 (23%)
-Frame 24 (24%)
-Frame 25 (25%)
-Frame 26 (26%)
-Frame 27 (27%)
-Frame 28 (28%)
-Frame 29 (29%)
-Frame 30 (30%)
-Frame 31 (31%)
-Frame 32 (32%)
-Frame 33 (33%)
-Frame 34 (34%)
-Frame 35 (35%)
-Frame 36 (36%)
-Frame 37 (37%)
-Frame 38 (38%)
-Frame 39 (39%)
-Frame 40 (40%)
-Frame 41 (41%)
-Frame 42 (42%)
-Frame 43 (43%)
-Frame 44 (44%)
-Frame 45 (45%)
-Frame 46 (46%)
-Frame 47 (47%)
-Frame 48 (48%)
-Frame 49 (49%)
-Frame 50 (50%)
-Frame 51 (51%)
-Frame 52 (52%)
-Frame 53 (53%)
-Frame 54 (54%)
-Frame 55 (55%)
-Frame 56 (56%)
-Frame 57 (57%)
-Frame 58 (58%)
-Frame 59 (59%)
-Frame 60 (60%)
-Frame 61 (61%)
-Frame 62 (62%)
-Frame 63 (63%)
-Frame 64 (64%)
-Frame 65 (65%)
-Frame 66 (66%)
-Frame 67 (67%)
-Frame 68 (68%)
-Frame 69 (69%)
-Frame 70 (70%)
-Frame 71 (71%)
-Frame 72 (72%)
-Frame 73 (73%)
-Frame 74 (74%)
-Frame 75 (75%)
-Frame 76 (76%)
-Frame 77 (77%)
-Frame 78 (78%)
-Frame 79 (79%)
-Frame 80 (80%)
-Frame 81 (81%)
-Frame 82 (82%)
-Frame 83 (83%)
-Frame 84 (84%)
-Frame 85 (85%)
-Frame 86 (86%)
-Frame 87 (87%)
-Frame 88 (88%)
-Frame 89 (89%)
-Frame 90 (90%)
-Frame 91 (91%)
-Frame 92 (92%)
-Frame 93 (93%)
-Frame 94 (94%)
-Frame 95 (95%)
-Frame 96 (96%)
-Frame 97 (97%)
-Frame 98 (98%)
-Frame 99 (99%)
-Frame 100 (100%)
-Finalizing encoding... done!
-

+
library(ggplot2)
+library(gganimate)
+library(gapminder)
+
+ggplot(gapminder, aes(gdpPercap, lifeExp, size = pop, colour = country)) +
+  geom_point(alpha = 0.7, show.legend = FALSE) +
+  scale_colour_manual(values = country_colors) +
+  scale_size(range = c(2, 12)) +
+  scale_x_log10() +
+  facet_wrap(~continent) +
+  # Here comes the gganimate specific bits
+  labs(title = "Year: {frame_time}", x = "GDP per capita", y = "life expectancy") +
+  transition_time(year) +
+  ease_aes("linear")
+

Voir le site de l’extension (https://gganimate.com/) pour la documentation et des tutoriels. Il est conseillé d’installer également l’extension gifski avec gganimate.

Surligner certaines données

L’extension gghighlight fournit une fonction gghiglight qui permets de surligner les données qui remplissent des conditions spécifiées.

-
d <- purrr::map_dfr(
-  letters,
-  ~ data.frame(
-    idx = 1:400,
-    value = cumsum(runif(400, -1, 1)),
-    type = .,
-    flag = sample(c(TRUE, FALSE), size = 400, replace = TRUE),
-    stringsAsFactors = FALSE
-  )
-)
-
-ggplot(d) +
-  aes(x = idx, y = value, colour = type) +
-  geom_line()
-

-
library(gghighlight)
-ggplot(d) +
-  aes(x = idx, y = value, colour = type) +
-  geom_line() +
-  gghighlight(max(value) > 20)
+
d <- purrr::map_dfr(
+  letters,
+  ~ data.frame(
+    idx = 1:400,
+    value = cumsum(runif(400, -1, 1)),
+    type = .,
+    flag = sample(c(TRUE, FALSE), size = 400, replace = TRUE),
+    stringsAsFactors = FALSE
+  )
+)
+
+ggplot(d) +
+  aes(x = idx, y = value, colour = type) +
+  geom_line()
+

+
library(gghighlight)
+ggplot(d) +
+  aes(x = idx, y = value, colour = type) +
+  geom_line() +
+  gghighlight(max(value) > 20)
label_key: type
-

-
ggplot(iris, aes(Sepal.Length, fill = Species)) +
-  geom_histogram() +
-  gghighlight() +
-  facet_wrap(~Species)
-

+

+
ggplot(iris, aes(Sepal.Length, fill = Species)) +
+  geom_histogram() +
+  gghighlight() +
+  facet_wrap(~Species)
+

@@ -32836,39 +35631,39 @@

Palettes de couleurs

hrbrthemes

L’extension hrbrthemes fournit plusieurs thèmes graphiques pour ggplot2. Un exemple ci-dessous. Pour plus d’informations, voir https://github.com/hrbrmstr/hrbrthemes.

-
library(ggplot2)
-library(hrbrthemes)
-ggplot(mtcars, aes(mpg, wt)) +
-  geom_point(aes(color = factor(carb))) +
-  labs(
-    x = "Fuel efficiency (mpg)", y = "Weight (tons)",
-    title = "Seminal ggplot2 scatterplot example",
-    subtitle = "A plot that is only useful for demonstration purposes",
-    caption = "Brought to you by the letter 'g'"
-  ) +
-  scale_color_ipsum() +
-  theme_ipsum_rc()
-

+
library(ggplot2)
+library(hrbrthemes)
+ggplot(mtcars, aes(mpg, wt)) +
+  geom_point(aes(color = factor(carb))) +
+  labs(
+    x = "Fuel efficiency (mpg)", y = "Weight (tons)",
+    title = "Seminal ggplot2 scatterplot example",
+    subtitle = "A plot that is only useful for demonstration purposes",
+    caption = "Brought to you by the letter 'g'"
+  ) +
+  scale_color_ipsum() +
+  theme_ipsum_rc()
+

ggthemes

ggthemes propose une vingtaine de thèmes différentes présentés sur le site de l’extension : https://jrnold.github.io/ggthemes/.

Voir ci-dessous un exemple du thème theme_tufte inspiré d’Edward Tufte.

-
library(ggplot2)
-library(ggthemes)
-
-p <- ggplot(mtcars, aes(x = wt, y = mpg)) +
-  geom_point() +
-  scale_x_continuous(breaks = extended_range_breaks()(mtcars$wt)) +
-  scale_y_continuous(breaks = extended_range_breaks()(mtcars$mpg)) +
-  ggtitle("Cars")
-
-p + geom_rangeframe() +
-  theme_tufte()
-

-
p + geom_rug() +
-  theme_tufte(ticks = FALSE)
-

+
library(ggplot2)
+library(ggthemes)
+
+p <- ggplot(mtcars, aes(x = wt, y = mpg)) +
+  geom_point() +
+  scale_x_continuous(breaks = extended_range_breaks()(mtcars$wt)) +
+  scale_y_continuous(breaks = extended_range_breaks()(mtcars$mpg)) +
+  ggtitle("Cars")
+
+p + geom_rangeframe() +
+  theme_tufte()
+

+
p + geom_rug() +
+  theme_tufte(ticks = FALSE)
+

@@ -32883,7 +35678,7 @@

Combiner plusieurs graphiques

-
+
@@ -32900,6 +35695,9 @@

Combiner plusieurs graphiques

+
+

Ce chapitre est évoqué dans le webin-R #14 (exemples de graphiques avancés - 2) sur YouTube.

+

Vous savez réaliser des graphiques avec ggplot2 ? Il est très facile de combiner plusieurs graphiques en un seul.

Commençons par créer quelques graphiques avec ggplot2.

library(ggplot2)
@@ -33007,7 +35805,7 @@ 

Légende partagée entre plusieurs graphiques

-
+
-
-

Ce chapitre est en cours de rédaction.

+
+

Ce chapitre est évoqué dans le webin-R #13 (exemples de graphiques avancés) sur YouTube.

+

Ce chapitre est évoqué dans le webin-R #14 (exemples de graphiques avancés - 2) sur YouTube.

Dans ce chapitre, nous présentons plusieurs graphiques avec une mise en forme avancée et détaillons pas à pas leur création.

Chargeons quelques extensions de base.

@@ -33555,9 +36362,302 @@

Code final du graphique

+
+

Évolutions temporelles

+

Pour cet exemple, nous allons utiliser des données fictives. Dans les années 1950, au sortir de la guerre, la Syldavie et la Bordurie (deux pays fictifs inventés par Hergé) ont décidé de mettre un programme de distribution de bandes dessinées de Tintin dans des écoles et des collèges afin de motiver les élèves à lire plus. Nous disposons des rapports d’activités des différents agents du programme qui indident, par mois et par type d’établissement, le nombre d’élèves rencontrés et le nombre de bandes dessinées distribués.

+

Commençons par importer les données, qui sont au format Excel. Nous utiliserons donc la fonction read_excel de l’extension readxl. Profitons-en pour charger également en mémoire le tidyverse ainsi que l’extension lubridate qui nous servira pour la gestion des dates.

+
library(readxl)
+library(tidyverse)
+library(lubridate)
+url <- "https://larmarange.github.io/analyse-R/data/bandes_dessinees_tintin.xlsx"
+destfile <- "bandes_dessinees_tintin.xlsx"
+curl::curl_download(url, destfile)
+bd <- read_excel(destfile)
+
glimpse(bd)
+
Rows: 4,331
+Columns: 6
+$ annee              <dbl> 1950, 1950, 1951, 1951, 1951, 1~
+$ mois               <dbl> 9, 10, 4, 2, 4, 5, 5, 3, 2, 5, ~
+$ pays               <chr> "Bordurie", "Bordurie", "Bordur~
+$ type_etablissement <chr> "école primaire", "école primai~
+$ eleves_rencontres  <dbl> 2, 3, 6, 16, 1, 5, 6, 3, 5, 3, ~
+$ bd_distribuees     <dbl> 3, 3, 6, 16, 1, 5, 12, 4, 6, 5,~
+
+

Bandes dessinées distribuées par mois

+

En premier lieu, nous souhaiterions représenter le nombre de bandes dessinées distribuées par mois. Comme on peut le voir, nous n’avons pas directement une variable date, l’année et le mois étant indiqués dans deux variables différentes. Nous allons donc commencer par créer une telle variable, qui correspondra au premier jour du mois.

+

Nous allons utiliser la fonction paste0 qui permets de concaténer du texte pour créer des chaines de texte au format ANNEE-MOIS-JOUR puis transformer cela en objet Date avec ymd de l’extension lubridate.

+
bd$date <- paste0(bd$annee, "-", bd$mois, "-01") %>% ymd()
+summary(bd$date)
+
        Min.      1st Qu.       Median         Mean 
+"1949-12-01" "1950-07-01" "1950-12-01" "1950-11-13" 
+     3rd Qu.         Max. 
+"1951-04-01" "1951-07-01" 
+

Nous pouvons maintenant commencer à réaliser notre graphique. Nous allons compter le nombre de BD distribuées par mois et représenter cela sous forme d’un graphique en barres. geom_bar utilise la statistique stat_count pour compter le nombre d’observations. Cependant, le nombre de BD distribuées varie d’une ligne du fichier à l’autre. Nous allons donc utiliser l’esthétique weight pour pondérer le calcul et obtenir le total de bandes dessinées distribuées. Nous allons également utiliser l’esthétique fill pour distinguer les écoles primaires et les collèges.

+
p <- ggplot(bd) +
+  aes(x = date, weight = bd_distribuees, fill = type_etablissement) +
+  geom_bar()
+p
+

+

Avec facet_grid nous pouvons comparer la Syldavie et la Bordurie.

+
p + facet_grid(cols = vars(pays))
+

+

Essayons de faire un peu mieux en répétant l’axe des y sur le graphique de droite, ce qui peut être fait avec la fonction facet_rep_grid de l’extension lemon.

+
library(lemon, quietly = TRUE)
+p + facet_rep_grid(cols = vars(pays))
+

+

Cela a répété les encoches (ticks). Pour répéter également les étiquettes, il nous faut ajouter l’option repeat.tick.labels = TRUE.

+
p <- p + facet_rep_grid(cols = vars(pays), repeat.tick.labels = TRUE)
+p
+

+

Allégeons un peu le graphique (voir exemple précédent). Pour cela, nous allons utiliser le thème theme_clean fourni par ggthemes.

+
library(ggthemes)
+p <- p +
+  xlab("") + ylab("") + labs(fill = "") +
+  ggtitle("Bandes dessinées distribuées par mois") +
+  theme_clean() +
+  theme(
+    legend.position = "bottom"
+  )
+p
+

+

De même, nous allons utiliser une palette de couleurs adaptées aux personnes daltoniennes, en s’appuyant sur scale_fill_bright disponible avec khroma.

+
library(khroma)
+p <- p + scale_fill_bright()
+p
+

+

Reste à améliorer la présentation de l’axe des x avec scale_x_date{data-pkg="ggplot2}. L’option date_labels permet de personnaliser l’affichage des dates via des raccourcis décrits dans l’aide de la fonction strptime. Ainsi, %b correspond au mois écrit textuellement de manière abrégée et %Y à l’année sur 4 chiffres. \n est utilisé pour indiquer un retour à la ligne. L’option date_breaks permet d’indiquer de manière facilitée la durée attendue entre deux étiquettes, ici trois mois.

+
p <- p + scale_x_date(
+  date_labels = "%b\n%Y",
+  date_breaks = "3 months"
+)
+p
+

+

Pour améliorer le graphique, nous aimerions rajouter une encoche sous chaque mois. Ceci est rendu possible avec la fonction guide_axis_minor de ggh4x.

+
library(ggh4x)
+p <- p + scale_x_date(
+  date_labels = "%b\n%Y",
+  date_breaks = "3 months",
+  date_minor_breaks = "1 month",
+  guide = guide_axis_minor()
+)
+
Scale for 'x' is already present. Adding another scale
+for 'x', which will replace the existing scale.
+
p
+

+

Le code complet de ce graphique est donc :

+
library(ggthemes)
+library(khroma)
+library(ggh4x)
+library(lemon)
+ggplot(bd) +
+  aes(x = date, weight = bd_distribuees, fill = type_etablissement) +
+  geom_bar() +
+  facet_rep_grid(cols = vars(pays), repeat.tick.labels = TRUE) +
+  xlab("") +
+  ylab("") +
+  labs(fill = "") +
+  ggtitle("Bandes dessinées distribuées par mois") +
+  scale_x_date(
+    date_labels = "%b\n%Y",
+    date_breaks = "3 months",
+    date_minor_breaks = "1 month",
+    guide = guide_axis_minor()
+  ) +
+  scale_fill_bright() +
+  theme_clean() +
+  theme(
+    legend.position = "bottom"
+  )
+

+
+
+

Évolution du nombre moyen de bandes dessinées remises par élève

+

Nous disposons dans les rapports d’activités du nombre de bandes dessinées distribuées et du nombre d’élèves rencontrés. Nous pouvons donc regarder comment à évaluer au cours du temps le nombre moyen de bandes dessinées distribuées par élève, à savoir l’évolution du ratio bd_distribuees / eleves_rencontres.

+
ggplot(bd) +
+  aes(x = date, y = bd_distribuees / eleves_rencontres, colour = type_etablissement) +
+  geom_point()
+

+

Comme on le voit sur la figure précédente, si l’on représente directement cet indicateur, nous obtenons plusieurs points pour chaque date. En effet, nous avons plusieurs observations par date et nous obtenons donc un point pour chacune de ces observations. Nous souhaiterions avoir la moyenne pour chaque date. Cela est possible en ayant recours à stat_weighted_mean de l’extension GGally. Pour que le calcul soit correct, il faut réaliser une moyenne pondérée par le dénominateur, à savoir ici le nombre d’élèves.

+
library(GGally)
+ggplot(bd) +
+  aes(
+    x = date, y = bd_distribuees / eleves_rencontres,
+    weight = eleves_rencontres, colour = type_etablissement
+  ) +
+  geom_point(stat = "weighted_mean")
+

+

Le graphique sera plus lisible si nous représentons des lignes.

+
library(GGally)
+ggplot(bd) +
+  aes(
+    x = date, y = bd_distribuees / eleves_rencontres,
+    weight = eleves_rencontres, colour = type_etablissement
+  ) +
+  geom_line(stat = "weighted_mean")
+

+

Pour améliorer la comparaison, il serait pertinent d’ajouter les intervalles de confiance sur le graphique. Cela peut être réalisé par exemple avec des rubans de couleur. Mais pour cela, il va falloir avoir recours à quelques astuces pour permettre le calcul de ces intervalles de confiance à la volée.

+

Tout d’abord, pour calculer l’intervalle de confiance d’un ratio de nombres entiers, nous pouvons utiliser un test de Poisson avec poisson.test auquel nous devons transmettre le numérateur et le dénominateur. Par exemple, pour 48 bandes dessinées distribuées à 27 élèves :

+
test <- poisson.test(48, 27)
+test
+

+    Exact Poisson test
+
+data:  48 time base: 27
+number of events = 48, time base = 27, p-value =
+0.0002246
+alternative hypothesis: true event rate is not equal to 1
+95 percent confidence interval:
+ 1.310793 2.357075
+sample estimates:
+event rate 
+  1.777778 
+
str(test)
+
List of 9
+ $ statistic  : Named num 48
+  ..- attr(*, "names")= chr "number of events"
+ $ parameter  : Named num 27
+  ..- attr(*, "names")= chr "time base"
+ $ p.value    : num 0.000225
+ $ conf.int   : num [1:2] 1.31 2.36
+  ..- attr(*, "conf.level")= num 0.95
+ $ estimate   : Named num 1.78
+  ..- attr(*, "names")= chr "event rate"
+ $ null.value : Named num 1
+  ..- attr(*, "names")= chr "event rate"
+ $ alternative: chr "two.sided"
+ $ method     : chr "Exact Poisson test"
+ $ data.name  : chr "48 time base: 27"
+ - attr(*, "class")= chr "htest"
+

Comme nous le montre str, poisson.test renvoie une liste avec différents éléments et l’intervalle de confiance est disponible dans le sous-objet "conf.int". Il est possible d’y accéder avec l’opérateur $ ou bien avec la fonction pluck de l’extension purrr chargée par défaut avec le tidyverse.

+
test$conf.int
+
[1] 1.310793 2.357075
+attr(,"conf.level")
+[1] 0.95
+
test %>% pluck("conf.int")
+
[1] 1.310793 2.357075
+attr(,"conf.level")
+[1] 0.95
+

Pour obtenir la borne inférieure de l’intervalle de confiance, il nous faut maintenant extraire le premier élément.

+
test$conf.int[1]
+
[1] 1.310793
+
test %>% pluck("conf.int", 1)
+
[1] 1.310793
+

Nous avons trouvé la manière de calculer la borne inférieure de l’intervalle de confiance pour une ligne d’observations. Mais comment procéder pour plusieurs observations. Supposons que nous ayons 4 observations :

+
num <- c(50, 25, 32, 48)
+denom <- c(25, 17, 25, 31)
+

Si nous passons ces vecteurs de données à poisson.test, nous obtenons un message d’erreur car poisson.test ne permets de calculer qu’un seul test à la fois.

+
poisson.test(num, denom)
+
Error in poisson.test(num, denom) : le cas k > 2 n'est pas implémenté
+

Dans notre cas, nous souhaitons exécuter poisson.test ligne à ligne. Cela peut être réalisée avec la famille de fonctions map fournies par l’extension purrr. Plus précisément, dans notre situation, nous allons avoir recours à map2 qui permet de fournir deux vecteurs en entrée et d’appliquer une fonction ligne à ligne. On passera à map2 soit une fonction à utiliser telle quelle ou bien une formule décrivant une fonction personnalisée à la levée, ce que nous allons faire. Dans cette formule décrivant le calcul à effectuer, on utilisera .x pour se référer à l’élément du premier vecteur et à .y pour se référer au deuxième vecteur.

+
map2(num, denom, ~ poisson.test(.x, .y) %>% pluck("conf.int", 1))
+
[[1]]
+[1] 1.484439
+
+[[2]]
+[1] 0.9516872
+
+[[3]]
+[1] 0.8755191
+
+[[4]]
+[1] 1.141658
+

Le résultat obtenu est une liste de 4 éléments, chaque élément contenu la borne inférieur des intervalles. Nous préférerions que la fonction nous retourne un vecteur de valeurs numériques (double) plutôt qu’une liste. Nous allons donc utiliser map2_dbl plutôt que map2.

+
map2_dbl(num, denom, ~ poisson.test(.x, .y) %>% pluck("conf.int", 1))
+
[1] 1.4844385 0.9516872 0.8755191 1.1416584
+

Nous y sommes presque. Il nous reste plus qu’à avoir recours à after_stat pour avoir accès aux numérateurs et dénominateurs calculés par stat_weighted_mean.

+
ggplot(bd) +
+  aes(
+    x = date, y = bd_distribuees / eleves_rencontres, weight = eleves_rencontres,
+    ymin = map2_dbl(after_stat(numerator), after_stat(denominator), ~ poisson.test(.x, .y) %>% pluck("conf.int", 1)),
+    ymax = map2_dbl(after_stat(numerator), after_stat(denominator), ~ poisson.test(.x, .y) %>% pluck("conf.int", 2)),
+    colour = type_etablissement, fill = type_etablissement
+  ) +
+  geom_ribbon(stat = "weighted_mean", alpha = .5) +
+  geom_line(stat = "weighted_mean")
+

+

Faisons quelques ajustements pour une meilleur lisibilité : effaçons les limites supérieures et inférieures des rubans avec color = "transparent", augmentons la transparence des rubans avec alpha = .2 et épaississons les courbes principales avec size = 1.

+
p <- ggplot(bd) +
+  aes(
+    x = date, y = bd_distribuees / eleves_rencontres, weight = eleves_rencontres,
+    ymin = map2_dbl(after_stat(numerator), after_stat(denominator), ~ poisson.test(.x, .y) %>% pluck("conf.int", 1)),
+    ymax = map2_dbl(after_stat(numerator), after_stat(denominator), ~ poisson.test(.x, .y) %>% pluck("conf.int", 2)),
+    colour = type_etablissement, fill = type_etablissement
+  ) +
+  geom_ribbon(stat = "weighted_mean", alpha = .25, color = "transparent") +
+  geom_line(stat = "weighted_mean", size = 1)
+p
+

+

Comme tous les calculs sont réalisés à la volée, il est possible de définir simplement et rapidement des facettes pour séparer les résultats par pays.

+
p <- p + facet_rep_grid(cols = vars(pays), repeat.tick.labels = TRUE)
+p
+

+

Faisons un peu d’habillage :

+
p <- p +
+  xlab("") + ylab("") + labs(fill = "", colour = "") +
+  ggtitle(
+    "Nombre moyen de bandes dessinées distribuées par élève",
+    subtitle = "par mois, type d'établissement et pays"
+  ) +
+  scale_x_date(
+    date_labels = "%b\n%Y",
+    date_breaks = "3 months",
+    date_minor_breaks = "1 month",
+    guide = guide_axis_minor()
+  ) +
+  scale_fill_bright() +
+  scale_colour_bright() +
+  theme_clean() +
+  theme(
+    legend.position = "bottom"
+  )
+p
+

+

Voilà !

+

Le code final de notre graphique est donc :

+
library(ggthemes)
+library(khroma)
+library(ggh4x)
+library(GGally)
+library(lemon)
+ggplot(bd) +
+  aes(
+    x = date, y = bd_distribuees / eleves_rencontres, weight = eleves_rencontres,
+    ymin = map2_dbl(after_stat(numerator), after_stat(denominator), ~ poisson.test(.x, .y) %>% pluck("conf.int", 1)),
+    ymax = map2_dbl(after_stat(numerator), after_stat(denominator), ~ poisson.test(.x, .y) %>% pluck("conf.int", 2)),
+    colour = type_etablissement, fill = type_etablissement
+  ) +
+  geom_ribbon(stat = "weighted_mean", alpha = .25, color = "transparent") +
+  geom_line(stat = "weighted_mean", size = 1) +
+  facet_rep_grid(cols = vars(pays), repeat.tick.labels = TRUE) +
+  xlab("") +
+  ylab("") +
+  labs(fill = "", colour = "") +
+  ggtitle(
+    "Nombre moyen de bandes dessinées distribuées par élève",
+    subtitle = "par mois, type d'établissement et pays"
+  ) +
+  scale_x_date(
+    date_labels = "%b\n%Y",
+    date_breaks = "3 months",
+    date_minor_breaks = "1 month",
+    guide = guide_axis_minor()
+  ) +
+  scale_fill_bright() +
+  scale_colour_bright() +
+  theme_clean() +
+  theme(
+    legend.position = "bottom"
+  )
+

+
+
+
+

Pour aller plus loin

+

On pourra jeter un œil au chapitre Étendre ggplot2.

+
-
+
@@ -33615,7 +36715,7 @@

ggvis

-
+
@@ -33807,7 +36907,7 @@

Diagramme de dispersion

-
+ -
+
@@ -34236,7 +37336,7 @@

highcharter

-
+
@@ -34340,7 +37440,7 @@

Conditions et comparaisons

logical 1101 899
-
+
@@ -35203,7 +38303,7 @@

Pour aller plus loin

-
+
@@ -35411,7 +38511,7 @@

Barre de progression

-
+
@@ -36527,7 +39627,7 @@

La fonction Vectorize

-
+
@@ -36542,7 +39642,7 @@

Expressions régulières

Pour des besoins plus pointus, on pourra aussi utiliser l’extension stringi sur laquelle est elle-même basée stringr.

-
+
@@ -38608,7 +41708,7 @@

Ressources

-
+
@@ -38620,10 +41720,13 @@

Mettre en forme des nombres

Ce chapitre est en cours d’écriture.

+
+

Ce chapitre est évoqué dans le webin-R #09 (Graphiques uni- et bivariés avec ggplot2) sur YouTube.

+

Le plus simple est d’avoir recours à l’extension scales et aux fonctions number, comma, percent, unit, ordinal et pvalue.

-
+
@@ -38651,6 +41754,10 @@

Couleurs et Palettes

+
+

Ce chapitre est évoqué dans le webin-R #08 (ggplot2 et la grammaires des graphiques) sur YouTube.

+

Ce chapitre est évoqué dans le webin-R #13 (exemples de graphiques avancés) sur YouTube.

+

Noms de couleur

Lorsque l’on doit indiquer à R une couleur, notamment dans les fonctions graphiques, on peut mentionner certaines couleurs en toutes lettres (en anglais) comme "red" ou "blue". La liste des couleurs reconnues par R est disponible sur http://www.stat.columbia.edu/~tzheng/files/Rcolor.pdf.

@@ -43367,7 +46474,7 @@

paletteer

-
+
@@ -43424,7 +46531,7 @@

Syntaxe de plotmath

-
+
@@ -43580,7 +46687,7 @@

Notes

-
+ -
+
@@ -43727,15 +46834,18 @@

aléatoire, effet

analyse de séquences

analyse de survie

analyse des biographies

-
+
@@ -45735,6 +48888,9 @@

Index des fonctions

  • Y
  • +
  • +Z +
  • % @@ -45756,7 +48912,6 @@

    A2Rplot (JLutils)

    aaply (plyr)

    -
    +
    @@ -48799,6 +52219,7 @@

  • Conditions et comparaisons
  • Définir un plan d’échantillonnage complexe
  • Données pondérées
  • +
  • Exemples de graphiques avancés
  • Export de données
  • Extensions (installation, mise à jour)
  • Facteurs et vecteurs labellisés
  • @@ -48824,6 +52245,7 @@

  • Statistique univariée
  • Structures conditionnelles
  • Trajectoires de soins : un exemple de données longitudinales
  • +
  • Trajectoires de soins : un exemple de données longitudinales avec data.table
  • Tris
  • Vecteurs, indexation et assignation
  • Vectorisation
  • @@ -48878,6 +52300,10 @@

  • Combiner plusieurs graphiques
  • Régression logistique binaire, multinomiale et ordinale
  • +

    coxme

    +

    D

    @@ -48891,6 +52317,7 @@

  • Réorganiser ses données avec tidyr
  • Sous-ensembles
  • Trajectoires de soins : un exemple de données longitudinales
  • +
  • Trajectoires de soins : un exemple de données longitudinales avec data.table
  • Tris
  • Vectorisation
  • @@ -48920,7 +52347,6 @@

    devtools