R Notebook ACM CAH types de lecteurs - Romain Orioli - Mémoire de M1

1. Préparation

Chargement de la base de données

# Ce chunk est désactivé dans la version publiée (le fichier .Rdata n'est pas accessible en ligne)
load("C:/ad.univ-lille.fr/Personnels/Homedir1/4273/Documents/Cours 2024-2025/Master 1 ENSP travail R/travailRmémoire/bddpond.Rdata")

Chargement des packages utiles

library(FactoMineR)
library(missMDA)
library(dplyr)
library(tidyverse)
library(tidyr)
library(explor)
library(factoextra)
library(ggplot2)
library(questionr)
library(gt)
library(explor)
library(gridExtra)
library(plotly)
library(ggrepel)
library(RColorBrewer)

Extrait de base de données pour l’ACM

resacm2 <- bddpond %>%
  select(CLASS_univprat_name, CRITAGE, SEXE, DIPLOMrecodebis,62:74, 77, 
         nb_livres_lus_4cl, freq_bibmed_rec, lire_autre_langue, manque_livre, 
         Supports, div_genre_rec) %>%
  rename(
    AGE = CRITAGE,
    Univ_pratiques = CLASS_univprat_name,
    Diplome = DIPLOMrecodebis,
    nb_livres_lus = nb_livres_lus_4cl,
    freq_biblio = freq_bibmed_rec,
    nb_genres_lus = div_genre_rec
  ) %>%
  mutate(across(c(Diplome, lire_autre_langue), as.character)) %>%
  mutate(across(c(Diplome, lire_autre_langue), ~ na_if(.x, "REF"))) %>%
  mutate(across(c(Diplome,  lire_autre_langue), ~ na_if(.x, "NSP"))) %>%
  mutate(
    lire_autre_langue = replace_na(lire_autre_langue, "Non"),
    manque_livre = replace_na(manque_livre, "Non"),
  ) %>%
  mutate(across(5:18, ~ replace_na(.x, 0))) %>%
  mutate(across(5:18, ~ case_when(
    .x == 0 ~ "Non",
    .x == 1 ~ "Oui",
    TRUE ~ as.character(.x)
  ))) %>%
  filter(!is.na(Diplome) & !is.na(freq_biblio)) %>%
  mutate(across(everything(), as.factor))

resacm2 <- readRDS("resacm2.rds")

2. ACM

Executons l’ACM. Les 4 premières variables et la dernière sont placées en variables supplémentaires illustratives

res.MCA <- MCA(resacm2, quali.sup = c(1,2,3,4,24), graph = FALSE)

Relevons les valeurs propres,l’inertie totale, les coordonnées, les contributions et les co2

summary(res.MCA)

## 
## Call:
## MCA(X = resacm2, quali.sup = c(1, 2, 3, 4, 24), graph = FALSE) 
## 
## 
## Eigenvalues
##                        Dim.1   Dim.2   Dim.3   Dim.4   Dim.5   Dim.6   Dim.7
## Variance               0.281   0.100   0.092   0.065   0.055   0.054   0.053
## % of var.             21.378   7.624   7.022   4.925   4.182   4.078   3.993
## Cumulative % of var.  21.378  29.002  36.024  40.949  45.131  49.209  53.202
##                        Dim.8   Dim.9  Dim.10  Dim.11  Dim.12  Dim.13  Dim.14
## Variance               0.052   0.049   0.046   0.044   0.042   0.041   0.038
## % of var.              3.917   3.750   3.502   3.368   3.187   3.130   2.875
## Cumulative % of var.  57.119  60.869  64.371  67.739  70.925  74.055  76.930
##                       Dim.15  Dim.16  Dim.17  Dim.18  Dim.19  Dim.20  Dim.21
## Variance               0.036   0.036   0.034   0.033   0.032   0.030   0.029
## % of var.              2.767   2.718   2.611   2.515   2.405   2.261   2.172
## Cumulative % of var.  79.697  82.415  85.025  87.540  89.945  92.206  94.378
##                       Dim.22  Dim.23  Dim.24  Dim.25
## Variance               0.028   0.028   0.014   0.004
## % of var.              2.160   2.101   1.054   0.307
## Cumulative % of var.  96.538  98.638  99.693 100.000
## 
## Individuals (the 10 first)
##                                  Dim.1    ctr   cos2    Dim.2    ctr   cos2  
## 1                             |  0.093  0.000  0.009 |  0.127  0.002  0.016 |
## 2                             | -0.565  0.012  0.362 |  0.018  0.000  0.000 |
## 3                             |  0.249  0.002  0.050 | -0.063  0.000  0.003 |
## 4                             | -0.247  0.002  0.081 |  0.126  0.002  0.021 |
## 5                             | -0.638  0.016  0.867 | -0.071  0.001  0.011 |
## 6                             | -0.638  0.016  0.867 | -0.071  0.001  0.011 |
## 7                             | -0.638  0.016  0.867 | -0.071  0.001  0.011 |
## 8                             | -0.364  0.005  0.339 |  0.058  0.000  0.009 |
## 9                             | -0.638  0.016  0.867 | -0.071  0.001  0.011 |
## 10                            | -0.264  0.003  0.139 | -0.072  0.001  0.010 |
##                                Dim.3    ctr   cos2  
## 1                             -0.144  0.002  0.021 |
## 2                              0.155  0.003  0.027 |
## 3                             -0.006  0.000  0.000 |
## 4                             -0.196  0.005  0.052 |
## 5                              0.225  0.006  0.108 |
## 6                              0.225  0.006  0.108 |
## 7                              0.225  0.006  0.108 |
## 8                             -0.277  0.009  0.196 |
## 9                              0.225  0.006  0.108 |
## 10                             0.004  0.000  0.000 |
## 
## Categories (the 10 first)
##                                   Dim.1     ctr    cos2  v.test     Dim.2
## lire_litt_class_Non           |  -0.294   1.305   0.362 -57.511 |   0.077
## lire_litt_class_Oui           |   1.233   5.477   0.362  57.511 |  -0.322
## lire_roman_policier_esp_Non   |  -0.363   1.678   0.280 -50.571 |  -0.034
## lire_roman_policier_esp_Oui   |   0.772   3.565   0.280  50.571 |   0.073
## lire_roman_SF_horreur_etc_Non |  -0.173   0.477   0.171 -39.450 |  -0.191
## lire_roman_SF_horreur_etc_Oui |   0.985   2.714   0.171  39.450 |   1.086
## lire_roman_hist_Non           |  -0.329   1.535   0.336 -55.346 |   0.121
## lire_roman_hist_Oui           |   1.019   4.746   0.336  55.346 |  -0.373
## lire_roman_sentiment_Non      |  -0.038   0.024   0.015 -11.578 |  -0.012
## lire_roman_sentiment_Oui      |   0.388   0.250   0.015  11.578 |   0.119
##                                   ctr    cos2  v.test     Dim.3     ctr    cos2
## lire_litt_class_Non             0.250   0.025  15.026 |  -0.106   0.521   0.048
## lire_litt_class_Oui             1.048   0.025 -15.026 |   0.447   2.188   0.048
## lire_roman_policier_esp_Non     0.042   0.002  -4.760 |   0.098   0.375   0.021
## lire_roman_policier_esp_Oui     0.089   0.002   4.760 |  -0.209   0.797   0.021
## lire_roman_SF_horreur_etc_Non   1.627   0.207 -43.500 |  -0.067   0.218   0.026
## lire_roman_SF_horreur_etc_Oui   9.253   0.207  43.500 |   0.382   1.242   0.026
## lire_roman_hist_Non             0.576   0.045  20.244 |  -0.012   0.006   0.000
## lire_roman_hist_Oui             1.781   0.045 -20.244 |   0.036   0.018   0.000
## lire_roman_sentiment_Non        0.006   0.001  -3.549 |   0.083   0.359   0.071
## lire_roman_sentiment_Oui        0.066   0.001   3.549 |  -0.854   3.686   0.071
##                                v.test  
## lire_litt_class_Non           -20.831 |
## lire_litt_class_Oui            20.831 |
## lire_roman_policier_esp_Non    13.705 |
## lire_roman_policier_esp_Oui   -13.705 |
## lire_roman_SF_horreur_etc_Non -15.293 |
## lire_roman_SF_horreur_etc_Oui  15.293 |
## lire_roman_hist_Non            -1.966 |
## lire_roman_hist_Oui             1.966 |
## lire_roman_sentiment_Non       25.453 |
## lire_roman_sentiment_Oui      -25.453 |
## 
## Categorical variables (eta2)
##                                 Dim.1 Dim.2 Dim.3  
## lire_litt_class               | 0.362 0.025 0.048 |
## lire_roman_policier_esp       | 0.280 0.002 0.021 |
## lire_roman_SF_horreur_etc     | 0.171 0.207 0.026 |
## lire_roman_hist               | 0.336 0.045 0.000 |
## lire_roman_sentiment          | 0.015 0.001 0.071 |
## lire_prix_litt                | 0.316 0.126 0.019 |
## lire_biographie               | 0.201 0.063 0.002 |
## lire_autre_roman_cont         | 0.304 0.078 0.003 |
## lire_BD                       | 0.211 0.230 0.025 |
## lire_Comics                   | 0.074 0.359 0.089 |
## 
## Supplementary categories (the 10 first)
##                                   Dim.1    cos2  v.test     Dim.2    cos2
## Bain audio                    |  -0.145   0.006  -7.205 |   0.216   0.013
## Culture patr                  |   0.453   0.041  19.328 |  -0.296   0.018
## Eclect augm                   |   0.608   0.034  17.663 |   0.728   0.049
## Eclect class                  |   1.106   0.155  37.592 |  -0.456   0.026
## Petit ecran                   |  -0.559   0.144 -36.241 |  -0.164   0.012
## Tout-num                      |  -0.404   0.020 -13.507 |   0.411   0.021
## 15-29 ans                     |  -0.005   0.000  -0.201 |   0.662   0.071
## 30-44 ans                     |  -0.009   0.000  -0.447 |   0.302   0.024
## 45-59 ans                     |   0.024   0.000   1.317 |  -0.055   0.001
## 60-74 ans                     |   0.031   0.000   1.789 |  -0.309   0.035
##                                v.test     Dim.3    cos2  v.test  
## Bain audio                     10.706 |  -0.444   0.053 -21.974 |
## Culture patr                  -12.653 |  -0.123   0.003  -5.245 |
## Eclect augm                    21.168 |   0.296   0.008   8.596 |
## Eclect class                  -15.492 |   0.315   0.013  10.722 |
## Petit ecran                   -10.653 |   0.086   0.003   5.565 |
## Tout-num                       13.745 |   0.246   0.007   8.234 |
## 15-29 ans                      25.490 |   0.191   0.006   7.362 |
## 30-44 ans                      14.924 |   0.001   0.000   0.034 |
## 45-59 ans                      -2.979 |  -0.002   0.000  -0.097 |
## 60-74 ans                     -17.997 |  -0.077   0.002  -4.476 |
## 
## Supplementary categorical variables (eta2)
##                                 Dim.1 Dim.2 Dim.3  
## Univ_pratiques                | 0.324 0.120 0.072 |
## AGE                           | 0.001 0.134 0.007 |
## SEXE                          | 0.029 0.040 0.021 |
## Diplome                       | 0.196 0.007 0.011 |
## nb_genres_lus                 | 0.830 0.027 0.355 |

fviz_screeplot(res.MCA, addlabels = TRUE, ylim = c(0, 30), title = "Décomposition de l'inertie totale")

Observons les coordonnées, les contributions et les cos2 des variables actives sur les 5 premières dimensions de l’ACM

round(res.MCA$var$coord,4)

##                                          Dim 1   Dim 2   Dim 3   Dim 4   Dim 5
## lire_litt_class_Non                    -0.2939  0.0768 -0.1064 -0.0550 -0.0075
## lire_litt_class_Oui                     1.2334 -0.3222  0.4467  0.2306  0.0317
## lire_roman_policier_esp_Non            -0.3632 -0.0342  0.0984  0.2819  0.0951
## lire_roman_policier_esp_Oui             0.7716  0.0726 -0.2091 -0.5988 -0.2020
## lire_roman_SF_horreur_etc_Non          -0.1732 -0.1910 -0.0671  0.0831  0.0089
## lire_roman_SF_horreur_etc_Oui           0.9848  1.0858  0.3818 -0.4725 -0.0507
## lire_roman_hist_Non                    -0.3295  0.1205 -0.0117 -0.0138  0.0100
## lire_roman_hist_Oui                     1.0189 -0.3727  0.0362  0.0425 -0.0311
## lire_roman_sentiment_Non               -0.0378 -0.0116  0.0832  0.1380 -0.0998
## lire_roman_sentiment_Oui                0.3884  0.1190 -0.8538 -1.4169  1.0249
## lire_prix_litt_Non                     -0.2538  0.1600 -0.0626  0.0192  0.0730
## lire_prix_litt_Oui                      1.2452 -0.7850  0.3072 -0.0940 -0.3583
## lire_biographie_Non                    -0.1992  0.1113  0.0218  0.0174 -0.0085
## lire_biographie_Oui                     1.0077 -0.5633 -0.1105 -0.0881  0.0431
## lire_autre_roman_cont_Non              -0.2924  0.1483 -0.0283  0.1003  0.0646
## lire_autre_roman_cont_Oui               1.0412 -0.5279  0.1008 -0.3570 -0.2301
## lire_BD_Non                            -0.2342 -0.2445 -0.0806 -0.0154  0.1268
## lire_BD_Oui                             0.8996  0.9391  0.3095  0.0593 -0.4872
## lire_Comics_Non                        -0.0648 -0.1422 -0.0709  0.0096  0.0372
## lire_Comics_Oui                         1.1492  2.5233  1.2580 -0.1698 -0.6593
## lire_Mangas_Non                        -0.0663 -0.1601 -0.0724  0.0128  0.0132
## lire_Mangas_Oui                         1.0413  2.5162  1.1376 -0.2017 -0.2081
## lire_essais_Non                        -0.2714  0.0083 -0.0384 -0.2649 -0.0706
## lire_essais_Oui                         0.9597 -0.0293  0.1359  0.9367  0.2496
## lire_livre_actu_Non                    -0.1891  0.0704  0.0197 -0.2009  0.0034
## lire_livre_actu_Oui                     0.9455 -0.3521 -0.0985  1.0046 -0.0168
## lire_beau_livre_Non                    -0.2214  0.0420 -0.0660 -0.1256  0.0453
## lire_beau_livre_Oui                     1.1808 -0.2242  0.3519  0.6698 -0.2417
## 0 livre                                -1.0927 -0.1750  0.7128  0.0524 -0.0585
## 1 à 9 livres                            0.1131  0.4286 -0.9592  0.1815  0.3406
## 10 à 19 livres                          0.6356 -0.0899 -0.2944  0.1584 -1.2723
## 20 livres et plus                       1.1258 -0.3556  0.6600 -0.5226  0.5591
## bibl_Au moins 1 fois par mois           0.9071 -0.2147  0.2713 -0.3773  0.4342
## bibl_Moins d'une fois par mois          0.4502  0.5109 -0.4065  0.5869 -0.1754
## bibl_Jamais                            -0.2830 -0.0250 -0.0038  0.0008 -0.0823
## NSP                                    -0.2091 -1.1888  0.7843  0.2650  6.2643
## lire_autre_langue_Non                  -0.1495 -0.0513 -0.0585 -0.0845 -0.1638
## lire_autre_langue_Oui                   1.0370  0.3561  0.4057  0.5863  1.1360
## manque_livre_Oui, beaucoup              0.9755 -0.4075  0.2635 -0.2842 -0.0274
## manque_livre_Oui, un peu                0.2860  0.6197 -1.2211  0.3552  0.0911
## manque_livre_Non                       -0.8168  0.0441  0.3012  0.0617 -0.0169
## Aucun_support                          -1.0951 -0.1762  0.7275  0.0410 -0.0554
## Papier_non_exclusif_ou_autres_supports  0.9409  0.7216  0.8427  0.1484  1.3365
## Papier_uniquement                       0.4556 -0.0019 -0.4964 -0.0413 -0.1471

round(res.MCA$var$contrib,4)

##                                         Dim 1   Dim 2   Dim 3   Dim 4   Dim 5
## lire_litt_class_Non                    1.3050  0.2498  0.5213  0.1981  0.0044
## lire_litt_class_Oui                    5.4771  1.0484  2.1877  0.8312  0.0185
## lire_roman_policier_esp_Non            1.6785  0.0417  0.3753  4.3878  0.5884
## lire_roman_policier_esp_Oui            3.5655  0.0886  0.7973  9.3209  1.2499
## lire_roman_SF_horreur_etc_Non          0.4773  1.6274  0.2184  0.4771  0.0065
## lire_roman_SF_horreur_etc_Oui          2.7139  9.2527  1.2418  2.7126  0.0368
## lire_roman_hist_Non                    1.5348  0.5758  0.0059  0.0116  0.0073
## lire_roman_hist_Oui                    4.7462  1.7806  0.0182  0.0359  0.0225
## lire_roman_sentiment_Non               0.0244  0.0064  0.3590  1.4095  0.8686
## lire_roman_sentiment_Oui               0.2505  0.0660  3.6856 14.4712  8.9180
## lire_prix_litt_Non                     1.0010  1.1155  0.1855  0.0248  0.4236
## lire_prix_litt_Oui                     4.9117  5.4734  0.9100  0.1216  2.0787
## lire_biographie_Non                    0.6196  0.5431  0.0227  0.0206  0.0058
## lire_biographie_Oui                    3.1352  2.7478  0.1148  0.1041  0.0293
## lire_autre_roman_cont_Non              1.2490  0.9004  0.0357  0.6374  0.3119
## lire_autre_roman_cont_Oui              4.4474  3.2062  0.1270  2.2696  1.1106
## lire_BD_Non                            0.8143  2.4881  0.2934  0.0154  1.2210
## lire_BD_Oui                            3.1279  9.5579  1.1272  0.0590  4.6904
## lire_Comics_Non                        0.0743  1.0049  0.2712  0.0070  0.1251
## lire_Comics_Oui                        1.3187 17.8269  4.8110  0.1250  2.2185
## lire_Mangas_Non                        0.0772  1.2648  0.2807  0.0126  0.0158
## lire_Mangas_Oui                        1.2139 19.8749  4.4108  0.1977  0.2478
## lire_essais_Non                        1.0745  0.0028  0.0656  4.4429  0.3717
## lire_essais_Oui                        3.7991  0.0099  0.2319 15.7092  1.3143
## lire_livre_actu_Non                    0.5576  0.2168  0.0184  2.7322  0.0009
## lire_livre_actu_Oui                    2.7879  1.0840  0.0922 13.6612  0.0045
## lire_beau_livre_Non                    0.7725  0.0781  0.2089  1.0788  0.1654
## lire_beau_livre_Oui                    4.1196  0.4165  1.1142  5.7536  0.8821
## 0 livre                                7.2407  0.5210  9.3808  0.0723  0.1061
## 1 à 9 livres                           0.0779  3.1385 17.0629  0.8709  3.6125
## 10 à 19 livres                         1.1879  0.0666  0.7761  0.3203 24.3322
## 20 livres et plus                      4.5808  1.2816  4.7940  4.2853  5.7757
## bibl_Au moins 1 fois par mois          2.6298  0.4131  0.7165  1.9748  3.0808
## bibl_Moins d'une fois par mois         0.4118  1.4869  1.0222  3.0373  0.3195
## bibl_Jamais                            1.0785  0.0237  0.0006  0.0000  0.4664
## NSP                                    0.0005  0.0488  0.0230  0.0037  2.4679
## lire_autre_langue_Non                  0.3656  0.1209  0.1704  0.5073  2.2429
## lire_autre_langue_Oui                  2.5355  0.8385  1.1816  3.5183 15.5563
## manque_livre_Oui, beaucoup             6.0388  2.9554  1.3417  2.2251  0.0244
## manque_livre_Oui, un peu               0.2899  3.8180 16.0919  1.9414  0.1504
## manque_livre_Non                       5.8840  0.0481  2.4356  0.1459  0.0129
## Aucun_support                          7.1505  0.5193  9.6085  0.0434  0.0935
## Papier_non_exclusif_ou_autres_supports 1.3160  2.1701  3.2140  0.1421 13.5747
## Papier_uniquement                      2.3374  0.0001  8.4488  0.0833  1.2456

round(res.MCA$var$cos2,4)

##                                         Dim 1  Dim 2  Dim 3  Dim 4  Dim 5
## lire_litt_class_Non                    0.3625 0.0247 0.0476 0.0127 0.0002
## lire_litt_class_Oui                    0.3625 0.0247 0.0476 0.0127 0.0002
## lire_roman_policier_esp_Non            0.2803 0.0025 0.0206 0.1688 0.0192
## lire_roman_policier_esp_Oui            0.2803 0.0025 0.0206 0.1688 0.0192
## lire_roman_SF_horreur_etc_Non          0.1706 0.2074 0.0256 0.0393 0.0005
## lire_roman_SF_horreur_etc_Oui          0.1706 0.2074 0.0256 0.0393 0.0005
## lire_roman_hist_Non                    0.3357 0.0449 0.0004 0.0006 0.0003
## lire_roman_hist_Oui                    0.3357 0.0449 0.0004 0.0006 0.0003
## lire_roman_sentiment_Non               0.0147 0.0014 0.0710 0.1955 0.1023
## lire_roman_sentiment_Oui               0.0147 0.0014 0.0710 0.1955 0.1023
## lire_prix_litt_Non                     0.3160 0.1256 0.0192 0.0018 0.0262
## lire_prix_litt_Oui                     0.3160 0.1256 0.0192 0.0018 0.0262
## lire_biographie_Non                    0.2007 0.0627 0.0024 0.0015 0.0004
## lire_biographie_Oui                    0.2007 0.0627 0.0024 0.0015 0.0004
## lire_autre_roman_cont_Non              0.3044 0.0783 0.0029 0.0358 0.0149
## lire_autre_roman_cont_Oui              0.3044 0.0783 0.0029 0.0358 0.0149
## lire_BD_Non                            0.2107 0.2296 0.0249 0.0009 0.0618
## lire_BD_Oui                            0.2107 0.2296 0.0249 0.0009 0.0618
## lire_Comics_Non                        0.0745 0.3589 0.0892 0.0016 0.0245
## lire_Comics_Oui                        0.0745 0.3589 0.0892 0.0016 0.0245
## lire_Mangas_Non                        0.0690 0.4029 0.0824 0.0026 0.0028
## lire_Mangas_Oui                        0.0690 0.4029 0.0824 0.0026 0.0028
## lire_essais_Non                        0.2605 0.0002 0.0052 0.2481 0.0176
## lire_essais_Oui                        0.2605 0.0002 0.0052 0.2481 0.0176
## lire_livre_actu_Non                    0.1788 0.0248 0.0019 0.2019 0.0001
## lire_livre_actu_Oui                    0.1788 0.0248 0.0019 0.2019 0.0001
## lire_beau_livre_Non                    0.2615 0.0094 0.0232 0.0841 0.0110
## lire_beau_livre_Oui                    0.2615 0.0094 0.0232 0.0841 0.0110
## 0 livre                                0.5726 0.0147 0.2436 0.0013 0.0016
## 1 à 9 livres                           0.0062 0.0887 0.4441 0.0159 0.0560
## 10 à 19 livres                         0.0753 0.0015 0.0162 0.0047 0.3018
## 20 livres et plus                      0.3034 0.0303 0.1043 0.0654 0.0748
## bibl_Au moins 1 fois par mois          0.1695 0.0095 0.0152 0.0293 0.0388
## bibl_Moins d'une fois par mois         0.0247 0.0318 0.0201 0.0420 0.0037
## bibl_Jamais                            0.2058 0.0016 0.0000 0.0000 0.0174
## NSP                                    0.0000 0.0009 0.0004 0.0000 0.0258
## lire_autre_langue_Non                  0.1551 0.0183 0.0237 0.0496 0.1861
## lire_autre_langue_Oui                  0.1551 0.0183 0.0237 0.0496 0.1861
## manque_livre_Oui, beaucoup             0.4884 0.0852 0.0356 0.0415 0.0004
## manque_livre_Oui, un peu               0.0191 0.0898 0.3485 0.0295 0.0019
## manque_livre_Non                       0.5949 0.0017 0.0809 0.0034 0.0003
## Aucun_support                          0.5609 0.0145 0.2476 0.0008 0.0014
## Papier_non_exclusif_ou_autres_supports 0.0764 0.0449 0.0613 0.0019 0.1542
## Papier_uniquement                      0.3138 0.0000 0.3726 0.0026 0.0327

Enfin, décrivons les axes. Pour chacun des 3 premiers axes, on peut observer le lien entre l’axe et les variables et entre l’axe et les modalités.

round(desc_axes$`Dim 1`$quali, 4)

##                               R2 p.value
## Univ_pratiques            0.3237  0.0000
## Diplome                   0.1957  0.0000
## lire_litt_class           0.3625  0.0000
## lire_roman_policier_esp   0.2803  0.0000
## lire_roman_SF_horreur_etc 0.1706  0.0000
## lire_roman_hist           0.3357  0.0000
## lire_prix_litt            0.3160  0.0000
## lire_biographie           0.2007  0.0000
## lire_autre_roman_cont     0.3044  0.0000
## lire_BD                   0.2107  0.0000
## lire_essais               0.2605  0.0000
## lire_livre_actu           0.1788  0.0000
## lire_beau_livre           0.2615  0.0000
## nb_livres_lus             0.6995  0.0000
## freq_biblio               0.2202  0.0000
## lire_autre_langue         0.1551  0.0000
## manque_livre              0.6527  0.0000
## Supports                  0.5774  0.0000
## nb_genres_lus             0.8302  0.0000
## lire_Comics               0.0745  0.0000
## lire_Mangas               0.0690  0.0000
## SEXE                      0.0290  0.0000
## lire_roman_sentiment      0.0147  0.0000
## AGE                       0.0014  0.0105

round(desc_axes$`Dim 2`$quali, 4)

##                               R2 p.value
## lire_roman_SF_horreur_etc 0.2074   0e+00
## lire_BD                   0.2296   0e+00
## lire_Comics               0.3589   0e+00
## lire_Mangas               0.4029   0e+00
## AGE                       0.1336   0e+00
## manque_livre              0.1300   0e+00
## lire_prix_litt            0.1256   0e+00
## Univ_pratiques            0.1198   0e+00
## nb_livres_lus             0.0954   0e+00
## lire_autre_roman_cont     0.0783   0e+00
## lire_biographie           0.0627   0e+00
## Supports                  0.0513   0e+00
## lire_roman_hist           0.0449   0e+00
## SEXE                      0.0396   0e+00
## freq_biblio               0.0376   0e+00
## nb_genres_lus             0.0267   0e+00
## lire_livre_actu           0.0248   0e+00
## lire_litt_class           0.0247   0e+00
## lire_autre_langue         0.0183   0e+00
## lire_beau_livre           0.0094   0e+00
## Diplome                   0.0070   0e+00
## lire_roman_policier_esp   0.0025   0e+00
## lire_roman_sentiment      0.0014   4e-04

round(desc_axes$`Dim 3`$quali, 4)

##                               R2 p.value
## nb_livres_lus             0.5620  0.0000
## manque_livre              0.3488  0.0000
## Supports                  0.3734  0.0000
## nb_genres_lus             0.3551  0.0000
## lire_Comics               0.0892  0.0000
## lire_Mangas               0.0824  0.0000
## lire_roman_sentiment      0.0710  0.0000
## Univ_pratiques            0.0718  0.0000
## lire_litt_class           0.0476  0.0000
## freq_biblio               0.0309  0.0000
## lire_roman_SF_horreur_etc 0.0256  0.0000
## lire_BD                   0.0249  0.0000
## lire_autre_langue         0.0237  0.0000
## lire_beau_livre           0.0232  0.0000
## SEXE                      0.0213  0.0000
## lire_roman_policier_esp   0.0206  0.0000
## lire_prix_litt            0.0192  0.0000
## Diplome                   0.0106  0.0000
## AGE                       0.0069  0.0000
## lire_essais               0.0052  0.0000
## lire_autre_roman_cont     0.0029  0.0000
## lire_biographie           0.0024  0.0000
## lire_livre_actu           0.0019  0.0000
## lire_roman_hist           0.0004  0.0493

3. Représentations graphiques de l’ACM

Représentons tout d’abord le nuage des individus en fonction de la qualité de leur représentation (cos2) sur la première dimension

plot.MCA(res.MCA,invisible= c('var','quali.sup'),selectMod= 'cos2 0',habillage='cos2',title="Graphe des individus par cos2 sur la dim1",label ='none')

On peut représenter le nuage des individus en fonction des modalités de chacune des variables illustratives.

quali_sup_indices <- c(1, 2, 3, 4, 24)

#on applique successivement à chaque variable supplémentaire le code du graphique grâce à une fonction
plots <- lapply(quali_sup_indices, function(i) {
  fviz_mca_ind(res.MCA, label = "none", habillage = i,axes=c(1,2), addEllipses = TRUE, 
               palette = "Dark2", title = paste("Projection des individus -", colnames(resacm2)[i])) #on utilise le nom des variables pour identifier chacun des futures graphiques
})

# On affiche les 5 graphiques en même temps (grâce à gridExtra)
library(gridExtra)
do.call(grid.arrange, c(plots, ncol = 2))  # affichage en 2 colonnes (l'affichage est plus "propre" en executant dans la console de Rstudio)

La librairie explor est utilisée pour visualiser les différents graphs, dont celui des modalités. On peut placer les labels dans explor et en récuperer les coordonnées sur le plan afin de l’insérer dans notre code. On peut alors générer le graph des modalités ed façon lisible.

#recuperer la position des labels
res <- explor::prepare_results(res.MCA)

#(ligne desactivée car faisant appel à un fichier local) label_df_supp<-read.csv("C:/ad.univ-lille.fr/Personnels/Homedir1/4273/Documents/Cours 2024-2025/Master 1 ENSP travail R/AGD/AGD/position_labels_ACM_supp.csv", sep=",", header=TRUE)

label_df_supp <- readRDS("label_df_supp.rds")

label_df_supp <- label_df_supp[label_df_supp$lab %in% rownames(res$var$coord), ]

# Fusionner les coordonnées avec res$var
res$var$coord[rownames(res$var$coord) %in% label_df_supp$lab, "Dim 1"] <- label_df_supp$lab_x
res$var$coord[rownames(res$var$coord) %in% label_df_supp$lab, "Dim 2"] <- label_df_supp$lab_y


explor::MCA_var_plot(res, xax = 1, yax = 2, var_sup = TRUE, var_sup_choice = c("Univ_pratiques",
                                                                               "AGE", "SEXE", "Diplome", "nb_genres_lus"), var_lab_min_contrib = 0, col_var = "Type",
                     symbol_var = "Variable", size_var = "Contrib", size_range = c(52.5, 700), #on utilise la contribution pour définir la taille des points pour les modalités actives
                     labels_size = 10, point_size = 56, transitions = TRUE, labels_positions = "auto",
                     labels_prepend_var = FALSE, xlim = c(-2.28, 2.35), ylim = c(-1.45, 3.19))

#la console indique un Avis relatif à des valeurs manquantes puisque par définition il n'y a pas de contribution pour les variables illustratives (elles n'ont pas contribué à la construction des axes)

On peut également générer le graph des variables

plot.MCA(res.MCA, choix='var',title="Graphe des variables")

4. CAH

Procédons maintenant à la CAH. La construction se fait sur les 13 premières dimensions (plus de 75% de l’inertie).

res.MCA<-MCA(resacm2,ncp=13,quali.sup=c(1,2,3,4,24),graph=FALSE)

Observons les gains d’inertie pour pouvoir choisir le nombre de classes que nous voulons contruire

res.HCPC<-HCPC(res.MCA,nb.clust=4,consol=TRUE,graph=FALSE) 
saveRDS(res.HCPC, "resHCPC.rds")

res.HCPC <- readRDS("resHCPC.rds")

inertie_gains <- res.HCPC$call$t$inert.gain

# Afficher les 10 premiers gains d'inertie
(inertie_gains_10 <- inertie_gains[1:10]) 

##  [1] 0.188984351 0.072570711 0.057385855 0.052654237 0.040052013 0.036109366
##  [7] 0.034546605 0.030733684 0.012491035 0.009421703

# Création du diagramme en barres des 10 premiers gains d'inertie
barplot(
  inertie_gains_10,
  names.arg = 1:10,
  col = "blue",
  main = "Gains d'inertie",
  xlab = "Étapes de fusion",
  ylab = "Gains d'inertie",
  border = "black"
)

L’observation des valeurs nous indique que le passage d’un groupement en 4 classes à 5 classes entraîne un saut d’inertie. On gardera donc 4 classes.

On peut maintenant faire la CAH en 4 classes que l’on consolidera avec la méthode des K-means

res.HCPC<-HCPC(res.MCA,nb.clust=4,consol=TRUE,graph=FALSE) 
saveRDS(res.HCPC, "resHCPC.rds")

res.HCPC <- readRDS("resHCPC.rds")

Les résultats sont visibles dans le dendrogramme

plot.HCPC(res.HCPC,choice='tree',title='Dendrogramme (arbre hiérarchique)')

4 clusters sont créés et on peut représenter le nuage des individus en fonction de leur appartenance aux clusters. On vérifie que la consolidation par la méthode des k-means a permis d’améliorer le ration inertie intra-classes/inertie totale

res.HCPC$call$bw.before.consol

## [1] 0.3189409

res.HCPC$call$bw.after.consol

## [1] 0.3645543

Maintenant que 4 clusters sont créés, on peut faire le nuage des individus par cluster

res.HCPC$data.clust$clust <- factor(res.HCPC$data.clust$clust,
                                    levels = c(1, 2, 3, 4),
                                    labels = c("non_lecteurs", "modérés", "attachés", "innovants"))

plot.HCPC(res.HCPC, choice = 'map', draw.tree = FALSE, label = "none",
          title = "Nuage des individus - représentation par cluster")

Puisque nous avons interprété les 3 premiers axes de l’ACM et que la CAH est liée à ces 3 premiers axes on peut représenter les individus dans un graphique à 3 dimensions

res.HCPC <- HCPC(res.MCA, nb.clust = 4, consol = TRUE, graph = FALSE)
saveRDS(res.HCPC, "resHCPC.rds")

res.HCPC <- readRDS("resHCPC.rds")

# Créer ind_3d avant de renommer
ind_3d <- as.data.frame(res.MCA$ind$coord[, 1:3])
colnames(ind_3d)[1:3] <- c("Dim.1", "Dim.2", "Dim.3")
ind_3d$cluster <- res.HCPC$data.clust$clust  # ne pas factoriser ici

# Ensuite, renommer les clusters (dans l'objet ind_3d)
ind_3d$cluster <- factor(ind_3d$cluster,
                         levels = c(1, 2, 3, 4),
                         labels = c("non_lecteurs", "modérés", "attachés", "innovants"))

plot_ly(ind_3d, 
        x = ~Dim.1, y = ~Dim.2, z = ~Dim.3,
        color = ~cluster, 
        colors = brewer.pal(4, "Paired"),  # ou "Dark2", "Paired"
        type = "scatter3d", 
        mode = "markers",
        marker = list(size = 3, opacity = 0.7)) %>%
  layout(title = "Nuage des individus en 3D (3 premiers axes de l'ACM)",
         scene = list(xaxis = list(title = "Dim 1"),
                      yaxis = list(title = "Dim 2"),
                      zaxis = list(title = "Dim 3")))

On peut, si on le souhaite, ajouter les modalités des variables illustratives sur ce graph (mais cela donne un rendu trop chargé pour être vraiment lisible, même en diminuant la taille de la police (cex) ou en changeant la couleur (col). On pourrait n’en selectionner que quelques unes si nécessaire.)

plot.HCPC(res.HCPC,choice='map',draw.tree=FALSE,label="none",title="")

# On extrait les coordonnées des variables supplémentaires depuis res.MCA
points(res.MCA$quali.sup$coord[, 1], 
       res.MCA$quali.sup$coord[, 2], 
       col = "blue", 
       pch = 17, 
       cex = 1.5)

# Ajouter les noms des variables supplémentaires
text(res.MCA$quali.sup$coord[, 1], 
     res.MCA$quali.sup$coord[, 2], 
     labels = rownames(res.MCA$quali.sup$coord), 
     col = "blue", 
     pos = 3,
     cex=0.7)

Enfin, on peut représenter le dendrogramme sur le nuage des individus par cluster

plot.HCPC(res.HCPC,choice='3D.map',ind.names=FALSE,centers.plot=FALSE,angle=60,title='Arbre hiérarchique sur le plan factoriel')

5. Description des classes

Il nous reste à décrire les différentes classes. Pour cela on peut faire apparaitre les parangons (les individus les plus proches des barycentres des classes) et les individus spécifiques (les plus éloignés des barycentres des autres classes)

res.HCPC[["desc.ind"]][["para"]] 

## Cluster: 1
##          5         13          7         20         38 
## 0.04471245 0.04471245 0.04471245 0.04471245 0.04471245 
## ------------------------------------------------------------ 
## Cluster: 2
##        29       652      1486      2146      2968 
## 0.2916843 0.2916843 0.2916843 0.2916843 0.2916843 
## ------------------------------------------------------------ 
## Cluster: 3
##      2730      4670      1262       896      4334 
## 0.4221771 0.4236065 0.4462308 0.4463776 0.4506146 
## ------------------------------------------------------------ 
## Cluster: 4
##      8039      1529      5688      8496       325 
## 0.6264914 0.6321507 0.6452965 0.6464680 0.6628149

res.HCPC[["desc.ind"]][["dist"]]

## Cluster: 1
##     7057     8698     9055     1996     5639 
## 8.971239 8.971239 8.971239 8.970236 1.340770 
## ------------------------------------------------------------ 
## Cluster: 2
##     5237     1136     8676     4468     7577 
## 9.006375 1.665748 1.616197 1.595544 1.564783 
## ------------------------------------------------------------ 
## Cluster: 3
##     3581     8648     4358     6995     7635 
## 9.116292 1.957113 1.946723 1.917778 1.888101 
## ------------------------------------------------------------ 
## Cluster: 4
##      313     1713     1689     4958     6864 
## 2.154252 2.145453 2.102219 2.090405 2.087657

L’ensemble des valeurs qu’il faut analyser pour caractériser les classes sont accessibles

summary(res.HCPC)

##            Length Class      Mode
## data.clust 25     data.frame list
## desc.var    3     catdes     list
## desc.axes   3     catdes     list
## desc.ind    2     -none-     list
## call        8     -none-     list

Dans res.HPCP on peut avoir accès à toutes les données utiles pour l’analyse et notamment:

-les liens entre les dimensions de l’ACM et la classification (les Eta2 nous donnent les rapports de correlation. On s’aperçoit que seuls les 3 premiers axes sont vraiment reliés à la CAH)

round(res.HCPC$desc.axes$quanti.var, 4)

##          Eta2 P-value
## Dim.1  0.8318       0
## Dim.2  0.6389       0
## Dim.3  0.6542       0
## Dim.11 0.0338       0
## Dim.6  0.0275       0
## Dim.5  0.0199       0
## Dim.9  0.0148       0
## Dim.12 0.0066       0
## Dim.4  0.0048       0
## Dim.8  0.0045       0
## Dim.7  0.0034       0
## Dim.13 0.0030       0
## Dim.10 0.0030       0

-le lien entre les cluster et les variables -le lien entre les modalités et les variables (on regardera la p-value et la valeur test puis, si cela est concluant, on pourra comparer la distribution de la modalité dans le cluster par rapport à sa distribution dans l’ensemble es individus)

desc_modalites <- res.HCPC$desc.var$category

modalites_clust1 <- as.data.frame(desc_modalites$`1`) #on extrait les résultats pour le seul cluster 1 (ce n'est pas nécessaire mais c'est pour que ça ne se tronque pas dans le Notebook). On répètera l'opération pour les 3 autres clusters

modalites_clust1$p.value <- round(modalites_clust1$p.value, 4) #on arrondit la p-value à 4 décimales pour une meilleure visibilité

modalites_clust1

On peut faire la même chose pour les 3 autres clusters

modalites_clust2 <- as.data.frame(desc_modalites$`2`) 
modalites_clust2$p.value <- round(modalites_clust2$p.value, 4) 
modalites_clust2

modalites_clust3 <- as.data.frame(desc_modalites$`3`) 
modalites_clust3$p.value <- round(modalites_clust3$p.value, 4) 
modalites_clust3

modalites_clust4 <- as.data.frame(desc_modalites$`4`) 
modalites_clust4$p.value <- round(modalites_clust4$p.value, 4) 
modalites_clust4

Une fois l’analyse faite des modalités caractéristiques de chaque cluster, on peut de nouveau représenter le graph des individus en ajoutant ces modalités

# Liste des modalités sélectionnées
modalites_noms <- unique(c(
  "0 livre", "Aucun_support", "manque_livre_Non", "bibl_Jamais",
  "1 à 9 livres", "Papier_uniquement", "manque_livre_Oui, un peu", "lire_Mangas_Non",
  "lire_Comics_Non", "lire_roman_sentiment_Oui", "10 à 19 livres", "lire_prix_litt_Oui",
  "lire_autre_roman_cont_Oui", "lire_roman_hist_Oui", "lire_litt_class_Oui",
  "manque_livre_Oui, beaucoup", "Papier_non_exclusif_ou_autres_supports",
  "bibl_Au moins 1 fois par mois", "lire_Comics_Oui", "lire_Mangas_Oui",
  "lire_roman_SF_horreur_etc_Oui", "lire_BD_Oui", "20 livres et plus","lire_autre_langue_Oui"
))

# Garder seulement les modalités valides présentes dans l'ACM (cela pour éviter tout erreur)
modalites_noms <- modalites_noms[modalites_noms %in% rownames(res.MCA$var$coord)]

# Extraction des coordonnées des modalités
modalites_df <- as.data.frame(res.MCA$var$coord[modalites_noms, ])
modalites_df$label <- rownames(modalites_df)

# Coordonnées des individus + correction des noms des clusters 
ind_coord <- as.data.frame(res.MCA$ind$coord)
ind_coord$cluster <- factor(res.HCPC$data.clust$clust,
                            levels = c(1, 2, 3, 4),
                            labels = c("non_lecteurs", "modérés", "attachés", "innovants"))

# Renommer les colonnes pour ggplot
colnames(ind_coord)[1:2] <- c("Dim.1", "Dim.2")
colnames(modalites_df)[1:2] <- c("Dim.1", "Dim.2")

# Graphique
ggplot(ind_coord, aes(x = Dim.1, y = Dim.2, color = cluster)) +
  geom_point(alpha = 0.5) +
  geom_label_repel(data = modalites_df,
                   mapping = aes(x = Dim.1, y = Dim.2, label = label),
                   fill = "white",
                   color = "black",
                   alpha = 0.6,
                   size = 3,
                   label.padding = 0.15) +
  scale_color_viridis_d(option = "D") +
  labs(title = "Nuage des individus colorés par cluster et modalités caractéristiques",
       x = "Dimension 1", y = "Dimension 2", color = "Cluster") +
  theme_minimal()