TP2 Analyse de données (avec tidyverse)
Arthur Leroy
24 novembre, 2020
Avant propos
Dans le précédent document, nous avons introduit des outils utiles pour nettoyer une base de données, et visualiser directement une ou plusieurs de ses variables d'interêt. A présent, il est possible de faire usage de méthodes plus élaborées d'analyses de données, faisant appel à des notions d'algèbre linéaire, comme l'anayse en composante principale (ACP) ou l'analyse factorielle des correspondances (AFC). En termes pratiques, le package FactoMineR fournit un ensemble très complet d'implémentations de ces méthodes et d'autres.
Exercice 4
Dans cet exercice, nous utilisons une base de données classique, nommée swiss, présente par défaut dans la version de base de R. Bien qu'il soit possible de l'utiliser telle quelle, on remarque que ce dataframe n'est pas au format tidy tel que définit dans le tidyverse : https://cran.r-project.org/web/packages/tidyr/vignettes/tidy-data.html . En effet, chaque ligne a un nom, et celui-ci devrait constituer plutôt une colonne du tableau. Ainsi, comme précédemment introduit, nous allons importer la base de données brute, puis créer une copie que l'on va mettre sous une forme correcte.
library(tidyverse)
library(gridExtra)
library(FactoMineR)
raw_db = swiss
db = raw_db %>% rownames_to_column(var = 'Province') %>% as_tibble
db## # A tibble: 47 x 7
## Province Fertility Agriculture Examination Education Catholic
## <chr> <dbl> <dbl> <int> <int> <dbl>
## 1 Courtel~ 80.2 17 15 12 9.96
## 2 Delemont 83.1 45.1 6 9 84.8
## 3 Franche~ 92.5 39.7 5 5 93.4
## 4 Moutier 85.8 36.5 12 7 33.8
## 5 Neuvevi~ 76.9 43.5 17 15 5.16
## 6 Porrent~ 76.1 35.3 9 7 90.6
## 7 Broye 83.8 70.2 16 7 92.8
## 8 Glane 92.4 67.8 14 8 97.2
## 9 Gruyere 82.4 53.3 12 7 97.7
## 10 Sarine 82.9 45.2 16 13 91.4
## # ... with 37 more rows, and 1 more variable: Infant.Mortality <dbl>Pour nous familiariser avec les données, nous pouvons utiliser quelques indicateurs et graphs descriptifs dans un premier temps.
summary(db)## Province Fertility Agriculture Examination
## Length:47 Min. :35.00 Min. : 1.20 Min. : 3.00
## Class :character 1st Qu.:64.70 1st Qu.:35.90 1st Qu.:12.00
## Mode :character Median :70.40 Median :54.10 Median :16.00
## Mean :70.14 Mean :50.66 Mean :16.49
## 3rd Qu.:78.45 3rd Qu.:67.65 3rd Qu.:22.00
## Max. :92.50 Max. :89.70 Max. :37.00
## Education Catholic Infant.Mortality
## Min. : 1.00 Min. : 2.150 Min. :10.80
## 1st Qu.: 6.00 1st Qu.: 5.195 1st Qu.:18.15
## Median : 8.00 Median : 15.140 Median :20.00
## Mean :10.98 Mean : 41.144 Mean :19.94
## 3rd Qu.:12.00 3rd Qu.: 93.125 3rd Qu.:21.70
## Max. :53.00 Max. :100.000 Max. :26.60gg1 = ggplot(db) + geom_boxplot(aes(y = Fertility))
gg2 = ggplot(db) + geom_boxplot(aes(y = Agriculture))
gg3 = ggplot(db) + geom_boxplot(aes(y = Examination))
gg4 = ggplot(db) + geom_boxplot(aes(y = Education))
gg5 = ggplot(db) + geom_boxplot(aes(y = Catholic))
gg6 = ggplot(db) + geom_boxplot(aes(y = Infant.Mortality))
grid.arrange(gg1, gg2, gg3, gg4, gg5, gg6, ncol = 3, nrow = 2)
Lorsque nous souhaitons afficher comme ceci le même type de graph pour un grand nombre de variable, il peut être plus pratique d'utiliser la fonction gather() du tidyverse. Cette fonction regroupe toutes les variables en un tibble avec seulement deux colonnes key et value, qui associé à l'argument facet_wrap, permet l'affichage de multiples graphs.
db %>% select_if(is.numeric) %>%
gather() %>%
ggplot(aes(x = value)) + facet_wrap(~ key) + geom_histogram() 
Utilisons maintenant la fonction PCA() du package FactoMineR pour réaliser une analyse en composantes principales. Nous choisissons un nombre de composantes égal à 6 (le nombre de variables est le maximum). Par défaut, la fonction affiche la projection des individus et des variables dans le plan factoriel défini par les deux premières composantes.
swiss.acp = PCA(swiss, ncp = 6)
summary(swiss.acp)##
## Call:
## PCA(X = swiss, ncp = 6)
##
##
## Eigenvalues
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5 Dim.6
## Variance 3.200 1.188 0.848 0.439 0.205 0.121
## % of var. 53.329 19.805 14.127 7.315 3.409 2.014
## Cumulative % of var. 53.329 73.134 87.261 94.577 97.986 100.000
##
## Individuals (the 10 first)
## Dist Dim.1 ctr cos2 Dim.2 ctr cos2
## Courtelary | 2.034 | -0.364 0.088 0.032 | 1.399 3.506 0.473 |
## Delemont | 2.169 | 1.634 1.776 0.568 | 1.026 1.885 0.224 |
## Franches-Mnt | 2.764 | 2.104 2.944 0.580 | 0.746 0.997 0.073 |
## Moutier | 1.596 | 0.748 0.372 0.219 | 0.596 0.636 0.139 |
## Neuveville | 1.182 | -0.382 0.097 0.104 | 0.449 0.361 0.144 |
## Porrentruy | 2.924 | 1.369 1.247 0.219 | 2.292 9.405 0.614 |
## Broye | 2.310 | 1.724 1.977 0.557 | 1.128 2.277 0.238 |
## Glane | 2.971 | 2.183 3.167 0.540 | 1.764 5.572 0.353 |
## Gruyere | 1.873 | 1.518 1.532 0.657 | 0.623 0.694 0.110 |
## Sarine | 2.247 | 0.962 0.615 0.183 | 1.895 6.431 0.711 |
## Dim.3 ctr cos2
## Courtelary -0.860 1.855 0.179 |
## Delemont 0.548 0.753 0.064 |
## Franches-Mnt 0.473 0.561 0.029 |
## Moutier -0.579 0.842 0.132 |
## Neuveville -0.628 0.991 0.283 |
## Porrentruy 0.351 0.308 0.014 |
## Broye 0.432 0.469 0.035 |
## Glane 0.398 0.398 0.018 |
## Gruyere 0.708 1.258 0.143 |
## Sarine 0.665 1.109 0.088 |
##
## Variables
## Dim.1 ctr cos2 Dim.2 ctr cos2 Dim.3 ctr
## Fertility | 0.817 20.884 0.668 | 0.351 10.370 0.123 | -0.160 3.019
## Agriculture | 0.759 17.996 0.576 | -0.449 16.934 0.201 | 0.035 0.147
## Examination | -0.912 25.983 0.831 | 0.136 1.563 0.019 | -0.084 0.832
## Education | -0.813 20.640 0.660 | 0.195 3.206 0.038 | 0.490 28.344
## Catholic | 0.626 12.258 0.392 | 0.159 2.128 0.025 | 0.743 65.093
## Infant.Mortality | 0.268 2.240 0.072 | 0.884 65.799 0.782 | -0.147 2.563
## cos2
## Fertility 0.026 |
## Agriculture 0.001 |
## Examination 0.007 |
## Education 0.240 |
## Catholic 0.552 |
## Infant.Mortality 0.022 |Traçons l'ébouli des valeurs propres pour déterminer les composantes pertinentes.
vp = swiss.acp$eig %>% data.frame %>% rownames_to_column(var = 'Composante') %>% as_tibble
gg7 = ggplot(vp) + geom_col(aes(x = Composante, y = eigenvalue)) + ggtitle("Ebouli des valeurs propres")En utilisant la règle de Kaiser, on peut voir graphiquement que l'on ne retiendrait que deux compostantes principales.
gg7 + geom_hline(aes(yintercept = 1), color = 'red')
En utilisant le pourcentage de variance expliquée, on aurait pu retenir un nombre différent de composante. Par exemple si l'on souhaite retenir toutes celles qui expliquent plus de 10% de la variance.
ggplot(vp) + geom_col(aes(x = Composante, y = percentage.of.variance)) +
ggtitle("Pourcentage de variance expliquée") + geom_hline(aes(yintercept = 10), color = 'red')
Ou encore si on voulait avoir un pourcentage de variance cumulée supérieur à 90%, auquel cas on retiendra les 4 premières.
ggplot(vp) + geom_col(aes(x = Composante, y = percentage.of.variance)) +
geom_point(aes(x = Composante, y = cumulative.percentage.of.variance)) +
ggtitle("Pourcentage de variance expliquée cumulée") +
geom_hline(aes(yintercept = 90), color = 'red')
Exercice 5
Avant toute chose, pour ce nouvel exercice, nous allons effacer tous les objets créés dans l'espace de travail pour eviter tout conflit/erreur avec la commande suivante:
rm(list = ls())Nous pouvons ensuite entamer une nouvelle analyse par la traditionelle importation des packages, des données et leur mise en forme. Nous utilisons ici la base de données decathlon inclue dans le package FactoMineR, regroupant les performances en compétition (JO et Décastar 2004) de différents athlètes dans les épreuves de décathlon.
library(tidyverse)
library(gridExtra)
library(FactoMineR)
data(decathlon)
raw_db = decathlon
db = raw_db %>% rownames_to_column('Name') %>% as_tibble
db## # A tibble: 41 x 14
## Name `100m` Long.jump Shot.put High.jump `400m` `110m.hurdle` Discus
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 SEBR~ 11.0 7.58 14.8 2.07 49.8 14.7 43.8
## 2 CLAY 10.8 7.4 14.3 1.86 49.4 14.0 50.7
## 3 KARP~ 11.0 7.3 14.8 2.04 48.4 14.1 49.0
## 4 BERN~ 11.0 7.23 14.2 1.92 48.9 15.0 40.9
## 5 YURK~ 11.3 7.09 15.2 2.1 50.4 15.3 46.3
## 6 WARN~ 11.1 7.6 14.3 1.98 48.7 14.2 41.1
## 7 ZSIV~ 11.1 7.3 13.5 2.01 48.6 14.2 45.7
## 8 McMU~ 10.8 7.31 13.8 2.13 49.9 14.4 44.4
## 9 MART~ 11.6 6.81 14.6 1.95 50.1 14.9 47.6
## 10 HERNU 11.4 7.56 14.4 1.86 51.1 15.1 45.0
## # ... with 31 more rows, and 6 more variables: Pole.vault <dbl>,
## # Javeline <dbl>, `1500m` <dbl>, Rank <int>, Points <int>, Competition <fct>summary(db)## Name 100m Long.jump Shot.put
## Length:41 Min. :10.44 Min. :6.61 Min. :12.68
## Class :character 1st Qu.:10.85 1st Qu.:7.03 1st Qu.:13.88
## Mode :character Median :10.98 Median :7.30 Median :14.57
## Mean :11.00 Mean :7.26 Mean :14.48
## 3rd Qu.:11.14 3rd Qu.:7.48 3rd Qu.:14.97
## Max. :11.64 Max. :7.96 Max. :16.36
## High.jump 400m 110m.hurdle Discus
## Min. :1.850 Min. :46.81 Min. :13.97 Min. :37.92
## 1st Qu.:1.920 1st Qu.:48.93 1st Qu.:14.21 1st Qu.:41.90
## Median :1.950 Median :49.40 Median :14.48 Median :44.41
## Mean :1.977 Mean :49.62 Mean :14.61 Mean :44.33
## 3rd Qu.:2.040 3rd Qu.:50.30 3rd Qu.:14.98 3rd Qu.:46.07
## Max. :2.150 Max. :53.20 Max. :15.67 Max. :51.65
## Pole.vault Javeline 1500m Rank Points
## Min. :4.200 Min. :50.31 Min. :262.1 Min. : 1.00 Min. :7313
## 1st Qu.:4.500 1st Qu.:55.27 1st Qu.:271.0 1st Qu.: 6.00 1st Qu.:7802
## Median :4.800 Median :58.36 Median :278.1 Median :11.00 Median :8021
## Mean :4.762 Mean :58.32 Mean :279.0 Mean :12.12 Mean :8005
## 3rd Qu.:4.920 3rd Qu.:60.89 3rd Qu.:285.1 3rd Qu.:18.00 3rd Qu.:8122
## Max. :5.400 Max. :70.52 Max. :317.0 Max. :28.00 Max. :8893
## Competition
## Decastar:13
## OlympicG:28
##
##
##
## Nous pouvons maintenant appliquer notre ACP, en retenant les variables d'intérêt, les performances dans chaque épreuve, tout en écartant les variables non pertinentes (le nombre de points et le classement, qui sont juste la conséquence de la somme de toutes les autres). Comme la fonction PCA() permet l'affichage des individus seulement pour des bases de données comportant des noms de lignes (à éviter normalement, contraire au format tidy), nous utilisons exceptionnelement la base de données brute en argument.
deca_acp = PCA(raw_db, ncp = 10, quanti.sup=c(11,12), quali.sup= 13)
L'analyse de la projection des variables sur le plan factoriel revele des premières informations, notamment la nette distinction entre les disciplines de course et les disciplines de lancés/sauts. Cette distinction est très classique dans le milieu du décathlon, et se joue souvent au niveau de la morphologie des athlètes, notamment dans le compromis poids/vitesse/puissance. Le 1500m est traditionnement l'épreuve qui illustre le mieux cette recherche de la polyvalence, et son placement intermédiaire sur le premier axe factoriel le montre parfaitement. Bien que ne servant pas dans le calcul des axes, les variables supplémentaires Points et Rank sont parfaitement anticorrélés, ce qui est tout à fait normal par définition du système de classement. On peut noter que les variables à gauche du graphique sont celles dont des valeurs faibles indiquent une bonne performance (temps le plus rapide possible) alors que les variables de droite représentent des valeurs qui doivent être maximiser (sauter ou lancer le plus loin possible). Ce implique que le premier axe renseigne également sur le niveau des athlètes lorsque l'on projet les individus sur le plans factoriel. Ceux qui obtiennent les meilleurs résultats sont à droite, alors que les moins bons se retrouvent sur la gauche.
Regardons plus en profondeur les résultats de cette ACP avec un résumé des axes, et de l'influence des individus et des variables.
summary(deca_acp)##
## Call:
## PCA(X = raw_db, ncp = 10, quanti.sup = c(11, 12), quali.sup = 13)
##
##
## Eigenvalues
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5 Dim.6 Dim.7
## Variance 3.272 1.737 1.405 1.057 0.685 0.599 0.451
## % of var. 32.719 17.371 14.049 10.569 6.848 5.993 4.512
## Cumulative % of var. 32.719 50.090 64.140 74.708 81.556 87.548 92.061
## Dim.8 Dim.9 Dim.10
## Variance 0.397 0.215 0.182
## % of var. 3.969 2.148 1.822
## Cumulative % of var. 96.030 98.178 100.000
##
## Individuals (the 10 first)
## Dist Dim.1 ctr cos2 Dim.2 ctr cos2 Dim.3
## SEBRLE | 2.369 | 0.792 0.467 0.112 | 0.772 0.836 0.106 | 0.827
## CLAY | 3.507 | 1.235 1.137 0.124 | 0.575 0.464 0.027 | 2.141
## KARPOV | 3.396 | 1.358 1.375 0.160 | 0.484 0.329 0.020 | 1.956
## BERNARD | 2.763 | -0.610 0.277 0.049 | -0.875 1.074 0.100 | 0.890
## YURKOV | 3.018 | -0.586 0.256 0.038 | 2.131 6.376 0.499 | -1.225
## WARNERS | 2.428 | 0.357 0.095 0.022 | -1.685 3.986 0.482 | 0.767
## ZSIVOCZKY | 2.563 | 0.272 0.055 0.011 | -1.094 1.680 0.182 | -1.283
## McMULLEN | 2.561 | 0.588 0.257 0.053 | 0.231 0.075 0.008 | -0.418
## MARTINEAU | 3.742 | -1.995 2.968 0.284 | 0.561 0.442 0.022 | -0.730
## HERNU | 2.794 | -1.546 1.782 0.306 | 0.488 0.335 0.031 | 0.841
## ctr cos2
## SEBRLE 1.187 0.122 |
## CLAY 7.960 0.373 |
## KARPOV 6.644 0.332 |
## BERNARD 1.375 0.104 |
## YURKOV 2.606 0.165 |
## WARNERS 1.020 0.100 |
## ZSIVOCZKY 2.857 0.250 |
## McMULLEN 0.303 0.027 |
## MARTINEAU 0.925 0.038 |
## HERNU 1.227 0.091 |
##
## Variables
## Dim.1 ctr cos2 Dim.2 ctr cos2 Dim.3 ctr
## 100m | -0.775 18.344 0.600 | 0.187 2.016 0.035 | -0.184 2.420
## Long.jump | 0.742 16.822 0.550 | -0.345 6.869 0.119 | 0.182 2.363
## Shot.put | 0.623 11.844 0.388 | 0.598 20.607 0.358 | -0.023 0.039
## High.jump | 0.572 9.998 0.327 | 0.350 7.064 0.123 | -0.260 4.794
## 400m | -0.680 14.116 0.462 | 0.569 18.666 0.324 | 0.131 1.230
## 110m.hurdle | -0.746 17.020 0.557 | 0.229 3.013 0.052 | -0.093 0.611
## Discus | 0.552 9.328 0.305 | 0.606 21.162 0.368 | 0.043 0.131
## Pole.vault | 0.050 0.077 0.003 | -0.180 1.873 0.033 | 0.692 34.061
## Javeline | 0.277 2.347 0.077 | 0.317 5.784 0.100 | -0.390 10.807
## 1500m | -0.058 0.103 0.003 | 0.474 12.946 0.225 | 0.782 43.543
## cos2
## 100m 0.034 |
## Long.jump 0.033 |
## Shot.put 0.001 |
## High.jump 0.067 |
## 400m 0.017 |
## 110m.hurdle 0.009 |
## Discus 0.002 |
## Pole.vault 0.479 |
## Javeline 0.152 |
## 1500m 0.612 |
##
## Supplementary continuous variables
## Dim.1 cos2 Dim.2 cos2 Dim.3 cos2
## Rank | -0.671 0.450 | 0.051 0.003 | -0.058 0.003 |
## Points | 0.956 0.914 | -0.017 0.000 | -0.066 0.004 |
##
## Supplementary categories
## Dist Dim.1 cos2 v.test Dim.2 cos2 v.test Dim.3
## Decastar | 0.946 | -0.600 0.403 -1.430 | -0.038 0.002 -0.123 | 0.289
## OlympicG | 0.439 | 0.279 0.403 1.430 | 0.017 0.002 0.123 | -0.134
## cos2 v.test
## Decastar 0.093 1.050 |
## OlympicG 0.093 -1.050 |Nous pouvons évaluer la qualité de représentation des individus en calculant le cosinus au carré de l'angle entre chaque individu et les deux premières composantes principales. La somme pour chaque ligne est égale à 1, ce qui correspond à la contribution totale.
deca_acp$ind$cos2## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## SEBRLE 1.116789e-01 1.061026e-01 1.218353e-01 0.2458834524 0.0891175533
## CLAY 1.240094e-01 2.684265e-02 3.727871e-01 0.0102377459 0.3170100676
## KARPOV 1.599189e-01 2.030911e-02 3.317531e-01 0.2987884939 0.0548190497
## BERNARD 4.867778e-02 1.002326e-01 1.037729e-01 0.6461113208 0.0171358470
## YURKOV 3.769960e-02 4.985821e-01 1.648055e-01 0.0837901520 0.1719330517
## WARNERS 2.160805e-02 4.816432e-01 9.968563e-02 0.0589152534 0.1702119336
## ZSIVOCZKY 1.124289e-02 1.821025e-01 2.504698e-01 0.4002469595 0.0002956720
## McMULLEN 5.261548e-02 8.114872e-03 2.658664e-02 0.3541411987 0.0096431236
## MARTINEAU 2.843007e-01 2.247270e-02 3.804678e-02 0.0209913701 0.1778554736
## HERNU 3.061041e-01 3.054416e-02 9.052696e-02 0.0140466868 0.0070708236
## BARRAS 4.724688e-01 2.537270e-02 3.561105e-08 0.1092831998 0.0262577113
## NOOL 3.943464e-01 2.772902e-01 1.280937e-01 0.0027353957 0.0494306465
## BOURGUIGNON 8.568416e-01 2.161703e-03 9.522441e-02 0.0148794511 0.0045517341
## Sebrle 6.954102e-01 7.954314e-02 3.584905e-03 0.1606656530 0.0060588462
## Clay 7.112052e-01 3.243204e-02 2.474266e-03 0.1033352389 0.0498460233
## Karpov 8.517553e-01 6.383365e-05 6.901180e-05 0.0688510249 0.0014063664
## Macey 4.230486e-01 9.203950e-02 2.947774e-01 0.0468447512 0.0809958841
## Warners 5.299437e-01 3.664716e-01 8.162612e-02 0.0091289511 0.0025832911
## Zsivoczky 1.299979e-01 2.074432e-01 3.315678e-01 0.0990639959 0.1157524249
## Hernu 2.375133e-01 1.149269e-01 2.424855e-01 0.0054592252 0.1211641560
## Nool 9.085645e-03 2.488948e-01 1.913628e-01 0.5041363312 0.0001304805
## Bernard 4.546366e-01 9.210522e-04 7.172513e-02 0.2633835151 0.0146021897
## Schwarzl 1.692391e-03 4.716030e-01 1.741587e-01 0.0410045776 0.0214085579
## Pogorelov 5.129333e-02 1.046216e-01 3.198363e-01 0.0536930532 0.1664903797
## Schoenbeck 4.055023e-03 4.917858e-04 1.697632e-01 0.2671745019 0.2260760826
## Barras 9.304287e-07 2.625220e-02 4.981683e-01 0.0758215580 0.0921378551
## Smith 6.056788e-02 8.973312e-02 2.159712e-01 0.1005444484 0.3262548852
## Averyanov 1.918587e-02 3.823331e-01 1.256292e-02 0.0001169776 0.0205083363
## Ojaniemi 2.644231e-02 1.091967e-01 2.518177e-02 0.0864446226 0.0456162410
## Smirnov 5.746318e-02 2.753785e-01 3.693280e-01 0.0784257130 0.0405842640
## Qi 6.062787e-02 3.416535e-02 3.675892e-01 0.0134945074 0.0921372308
## Drews 5.279320e-03 8.106930e-01 9.498558e-02 0.0355995805 0.0027173219
## Parkhomenko 9.413024e-02 3.606112e-01 8.230215e-02 0.1938156221 0.0065362449
## Terek 4.316993e-02 2.663035e-02 4.530158e-01 0.0010952579 0.1010116137
## Gomez 1.231257e-02 2.098296e-01 2.499419e-01 0.0008880035 0.2331396438
## Turi 2.524637e-01 1.937904e-02 2.806770e-02 0.0021671053 0.0001592206
## Lorenzo 4.708005e-01 2.033589e-01 1.831808e-01 0.0073546458 0.0377447850
## Karlivans 5.439001e-01 1.183427e-02 1.606751e-02 0.2212739426 0.0190475658
## Korkizoglou 5.806095e-02 2.702279e-01 4.233992e-01 0.0898404437 0.0405932955
## Uldal 7.566016e-01 6.944056e-03 2.024606e-02 0.0000517390 0.1828292758
## Casarsa 3.371043e-01 5.956504e-01 3.857070e-05 0.0224734168 0.0245135075
## Dim.6 Dim.7 Dim.8 Dim.9 Dim.10
## SEBRLE 1.892895e-01 0.0542070919 0.0338232611 3.372145e-03 4.469019e-02
## CLAY 3.872431e-02 0.0407532353 0.0296050229 3.427231e-02 5.758110e-03
## KARPOV 4.654529e-02 0.0031274608 0.0054309241 5.557148e-02 2.373627e-02
## BERNARD 9.952095e-03 0.0003224872 0.0005962519 6.854503e-02 4.653684e-03
## YURKOV 1.201432e-03 0.0361659158 0.0009826613 4.489741e-03 3.497850e-04
## WARNERS 1.776073e-04 0.0015827615 0.0153136601 6.260235e-02 8.825952e-02
## ZSIVOCZKY 5.230461e-03 0.0448812128 0.0831636192 1.911959e-02 3.247261e-03
## McMULLEN 4.764100e-01 0.0016790592 0.0101059802 4.413916e-02 1.656444e-02
## MARTINEAU 3.983367e-01 0.0078888559 0.0143393016 1.137412e-02 2.439394e-02
## HERNU 6.339566e-03 0.3141959990 0.0005803072 2.241107e-01 6.480745e-03
## BARRAS 4.399132e-02 0.0262875152 0.1129854621 2.061882e-02 1.627345e-01
## NOOL 7.090376e-02 0.0547685689 0.0003597872 1.845568e-02 3.615826e-03
## BOURGUIGNON 1.303879e-04 0.0019181248 0.0147968750 9.475297e-03 2.043153e-05
## Sebrle 1.959273e-04 0.0131329362 0.0241510498 1.650987e-04 1.709223e-02
## Clay 3.057527e-02 0.0348431884 0.0042462459 8.084736e-06 3.103445e-02
## Karpov 2.194755e-02 0.0082303556 0.0457598020 1.297465e-03 6.192910e-04
## Macey 1.358070e-04 0.0031494551 0.0403466787 1.630137e-02 2.360497e-03
## Warners 7.103242e-04 0.0004194189 0.0051878709 3.158053e-03 7.706915e-04
## Zsivoczky 1.015474e-02 0.0149302064 0.0458360572 3.088104e-02 1.437265e-02
## Hernu 1.233756e-01 0.0944017436 0.0303460521 3.013493e-03 2.731412e-02
## Nool 1.711984e-02 0.0041176619 0.0093986386 1.843597e-03 1.391022e-02
## Bernard 1.476122e-01 0.0273638107 0.0137353226 5.677061e-03 3.431309e-04
## Schwarzl 1.870490e-03 0.0019108962 0.1321920522 1.004516e-01 5.370775e-02
## Pogorelov 2.326459e-02 0.1188074647 0.0403358040 1.095358e-01 1.212171e-02
## Schoenbeck 7.337071e-02 0.0425407430 0.0547984319 1.339631e-01 2.776639e-02
## Barras 1.651894e-01 0.0395714007 0.0843147043 2.284009e-04 1.831519e-02
## Smith 1.334385e-01 0.0690757200 0.0008512507 2.923333e-03 6.396704e-04
## Averyanov 5.981593e-02 0.2875194826 0.0917587715 8.885553e-02 3.734310e-02
## Ojaniemi 1.156401e-01 0.0094809343 0.4861245535 4.677378e-02 4.909898e-02
## Smirnov 6.042182e-03 0.0330055769 0.0175932939 5.068219e-02 7.149711e-02
## Qi 5.862170e-02 0.2883898169 0.0101829283 2.418912e-02 5.060228e-02
## Drews 3.081120e-03 0.0182254814 0.0257563918 4.916541e-04 3.170537e-03
## Parkhomenko 4.520717e-05 0.2448142236 0.0037539886 1.091170e-03 1.289996e-02
## Terek 1.418962e-01 0.0441602407 0.1630461994 1.405864e-02 1.191577e-02
## Gomez 3.638920e-02 0.0029906882 0.0013694640 2.342094e-02 2.297180e-01
## Turi 2.660406e-01 0.1771262390 0.2508770664 2.296868e-03 1.422452e-03
## Lorenzo 3.777958e-04 0.0112162337 0.0757542118 7.911033e-03 2.301023e-03
## Karlivans 4.371247e-02 0.1291605685 0.0019296046 1.046973e-02 2.604190e-03
## Korkizoglou 4.082232e-02 0.0017278908 0.0591722834 3.666211e-03 1.248953e-02
## Uldal 4.521809e-03 0.0285355773 0.0002684617 1.235601e-06 2.258501e-07
## Casarsa 2.979952e-04 0.0029071472 0.0018628266 1.054091e-02 4.610948e-03Nous pouvons évaluer la qualité de représentation des variables en calculant le cosinus au carré de l'angle entre chaque variable et les deux premières composantes principales. La somme pour chaque ligne est égale à 1, ce qui correspond à la contribution totale. On remarque ce qui apparaissait déjà sur les premiers graphs, à savoir que la perche, le javelot et le 1500m contribue très peu au premier axe, indiquant leur faible influence sur le total de points. Il est en effet connu que ces épreuves font en pratique peu de différences. Les deux premières étant surtout 'éliminatoires' en cas de 0 (aucune barre passée à la perche par exemple), et le 1500m étant la dernière épreuve qui confirme souvent des positions déjà largement figées. Au contraire du premier, le troisième axe factoriel se concentre justement sur ces trois disciplines, et il pourrait être intéressant de le visualiser si l'on veut se pencher sur leur analyse spécifique.
deca_acp$var$cos2## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## 100m 0.600190812 0.03502213 0.0340059930 0.0014302206 0.091322660
## Long.jump 0.550415232 0.11931587 0.0332008675 0.0103603165 0.001345279
## Shot.put 0.387509426 0.35796686 0.0005465513 0.0363251605 0.012354505
## High.jump 0.327121422 0.12270561 0.0673464410 0.0183857880 0.308513117
## 400m 0.461869674 0.32425938 0.0172842817 0.0008586058 0.007689811
## 110m.hurdle 0.556882084 0.05234639 0.0085816841 0.0845826853 0.027001375
## Discus 0.305219255 0.36761593 0.0018448960 0.0674292539 0.010988725
## Pole.vault 0.002534268 0.03252860 0.4785272696 0.3041897208 0.108873151
## Javeline 0.076790421 0.10048206 0.1518313365 0.5073389244 0.093103658
## 1500m 0.003372945 0.22488818 0.6117473613 0.0259496775 0.023581254
## Dim.6 Dim.7 Dim.8 Dim.9 Dim.10
## 100m 0.052532985 0.065768884 8.456508e-02 0.002357417 0.032803826
## Long.jump 0.056158895 0.177786116 1.752168e-04 0.050045300 0.001196908
## Shot.put 0.055920005 0.043286926 3.911301e-02 0.039220335 0.027757216
## High.jump 0.131125895 0.003773728 6.210295e-03 0.012753657 0.002064046
## 400m 0.066261577 0.006985401 1.807328e-02 0.065485634 0.031232355
## 110m.hurdle 0.005949349 0.057615948 2.006940e-01 0.004841992 0.001504535
## Discus 0.121013911 0.083390649 5.849093e-04 0.005148092 0.036764380
## Pole.vault 0.041030940 0.004330144 1.258004e-02 0.001479064 0.013926802
## Javeline 0.015961591 0.005141616 3.480612e-02 0.013140353 0.001403912
## 1500m 0.053313533 0.003155852 7.467951e-05 0.020343009 0.033573506Pour selectionner le nombre adéquat de composante, on peut se reposer sur l'ébouli des valeurs propres et la règle de Kayser.
vp = deca_acp$eig %>% data.frame %>% rownames_to_column(var = 'Composante') %>% as_tibble
vp %>% mutate(Composante = factor(Composante, levels = Composante)) %>%
ggplot() + geom_col(aes(x = Composante, y = eigenvalue)) + ggtitle("Ebouli des valeurs propres") +
geom_hline(aes(yintercept = 1), color = 'red')
Ou utiliser notre propre critère en se basant sur le pourcentage de variance expliquée.
vp %>% mutate(Composante = factor(Composante, levels = Composante)) %>%
ggplot() + geom_col(aes(x = Composante, y = percentage.of.variance)) +
geom_point(aes(x = Composante, y = cumulative.percentage.of.variance)) +
ggtitle("Pourcentage de variance expliquée cumulée") +
geom_hline(aes(yintercept = 90), color = 'red')
Une fois que l'on a selectionné le nombre de composantes, disons 4 ici. Nous pouvons visualiser les variables et individus dans de nouveaux plans factoriels. Cependant, les options graphiques restent assez limitées pour la fonction plot() définie dans le package.
plot(deca_acp, axes = c(1,3), choix="var")
plot(deca_acp, axes = c(1,3), choix="ind")
plot(deca_acp, axes = c(1,4), choix="var")
plot(deca_acp, axes = c(1,4), choix="ind")
plot(deca_acp, axes = c(3,4), choix="var")
plot(deca_acp, axes = c(3,4), choix="ind")
Exercice 6
Pour cette exercice, nous ré-utilisons la base de données Recensement_12, mais nous introduisons une nouvelle méthode permettant d'analyser également les variables qualitatives: l'analyse factorielle des correspondances (AFC). Il a été vu en cours que l'AFC utilise un tableau de contingence entre deux variables qualitatives. Il n'est donc plus questions d'individus ou de variables dans le tableau analysé, les lignes représentant les modalités d'une variables, et les colonnes les modalités de l'autre. En comptant les associations entres les différentes modalités de chaque variable, il est ensuite possible de fabriquer des profils lignes et profils colonnes à partir des fréquences conditionelles de chaque modalités. Puisque l'AFC correspond à une ACP utilisant la distance du \(\chi^2\) sur un tel tableau, le fonctionnement de l'analyse et l'interprétation des résultats est globalement ressemblante aux précédents exercices. Commençons par les importations, et le nettoyage des données manquantes, et le décompte des modalités communes entre les variables du statut marital et des revenus du foyer:
library(tidyverse)
library(gridExtra)
library(FactoMineR)
raw_db = read_csv2('C:/Users/user/Google Drive/Travail/Enseignement/STID/2A/ADD/Codes R/Donnees/Recensement_12.csv')
db = raw_db %>% filter( !is.na(REV_FOYER), !is.na(STAT_MARI) ) %>%
group_by(STAT_MARI, REV_FOYER) %>%
count()
db## # A tibble: 17 x 3
## # Groups: STAT_MARI, REV_FOYER [17]
## STAT_MARI REV_FOYER n
## <chr> <chr> <int>
## 1 C < 40 72
## 2 C >= 100 30
## 3 C 40 - < 60 39
## 4 C 60 - < 100 29
## 5 D < 40 25
## 6 D >= 100 8
## 7 D 40 - < 60 9
## 8 D 60 - < 100 12
## 9 M < 40 56
## 10 M >= 100 68
## 11 M 40 - < 60 66
## 12 M 60 - < 100 100
## 13 S < 40 6
## 14 S 40 - < 60 4
## 15 S 60 - < 100 2
## 16 V < 40 3
## 17 V 60 - < 100 2On peut représenter sous la forme d'un tableau de contingence si nécessaire en utilisant la fonction spread qui, comme son nom l'indique, permet de déployer les modalités d'une variable en colonnes. L'argument fill remplace les NA par la valeur indiquée.
tb_cont = db %>% spread(REV_FOYER, n, fill = 0)
tb_cont## # A tibble: 5 x 5
## # Groups: STAT_MARI [5]
## STAT_MARI `< 40` `>= 100` `40 - < 60` `60 - < 100`
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 C 72 30 39 29
## 2 D 25 8 9 12
## 3 M 56 68 66 100
## 4 S 6 0 4 2
## 5 V 3 0 0 2Il existe plusieurs façon de calculer les fréquences nécessaires à la définition des profils lignes et colonnes, mais en passant par le format tibble, il est possible de le faire assez naturellement.
prof_row = db %>% group_by(STAT_MARI) %>%
mutate(n = (n/sum(n)*100) %>% round()) %>%
spread(REV_FOYER, n, fill=0)
prof_row## # A tibble: 5 x 5
## # Groups: STAT_MARI [5]
## STAT_MARI `< 40` `>= 100` `40 - < 60` `60 - < 100`
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 C 42 18 23 17
## 2 D 46 15 17 22
## 3 M 19 23 23 34
## 4 S 50 0 33 17
## 5 V 60 0 0 40On remarque que les lignes somment bien à 100%, et on peut déjà voir à l'oeil nu la ressemblance entre certaines lignes, notamment les modalités Célibataire (C) et Divorcé (D). Gardons ça à l'esprit pour l'AFC qui suit et faisons la même chose pour les profils colonnes.
prof_col= db %>% group_by(REV_FOYER) %>%
mutate(n = (n/sum(n)*100) %>% round()) %>%
spread(STAT_MARI, n, fill=0)
prof_col## # A tibble: 4 x 6
## # Groups: REV_FOYER [4]
## REV_FOYER C D M S V
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 < 40 44 15 35 4 2
## 2 >= 100 28 8 64 0 0
## 3 40 - < 60 33 8 56 3 0
## 4 60 - < 100 20 8 69 1 1Dans le cas des revenus, on peut voir une très forte similarité entre les modalités 60-100 et >100, qui sont globalements des profils de foyers très aisés. A présent, on souhaite effectuer une AFC sur le tableau de contingence en utilisant le package FactoMineR, et sa fonction correspondante CA(). Si on note \(m_1 = 5\) et \(m_2 = 4\) le nombre de modalités pour respectivement la première et la deuxième variable, le nombre maximal d'axes est données par \(min(m_1, m_2) - 1 = 3\) dans notre cas.
res_ca = CA(tb_cont %>% column_to_rownames('STAT_MARI'), ncp = 3)
L'ACP est réalisée à la fois sur les profils lignes et les profils colonnes, ce qui amène ci-dessus aux projections sur les axes factoriels pour les deux ensembles de modalités. Regardons à présent un résumé des informations importantes de notre AFC.
summary(res_ca)##
## Call:
## CA(X = tb_cont %>% column_to_rownames("STAT_MARI"), ncp = 3)
##
## The chi square of independence between the two variables is equal to 49.31637 (p-value = 1.841341e-06 ).
##
## Eigenvalues
## Dim.1 Dim.2 Dim.3
## Variance 0.081 0.008 0.004
## % of var. 87.167 8.754 4.078
## Cumulative % of var. 87.167 95.922 100.000
##
## Rows
## Iner*1000 Dim.1 ctr cos2 Dim.2 ctr cos2 Dim.3
## C | 27.969 | -0.287 32.574 0.943 | 0.066 16.932 0.049 | 0.026
## D | 12.034 | -0.319 12.754 0.858 | -0.122 18.732 0.127 | 0.043
## M | 36.141 | 0.257 44.599 0.999 | -0.005 0.147 0.000 | -0.007
## S | 9.518 | -0.521 7.586 0.645 | 0.044 0.527 0.005 | -0.384
## V | 7.212 | -0.462 2.487 0.279 | -0.741 63.663 0.718 | -0.049
## ctr cos2
## C 5.859 0.008 |
## D 4.894 0.015 |
## M 0.638 0.001 |
## S 88.021 0.350 |
## V 0.588 0.003 |
##
## Columns
## Iner*1000 Dim.1 ctr cos2 Dim.2 ctr cos2 Dim.3
## < 40 | 50.977 | -0.407 62.335 0.990 | -0.039 5.568 0.009 | 0.014
## >= 100 | 11.925 | 0.210 10.845 0.736 | 0.070 12.086 0.082 | 0.104
## 40 - < 60 | 4.906 | 0.025 0.165 0.027 | 0.124 42.184 0.699 | -0.078
## 60 - < 100 | 25.067 | 0.281 26.655 0.861 | -0.109 40.162 0.130 | -0.029
## ctr cos2
## < 40 1.589 0.001 |
## >= 100 57.108 0.181 |
## 40 - < 60 35.428 0.274 |
## 60 - < 100 5.876 0.009 |On voit que le premier axe exprime à lui seul une énorme part de la variance, et les deux premiers axes dépassent les 95% de variances cumulée à eux seuls. On voit que la règle de Kayser n'est ici pas applicable car les valeurs propres sont toutes <1. On remarque sur le graphe comme dans le résumé des contributions que la modalité Veuf perturbe l'analyse à cause de son faible effectif. Nous allons donc refaire l'analyse en l'utilisant comme modalité supplémentaire qui n'intervient pas dans la construction des axes.
res_ca2 = CA(tb_cont %>% column_to_rownames('STAT_MARI'), ncp = 3, row.sup = 5)
On s'aperçoit alors que la modalité Séparé présente le même comportement, avec elle aussi un petit effectif. On va donc relancer une dernière fois l'analyse en ne conservant que les 3 modalités bien représentées. Attention, à cause de ce choix, notre nombre d'axe maximal est maintenant égale à 3 - 1 = 2.
res_ca3= CA(tb_cont %>% column_to_rownames('STAT_MARI'), ncp = 3, row.sup = c(4,5))
summary(res_ca3)##
## Call:
## CA(X = tb_cont %>% column_to_rownames("STAT_MARI"), ncp = 3,
## row.sup = c(4, 5))
##
## The chi square of independence between the two variables is equal to 40.67807 (p-value = 3.350746e-07 ).
##
## Eigenvalues
## Dim.1 Dim.2
## Variance 0.076 0.003
## % of var. 96.380 3.620
## Cumulative % of var. 96.380 100.000
##
## Rows
## Iner*1000 Dim.1 ctr cos2 Dim.2 ctr cos2
## C | 32.082 | -0.308 41.090 0.977 | 0.047 25.836 0.023 |
## D | 13.841 | -0.334 15.361 0.847 | -0.142 74.133 0.153 |
## M | 33.218 | 0.243 43.549 1.000 | -0.001 0.031 0.000 |
##
## Columns
## Iner*1000 Dim.1 ctr cos2 Dim.2 ctr cos2
## < 40 | 47.969 | -0.401 62.610 0.996 | -0.027 7.418 0.004 |
## >= 100 | 5.323 | 0.157 6.655 0.954 | 0.035 8.620 0.046 |
## 40 - < 60 | 1.611 | 0.032 0.295 0.140 | 0.079 48.396 0.860 |
## 60 - < 100 | 24.238 | 0.291 30.441 0.958 | -0.061 35.566 0.042 |
##
## Supplementary rows
## Dim.1 cos2 Dim.2 cos2
## S | -0.511 0.591 | 0.053 0.006 |
## V | -0.449 0.254 | -0.755 0.719 |On remarque maintenant que quasiment toute la variance est exprimée par un unique axe. Ceci semble donc indiquer une grande dépendance entre les deux variables, qui nous permet d'expliquer la plupart des différences de profils à l'aide des positions sur une seule dimension. Globalement on voit que cet axe donne des valeurs positives aux modalités de revenus les plus associés au statut marié et inversement.
plot(res_ca3)
tb_cont## # A tibble: 5 x 5
## # Groups: STAT_MARI [5]
## STAT_MARI `< 40` `>= 100` `40 - < 60` `60 - < 100`
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 C 72 30 39 29
## 2 D 25 8 9 12
## 3 M 56 68 66 100
## 4 S 6 0 4 2
## 5 V 3 0 0 2Exercice 7
Pour ce nouvel exercice, une AFC complète va être effectuée sur une nouvelle base de données, directement présentée comme un tableau de contingence, contenue dans le fichier media.csv. Les variables mises en relation ici sont la catégorie socio-professionnelle avec le type de média favoris utilisé pour s'informer sur les thématiques environnementales. Chacune de ces variables présente différentes modalités qualitatives, comme nous allons le voir lors de la présentation ci-dessous à la suite du traditionel import des données et packages.
rm(list = ls())
library(tidyverse)
library(gridExtra)
library(FactoMineR)
raw_db = read.csv2('C:/Users/user/Google Drive/Travail/Enseignement/STID/2A/ADD/Codes R/Donnees/media.csv')
raw_db## CSP TEL JOU RAD LIV ASS MAI Total
## 1 AGRI 26 18 9 5 4 6 68
## 2 CSUP 19 49 4 16 5 3 96
## 3 CMOY 44 87 4 39 14 3 191
## 4 EMPL 83 87 13 24 5 1 213
## 5 OUVR 181 107 16 31 7 7 349
## 6 RETR 167 95 29 15 7 7 320
## 7 CHOM 27 9 4 2 2 2 46
## 8 Total 547 452 79 132 44 29 1283Cette fois, le tableau a le bon goût d'être déjà au format tidy, on pourra donc directement utiliser raw_db comme référence, et la variable db ci-dessous va être mise au format réclamé par la fonction CA() du package maintenant bien connu FactoMineR.
db = raw_db %>% dplyr::select(- Total) %>%
filter(CSP != 'Total ') %>%
column_to_rownames('CSP')
db## TEL JOU RAD LIV ASS MAI
## AGRI 26 18 9 5 4 6
## CSUP 19 49 4 16 5 3
## CMOY 44 87 4 39 14 3
## EMPL 83 87 13 24 5 1
## OUVR 181 107 16 31 7 7
## RETR 167 95 29 15 7 7
## CHOM 27 9 4 2 2 2On peut maintenant effectuer notre AFC en se rappelant que le nombre maximum d'axes est donné par min(m1, m2) - 1 = min(6, 7) - 1 = 5, dans notre cas de figure. Même s'il l'argument graph a par défaut une valeur égale à TRUE, nous le précisons ici explicitement pour indiquer qu'il est possible de désactiver l'affichage automatique des résultats.
media_AFC = CA(db, ncp = 5, graph = T) 
Pour la suite, afin de clarifier le code et simplifier les multiples appels que l'on va faire aux différents résultats de l'AFC, on peut définir des variables row, col et eig. De manière générale, il faut savoir trouver un compromis entre garder une nombre réduit d'objets en mémoire dans l'environnement et la clarté/simplicité du code.
row = media_AFC$row
col = media_AFC$col
eig = media_AFC$eig %>% data.frame %>%
rownames_to_column(var = 'Composante') %>%
as_tibblePuis, comme nous en avons l'habitude, la selection du nombre d'axes à retenir peut se faire à l'aide de son critère favori concernant les valeurs propres et/ou la variance expliquée.
eig## # A tibble: 5 x 4
## Composante eigenvalue percentage.of.variance cumulative.percentage.of.variance
## <chr> <dbl> <dbl> <dbl>
## 1 dim 1 0.0915 75.1 75.1
## 2 dim 2 0.0219 18.0 93.1
## 3 dim 3 0.00642 5.27 98.4
## 4 dim 4 0.00175 1.44 99.8
## 5 dim 5 0.000236 0.194 100.eig %>% ggplot() + geom_col(aes(x = Composante, y = percentage.of.variance)) +
geom_point(aes(x = Composante, y = cumulative.percentage.of.variance)) +
ggtitle("Pourcentage de variance expliquée cumulée") +
geom_hline(aes(yintercept = 90), color = 'red')
Ici il peut sembler pertinent de garder seulement deux axes qui expliquent déjà plus de 90% de la variance. Un autre critère possible consiste à calculer la valeur moyenne des valeurs propres pour conserver celles qui lui sont supérieures.
mean_eig = eig %>% pull(eigenvalue) %>%
mean()Avec ce critère, nous n'aurions retenu qu'un axe, et très proche d'en conserver un deuxième (qui de toute façon ne 'coûte' rien lorsque l'on considère la projection sur un plan factoriel). Dans tous les cas, on voit que le premier axe rend compte à lui seul de l'information principale exprimée par nos données.
eig %>% ggplot() + geom_col(aes(x = Composante, y = eigenvalue)) +
ggtitle("Ebouli des valeurs propres") +
geom_hline(aes(yintercept = mean_eig), color = 'red')
A la lumière de ces informations, nous pouvons maintenant analyser les contributions et qualités de représentations des différentes modalités sur ces 2 premières composantes principales, pour vérifier si elles sont toutes pertinentes. Gardons en tête pour les profils lignes et leurs 7 modalités, une contribution moyenne serait de l'ordre de \(\frac{1}{7} \times100\) = 14.3%, et pour les profils colonnes de \(\frac{1}{6} \times 100\) = 16.7%. Une contribution qui serait très inférieure à ces valeurs sur chaque axe retenu pourrait être considérée comme très peu utile à l'analyse, et potentiellement amener à basculer les modalités correspondantes en supplémentaires.
row$contrib## Dim 1 Dim 2 Dim 3 Dim 4 Dim 5
## AGRI 1.298041 72.51327581 0.002768973 2.6703493 17.6761633
## CSUP 18.589655 2.92451563 9.926745975 27.4950684 31.7322241
## CMOY 46.346760 0.15573974 13.349957815 21.0009947 0.1650309
## EMPL 1.321123 9.41412708 27.118693446 0.4559869 27.3334060
## OUVR 6.216332 11.44358487 26.323414204 26.0420416 1.4375866
## RETR 20.336943 0.02474628 11.957637219 14.4076585 12.5171942
## CHOM 5.891148 3.52401058 11.320782369 7.9279006 9.1383948row$cos2## Dim 1 Dim 2 Dim 3 Dim 4 Dim 5
## AGRI 0.06913325 0.9257061924 1.034725e-05 0.002721255 2.428950e-03
## CSUP 0.90262553 0.0340366837 3.381821e-02 0.025544281 3.975290e-03
## CMOY 0.97116156 0.0007822194 1.962725e-02 0.008420048 8.922147e-06
## EMPL 0.23762891 0.4058757998 3.422412e-01 0.001569318 1.268475e-02
## OUVR 0.54971845 0.2425633799 1.633262e-01 0.044063983 3.279987e-04
## RETR 0.94635214 0.0002760159 3.904091e-02 0.012828122 1.502817e-03
## CHOM 0.76454800 0.1096223318 1.030834e-01 0.019686369 3.059896e-03On peut voir dans ces deux tableaux que les modalités Employé et Ouvrier participent très peu à la création des axes, et en conséquence, sont assez mal représentés sur ceux-ci. Nous les considérerons donc comme modalités suppémentaires dans une nouvelle analyse. De même, nous pouvons analyser les profils colonnes à présent.
col$contrib## Dim 1 Dim 2 Dim 3 Dim 4 Dim 5
## TEL 36.8359294 8.105340 12.263021 0.101198694 0.06006112
## JOU 18.0626422 2.242241 24.470862 6.402248871 13.59207658
## RAD 7.5070420 19.670247 33.990825 15.139456490 17.53498646
## LIV 29.3138808 0.282285 11.905792 0.004991968 48.20466391
## ASS 7.5764024 14.181452 12.054169 42.458147897 20.30036655
## MAI 0.7041032 55.518435 5.315332 35.893956080 0.30784537col$cos2## Dim 1 Dim 2 Dim 3 Dim 4 Dim 5
## TEL 0.9292328 0.049009593 0.02170490 4.884615e-05 3.909113e-06
## JOU 0.8821972 0.026249659 0.08385735 5.983007e-03 1.712782e-03
## RAD 0.5024225 0.315549146 0.15961341 1.938711e-02 3.027873e-03
## LIV 0.9661362 0.002230025 0.02753156 3.148034e-06 4.099077e-03
## ASS 0.5972194 0.267946782 0.06666771 6.403751e-02 4.128637e-03
## MAI 0.0467158 0.882920663 0.02474374 4.556710e-02 5.269775e-05Ici les modalités Radio et Associations sont assez mal représentées et l'on peut choisir de les basculer en supplémentaires. Dans ces conditions, le nombre maximum d'axe tombe à présent à 3.
media_AFC2 = CA(db, ncp = 2, row.sup = c(4,5), col.sup = c(3,5), graph = F) row = media_AFC2$row
col = media_AFC2$col
eig = media_AFC2$eig %>% data.frame %>%
rownames_to_column(var = 'Composante') %>%
as_tibbleeig## # A tibble: 3 x 4
## Composante eigenvalue percentage.of.variance cumulative.percentage.of.variance
## <chr> <dbl> <dbl> <dbl>
## 1 dim 1 0.139 86.5 86.5
## 2 dim 2 0.0183 11.4 97.9
## 3 dim 3 0.00339 2.11 100eig %>% ggplot() + geom_col(aes(x = Composante, y = percentage.of.variance)) +
geom_point(aes(x = Composante, y = cumulative.percentage.of.variance)) +
ggtitle("Pourcentage de variance expliquée cumulée") +
geom_hline(aes(yintercept = 90), color = 'red')
On peut voir à présent que la selection de deux axes est assez naturelle. Vérifions que toutes nos modalités contribuent correctement à leur création.
row$contrib## Dim 1 Dim 2
## AGRI 1.784454 80.674424
## CSUP 19.261376 1.581422
## CMOY 38.507944 2.847088
## RETR 29.830579 13.831766
## CHOM 10.615646 1.065300col$contrib## Dim 1 Dim 2
## TEL 46.9857173 3.15322896
## JOU 18.0168654 1.07243060
## LIV 34.1724121 0.03612171
## MAI 0.8250051 95.73821874Ainsi que la qualité de leur représentation.
row$cos2## Dim 1 Dim 2
## AGRI 0.1438487 0.855797563
## CSUP 0.9365794 0.010119046
## CMOY 0.9735759 0.009472286
## RETR 0.9385876 0.057269747
## CHOM 0.9403323 0.012417706col$cos2## Dim 1 Dim 2
## TEL 0.98841492 0.0087289788
## JOU 0.94105033 0.0073711851
## LIV 0.96297248 0.0001339495
## MAI 0.06144284 0.9382843034En plus de voir que les modalités sont en effet bien représentées on remarque que le deuxième axe est construit quasi exclusivement par les modalités Agriculteur et Mairie alors que les autres sont plus équilibrées su le premier axe. Ces informations sont importantes à retenir pour l'analyse des coordonnées de chaque modalité sur les axes retenus, dans le tableau ci-dessous.
row$coord## Dim 1 Dim 2
## AGRI -0.1698596 0.41430735
## CSUP 0.4437137 0.04612117
## CMOY 0.4449087 -0.04388473
## RETR -0.3056261 -0.07549456
## CHOM -0.4858050 0.05582671col$coord## Dim 1 Dim 2
## TEL -0.3842452 -0.03610943
## JOU 0.2492003 -0.02205519
## LIV 0.6282193 0.00740926
## MAI -0.1869121 0.73041396Ou plus simplement, via la projection dans le premier plan factoriel, que l'on peut également analyser en s'aidant du tableau de contingence brut.
plot(media_AFC2)
raw_db## CSP TEL JOU RAD LIV ASS MAI Total
## 1 AGRI 26 18 9 5 4 6 68
## 2 CSUP 19 49 4 16 5 3 96
## 3 CMOY 44 87 4 39 14 3 191
## 4 EMPL 83 87 13 24 5 1 213
## 5 OUVR 181 107 16 31 7 7 349
## 6 RETR 167 95 29 15 7 7 320
## 7 CHOM 27 9 4 2 2 2 46
## 8 Total 547 452 79 132 44 29 1283Pour commencer par le plus simple, le deuxième axe nous informe pour les valeurs hautes d'une association soit avec la modalité Agriculteurs pour les médias, ou avec la modalité Mairie pour les CSP. Ainsi, ormis l'apparente association de ces deux modalités, sûrement expliquée par un contexte rural, toutes les modalités sont très proches de l'axe horizontal et donc peu discriminés par cette composante principale. On pourra éventuellement noter une tendance des Employés à ne pas s'informer auprès des mairies, ou une relative affinité des Agriculteurs pour la Radio et les Associations.
Concernant le premier axe à présent, on voit une nette opposition entre les modalités de médias 'papier' avec des coordonnées positives, tout comme les CSP moyennes ou supérieurs, probablement parmi les plus 'éduqués' dans les catégories proposées. De l'autre côté de l'axe, les modalités 'Chômeurs', 'Ouvriers' et 'Retraités' sont plus associés aux média Radio ou Télévisuels. Tandis que les employés ont un profil à mi chemin.
Exercice 8
Cet exercice se concentre sur l'analyse de la base de données Papillon, qui regroupe 23 papillons sur lesquels sont observés 4 caratéristiques quantitatives discrètes notées \(Z_1\), \(Z_2\), \(Z_3\) et \(Z_4\). Nous allons tâcher de les analyser en nous appuyant sur une ACP puis sur une AFC, pour comparer les résultats apportés par les deux approches. Comme d'habitude, nous importons les packages, les données, et supprimons la colonne complétement futile qui comporte les numéros de ligne.
rm(list = ls())
library(tidyverse)
library(gridExtra)
library(FactoMineR)
raw_db = read.csv2('C:/Users/user/Google Drive/Travail/Enseignement/STID/2A/ADD/Codes R/Donnees/Papillon.csv')
raw_db## NUM Z1 Z2 Z3 Z4
## 1 1 22 35 24 19
## 2 2 24 31 21 22
## 3 3 27 36 25 15
## 4 4 27 36 24 23
## 5 5 21 33 23 18
## 6 6 26 35 23 32
## 7 7 27 37 26 15
## 8 8 22 30 19 20
## 9 9 25 33 22 22
## 10 10 30 41 28 17
## 11 11 24 39 27 21
## 12 12 29 39 27 17
## 13 13 29 40 27 17
## 14 14 28 36 23 24
## 15 15 22 36 24 20
## 16 16 23 30 20 20
## 17 17 28 38 26 16
## 18 18 25 34 23 14
## 19 19 26 35 24 15
## 20 20 23 37 25 20
## 21 21 31 42 29 18
## 22 22 26 34 22 21
## 23 23 24 38 26 21db = raw_db %>% select(- NUM)
db## Z1 Z2 Z3 Z4
## 1 22 35 24 19
## 2 24 31 21 22
## 3 27 36 25 15
## 4 27 36 24 23
## 5 21 33 23 18
## 6 26 35 23 32
## 7 27 37 26 15
## 8 22 30 19 20
## 9 25 33 22 22
## 10 30 41 28 17
## 11 24 39 27 21
## 12 29 39 27 17
## 13 29 40 27 17
## 14 28 36 23 24
## 15 22 36 24 20
## 16 23 30 20 20
## 17 28 38 26 16
## 18 25 34 23 14
## 19 26 35 24 15
## 20 23 37 25 20
## 21 31 42 29 18
## 22 26 34 22 21
## 23 24 38 26 21summary(db)## Z1 Z2 Z3 Z4
## Min. :21.00 Min. :30.00 Min. :19.00 Min. :14.00
## 1st Qu.:23.50 1st Qu.:34.00 1st Qu.:23.00 1st Qu.:17.00
## Median :26.00 Median :36.00 Median :24.00 Median :20.00
## Mean :25.61 Mean :35.87 Mean :24.26 Mean :19.43
## 3rd Qu.:27.50 3rd Qu.:38.00 3rd Qu.:26.00 3rd Qu.:21.00
## Max. :31.00 Max. :42.00 Max. :29.00 Max. :32.00Après un premier summary, nous pouvons noter en étant bien attentif que toutes les variables ont l'air relativement homogènes, hormis Z4, dont le max semble beaucoup plus grand que le 3ème quartile. Regardons ça de plus prêt dans l'ACP qui suit.
res_acp = PCA(db, ncp = 4)
Sur le plan factoriel, il semble y avoir un individu atypique, et en observant les données brutes, il s'agit en fait de l'individu avec une très grand valeur de \(Z_4\).
summary(res_acp)##
## Call:
## PCA(X = db, ncp = 4)
##
##
## Eigenvalues
## Dim.1 Dim.2 Dim.3 Dim.4
## Variance 2.661 0.901 0.423 0.015
## % of var. 66.518 22.531 10.582 0.369
## Cumulative % of var. 66.518 89.049 99.631 100.000
##
## Individuals (the 10 first)
## Dist Dim.1 ctr cos2 Dim.2 ctr cos2 Dim.3 ctr
## 1 | 1.359 | -0.850 1.180 0.391 | -0.477 1.096 0.123 | 0.947 9.204
## 2 | 2.209 | -2.135 7.447 0.934 | 0.184 0.164 0.007 | -0.495 2.515
## 3 | 1.303 | 0.746 0.910 0.328 | -0.968 4.521 0.552 | -0.436 1.955
## 4 | 1.069 | -0.021 0.001 0.000 | 1.016 4.981 0.903 | -0.332 1.131
## 5 | 2.017 | -1.572 4.038 0.607 | -0.939 4.252 0.217 | 0.834 7.141
## 6 | 3.342 | -1.223 2.443 0.134 | 3.108 46.587 0.864 | 0.004 0.000
## 7 | 1.491 | 1.168 2.227 0.613 | -0.899 3.895 0.363 | -0.160 0.263
## 8 | 3.110 | -3.023 14.929 0.944 | -0.575 1.594 0.034 | -0.400 1.642
## 9 | 1.465 | -1.346 2.962 0.844 | 0.397 0.759 0.073 | -0.416 1.780
## 10 | 2.806 | 2.793 12.749 0.991 | 0.113 0.062 0.002 | -0.239 0.586
## cos2
## 1 0.485 |
## 2 0.050 |
## 3 0.112 |
## 4 0.096 |
## 5 0.171 |
## 6 0.000 |
## 7 0.012 |
## 8 0.017 |
## 9 0.081 |
## 10 0.007 |
##
## Variables
## Dim.1 ctr cos2 Dim.2 ctr cos2 Dim.3 ctr cos2
## Z1 | 0.810 24.647 0.656 | 0.227 5.731 0.052 | -0.541 69.095 0.292 |
## Z2 | 0.957 34.451 0.917 | 0.165 3.035 0.027 | 0.220 11.451 0.048 |
## Z3 | 0.957 34.452 0.917 | 0.034 0.132 0.001 | 0.274 17.745 0.075 |
## Z4 | -0.414 6.449 0.172 | 0.906 91.102 0.821 | 0.085 1.709 0.007 |On peut également voir que ce 6ème individu accapare à lui seul quasiment toute la contribution du deuxième axe factoriel, qui se concentre sur \(Z_4\). Tout cela semble très clairement biaiser l'analyse et occulter l'information pertinente. Comme d'habitutde, nous nous proposons donc de traiter cet individu en tant que supplémentaire, afin de le projeter mais sans qu'il ne contribut à la construction des axes.
res_acp = PCA(db, ncp = 4, ind.sup= 6, graph = F)Comme habituellement, selectionnons le nombre adequat d'axes factoriels à considérer. Si l'on suit la règle de Kayser, seul un axe serait retenu, à peu de choses près.
vp = res_acp$eig %>% data.frame %>% rownames_to_column(var = 'Composante') %>% as_tibble
ggplot(vp) + geom_col(aes(x = Composante, y = eigenvalue)) +
ggtitle("Ebouli des valeurs propres") +
geom_hline(aes(yintercept = 1), color = 'red')
Comme déjà discuté, l'intérêt de ne retenir qu'un seul axe est faible, dans le sens où il est quasiment 'gratuit' de considérer les deux premiers axes d'un point de vu graphique. De plus, nous voyons avec un autre critère de choix que pour atteindre environ 90% de variance expliquée, il serait nécessaire de retenir deux composantes principales. Nous gardons donc ce choix de deux axes pour la suite de l'analyse.
ggplot(vp) + geom_col(aes(x = Composante, y = percentage.of.variance)) +
geom_point(aes(x = Composante, y = cumulative.percentage.of.variance)) +
ggtitle("Pourcentage de variance expliquée cumulée") +
geom_hline(aes(yintercept = 90), color = 'red')
Sachant que nous avons déjà retiré l'individu semblant le plus aberrant, concentrons nous à présent sur les variables, leurs contributions respectives et leurs qualités de représentation. D'une part pour voir si elles sont toutes utiles, et pour donner des premiers indices sur l'interprétation à suivre que l'on devra faire des composantes principales.
summary(res_acp)##
## Call:
## PCA(X = db, ncp = 4, ind.sup = 6, graph = F)
##
##
## Eigenvalues
## Dim.1 Dim.2 Dim.3 Dim.4
## Variance 2.717 0.845 0.425 0.013
## % of var. 67.925 21.118 10.629 0.328
## Cumulative % of var. 67.925 89.043 99.672 100.000
##
## Individuals (the 10 first)
## Dist Dim.1 ctr cos2 Dim.2 ctr cos2 Dim.3 ctr
## 1 | 1.324 | -0.889 1.323 0.451 | -0.238 0.305 0.032 | -0.952 9.682
## 2 | 2.371 | -2.248 8.457 0.899 | 0.471 1.195 0.040 | 0.536 3.066
## 3 | 1.501 | 0.832 1.158 0.307 | -1.205 7.807 0.644 | 0.323 1.116
## 4 | 1.574 | -0.243 0.099 0.024 | 1.486 11.876 0.891 | 0.455 2.210
## 5 | 1.971 | -1.546 4.001 0.616 | -0.829 3.698 0.177 | -0.889 8.454
## 7 | 1.654 | 1.239 2.567 0.561 | -1.087 6.359 0.432 | 0.058 0.036
## 8 | 3.096 | -3.028 15.343 0.957 | -0.484 1.260 0.024 | 0.368 1.450
## 9 | 1.721 | -1.485 3.691 0.744 | 0.721 2.795 0.175 | 0.478 2.439
## 10 | 2.747 | 2.732 12.482 0.989 | 0.151 0.123 0.003 | 0.238 0.604
## 11 | 1.718 | 0.654 0.715 0.145 | 0.986 5.229 0.329 | -1.244 16.544
## cos2
## 1 0.517 |
## 2 0.051 |
## 3 0.046 |
## 4 0.083 |
## 5 0.204 |
## 7 0.001 |
## 8 0.014 |
## 9 0.077 |
## 10 0.007 |
## 11 0.524 |
##
## Supplementary individual
## Dist Dim.1 cos2 Dim.2 cos2 Dim.3 cos2
## 6 | 4.757 | -1.780 0.140 | 4.385 0.850 | 0.375 0.006 |
##
## Variables
## Dim.1 ctr cos2 Dim.2 ctr cos2 Dim.3 ctr cos2
## Z1 | 0.820 24.745 0.672 | 0.145 2.478 0.021 | 0.554 72.122 0.307 |
## Z2 | 0.949 33.156 0.901 | 0.224 5.966 0.050 | -0.205 9.894 0.042 |
## Z3 | 0.953 33.415 0.908 | 0.097 1.124 0.009 | -0.276 17.968 0.076 |
## Z4 | -0.486 8.683 0.236 | 0.874 90.432 0.764 | -0.008 0.016 0.000 |On peut noter que la première composante semble fabriquée majoritairement avec les variables \(Z_1\), \(Z_2\) et \(Z_3\) (dans une moindre mesure pour \(Z_1\)), alors que la deuxième composante nous renseigne quasi exclusivement sur les valeurs de \(Z_4\). Cette propriété se comprend très bien lorsque l'on regarde le cercle des corrélations ci-dessous, qui indique que \(Z_4\) est quasiment orthogonale aux autres variables et renseigne donc sur une caractéristique très différente, alors que les 3 premières variables sont très liées entre elles. Pour l'interprétation des axes, on peut donc penser que les individus en haut du graphique seront ceux qui ont une grand valeur en \(Z_4\) en opposition à ceux du bas qui en auront une faible. Quand à la position sur l'axe horizontal, il indiquera une tendance à de grandes valeurs \(Z_1\), \(Z_2\) et \(Z_3\) à droite et des faibles à gauche. Projetons maintenant les individus pour voir si des structures apparaissent à la lumière de ces interprétations.
plot(res_acp, axes = c(1,2), choix = 'var')
plot(res_acp, axes = c(1,2), choix = 'ind')
Sur ce graph, nous pouvons voir une structure intéressante qui semble séparer deux groupes non homogènes, mais qui présentent tous deux un comportement similaire. Dans la partie gauche, le plus gros groupe associé aux faible valeurs de \(Z_1\), \(Z_2\) et \(Z_3\), et à droite le plus petit associé à de plus forte valeurs de ces variables. Dans chacun des groupes par contre, il semble qu'une augmentation des variables \(Z_1\), \(Z_2\) et \(Z_3\) est associé avec une hausse de la variable \(Z_4\) en même temps (car les individus vont vers le haut à mesure que l'on va vers la droite). Si il nous manque plus d'informations sur l'interprétation physique de ces variables, il n'est pas impossible de penser que l'on pourrait en fait avoir affaire à deux populations distinctes de papillons. Passons à l'AFC à présent, qui va traiter ces variables quantitatives discrètes comme si elles résultaient du comptage dans un tableau de contingence de différentes modalités d'une même variable. Comme précédemment, nous écartons le 6ème individu.
res_ca = CA(db, ncp = 3, row.sup = 6, graph = F)Intéressons nous tout d'abord au nombre d'axes via la variance expliquée. On voit ci dessous que si le premier axe exprime à lui seul une grosse partie de la variance, en considérant le deuxième axe 'gratuit', nous avons carrément 99%, soit la quasi totalité, de l'information disponible. Nous n'allons donc pas nous priver ici de considérer les deux premiers axes factoriels.
vp = res_ca$eig %>% data.frame %>% rownames_to_column(var = 'Composante') %>% as_tibble
ggplot(vp) + geom_col(aes(x = Composante, y = percentage.of.variance)) +
geom_point(aes(x = Composante, y = cumulative.percentage.of.variance)) +
ggtitle("Pourcentage de variance expliquée cumulée") +
geom_hline(aes(yintercept = 99), color = 'red')
Faisons une rapide vérification des contributions et représentations à l'aide d'un summary des premiers profils lignes et des profils colonnes.
summary(res_ca)##
## Call:
## CA(X = db, ncp = 3, row.sup = 6, graph = F)
##
## The chi square of independence between the two variables is equal to 16.2562 (p-value = 1 ).
##
## Eigenvalues
## Dim.1 Dim.2 Dim.3
## Variance 0.006 0.001 0.000
## % of var. 82.446 17.042 0.512
## Cumulative % of var. 82.446 99.488 100.000
##
## Rows (the 10 first)
## Iner*1000 Dim.1 ctr cos2 Dim.2 ctr cos2 Dim.3 ctr
## 1 | 0.147 | 0.025 0.453 0.180 | -0.053 9.995 0.820 | 0.001 0.115
## 2 | 0.611 | 0.115 9.681 0.922 | 0.031 3.365 0.066 | 0.013 20.283
## 3 | 0.380 | -0.090 6.266 0.959 | 0.018 1.213 0.038 | 0.004 2.230
## 4 | 0.297 | 0.076 4.682 0.917 | 0.022 1.999 0.081 | 0.003 1.361
## 5 | 0.131 | 0.023 0.368 0.163 | -0.051 8.968 0.821 | 0.007 6.045
## 7 | 0.440 | -0.098 7.521 0.994 | 0.004 0.052 0.001 | 0.007 5.809
## 8 | 0.459 | 0.105 7.442 0.943 | 0.023 1.695 0.044 | -0.012 16.132
## 9 | 0.411 | 0.093 6.533 0.924 | 0.026 2.492 0.073 | 0.005 3.184
## 10 | 0.392 | -0.087 6.617 0.984 | 0.011 0.503 0.015 | -0.003 1.081
## 11 | 0.213 | 0.022 0.407 0.111 | -0.063 15.731 0.886 | 0.003 1.557
## cos2
## 1 0.000 |
## 2 0.012 |
## 3 0.002 |
## 4 0.002 |
## 5 0.017 |
## 7 0.005 |
## 8 0.013 |
## 9 0.003 |
## 10 0.001 |
## 11 0.003 |
##
## Columns
## Iner*1000 Dim.1 ctr cos2 Dim.2 ctr cos2 Dim.3 ctr
## Z1 | 1.136 | -0.035 5.065 0.259 | 0.059 69.930 0.740 | 0.001 0.559
## Z2 | 0.453 | -0.029 5.030 0.646 | -0.020 11.847 0.315 | -0.007 48.820
## Z3 | 0.731 | -0.046 8.486 0.676 | -0.031 18.202 0.300 | 0.009 50.082
## Z4 | 4.739 | 0.162 81.419 1.000 | -0.001 0.022 0.000 | 0.001 0.539
## cos2
## Z1 0.000 |
## Z2 0.039 |
## Z3 0.025 |
## Z4 0.000 |
##
## Supplementary row
## Dim.1 cos2 Dim.2 cos2 Dim.3 cos2
## 6 | 0.249 0.993 | 0.017 0.004 | 0.013 0.003 |Nous voyons que les profils lignes sont soit bien représenté sur le premier axe, ou sur le deuxième mais jamais les deux la fois. Il semble qu'une claire distinction soit faite entre les composantes à ce niveau. En ce qui concerne les profils colonnes, le premier axe concentre toute l'information de \(Z_4\) et dans une moindre mesure de \(Z_2\) et \(Z_3\). Le deuxième axe quan à lui est majoritairement dirigé par \(Z_1\) avec une légère contribution de \(Z_2\) et \(Z_3\). Voyons ce qu'il en résulte dans l'analyse graphique à présent.
plot(res_ca, axes = c(1,2))
Sur l'analyse des profils lignes, nous pouvons encore une fois analyser la très forte opposition entre la variable \(Z_4\) et les autres. De manière plus faible, la variable \(Z_1\) se démarque du couple \(Z_2\)-\(Z_3\), chose qui n'apparaissait pas dans la précédente ACP, mais que l'on verrait bien en analysant une composante principale supplémentaire (voir le Bonus ci-dessous). Au niveau des profils lignes, là où l'ACP était relativement éparpillée, nous avons ici une constitution très nette de 3 groupes homogènes et distincts. En étant un peu caricatural, nous pourrions les nommer: fort \(Z_4\)/fort \(Z_1\) (en haut à droite), faible \(Z_4\)/fort \(Z_1\) (en haut à droite), modéré \(Z_4\)/faible \(Z_1\) (en bas). Le rôle exact de \(Z_2\) et \(Z_3\) est moins évident. Pour autant, il parait ici évident que notre hypothèse préalable de 2 espèces distinctes est mise à mal. L'AFC semble très clairement indiquer une structure en trois groupes.
Sur la question de la comparaison entre l'ACP et l'AFC sur cet exemple précis, nous serions tenter de considérer l'AFC comme plus appropriée ici. En effet, de part les résultats qui semblent plus clairs, et du fait que seulement deux axes ont suffit à donner une analyse très fine des données. Cependant, l'information globale qui ressort est en fait très similaire (ce qui est rassurant pour un même jeu de données), notamment lorsque l'on prend le temps d'analyser le troisième axe de l'ACP (comme proposé ci dessous). Rappellons nous que l'AFC n'est qu'un cas particulier d'ACP, qui est justement bien adapté pour analyser des tableaux de contigence, qui par définition contiennent des valeurs numériques discrètes. L'ACP est quelque part plus generale, et il n'est pas vraiment étonnant de voir que l'AFC fonctionne légèrement 'mieux' dans son cadre d'application idéale. Cependant, dans le cas de variables numériques continues, nous n'aurions de toute façon d'auter choix que d'effectuer une ACP. Pour finir, notez bien que cet exemple est majoritairement illustratif. Dans un cadre général, ces deux méthodes ne sont pas vraiment en concurence dans le sens où elles n'ont pas le même cadre d'application (variables quantitatives vs modalités de variables qualitatives, comme détaillé dans les exercices précédents).
Bonus: la 3ème composante principal de l'ACP
Comme souvent précisé en TP, la sélection du nombre d'axes en ACP ou AFC est avant tout une question de priorités et de temps que l'on souhaite consacrer à l'analyse. Pour atteindre 99% de variance expliquée, nous aurions pu selectionner un troisième axe dans notre ACP, suceptible de nous renseigner sur des caractéristiques plus subtiles du jeu de données, peut être ignorées jusque là. Nous voyons en effet dans le cercle des corrélations une nouvelle distinction qui est mise en avant. Si la variable Z_4 est quasiment ignorée, nous avons maintenant une nette opposition qui se dégage entre \(Z_1\) et le couple \(Z_2\)-\(Z_3\) selon la troisème composante principale, alors que la première les rassemblent toutes.
plot(res_acp, axes = c(1,3), choix = 'var')
Voyons sur ce plan factoriel composante1-composante3 si cette distinction dévoile de nouvelles structures de groupes parmi nos individus.
plot(res_acp, axes = c(1,3), choix = 'ind')
On voit en effet une nette opposition qui se créer en isolant un groupe de 6 individus en bas qui présentent de faible valeur de \(Z_1\) (dans une moindre mesure associée à de hautes valeurs de \(Z_2\) et \(Z_3\)). Le groupe du haut pour sa part présente des caractéristiques inverses. Sachant que l'on a déjà analysé la première composante principale, nous arrêtons l'analyse à ce nouvel aspect, qui révèle une information certes moins évidente, mais que l'on avait passé sous silence dans la première analyse 'rapide'.
Bien que les variables ne sont pas ici explicitées, nous pourrions imaginer dans un cas analogue pour les êtres humains, des variables \(Z_1\), \(Z_2\) et \(Z_3\) étant respectivement le poids, la taille et la taille des jambes. Si dans une analyse grossière, on pourrait imaginer que ces 3 variables soient très corrélées du fait que plus l'on est grand, plus généralement on pèse lourd, les deux dernières variables sont en fait bien plus corrélées entre elles qu'avec le poids, qui peut fluctuer. Dans un tel cas, nous aurions aussi probablement une distinction qui se ferait entre la variable poids et les variables de taille en regardant des 'petits' axes de l'ACP, associées à de plus faibles valeurs propres. Cet exemple est bien sûr fictif mais tente d'illustrer le phénomène observé ci-dessus avec des variables ne représentant rien de très concret dans le cas des papillons.