1. Préparation

On charge la base de données d’où on extraiera les variables de l’ACM ###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")

###Library

library(FactoMineR)
library(missMDA)
## Warning: le package 'missMDA' a été compilé avec la version R 4.4.3
library(dplyr)
library(tidyverse)
## Warning: le package 'lubridate' a été compilé avec la version R 4.4.2
library(tidyr)
library(explor)
library(factoextra)
## Warning: le package 'factoextra' a été compilé avec la version R 4.4.2
library(ggplot2)
library(questionr)
library(gt)
library(explor)
library(gridExtra)
library(plotly)
## Warning: le package 'plotly' a été compilé avec la version R 4.4.3
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")
  1. ACM

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

###ACM

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

###Valeurs propres et inertie totale

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 premières dimensions de l’ACM ###Contributions et cos2 - modalités actives

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.

###r2 et p-value

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
  1. Représentations graphiques

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

###graph des individus - Axes 1 et 2

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')

###graph des individus en fonction des 5 variables illustratives - Axes 1 et 2

# on crée une liste des variables supplémentaires
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. explor(res.MCA)

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.

###ACM - Nuage des modalités

#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))
## Warning in scatterD3::scatterD3(x = var_data[, "Coord.x"], y = var_data[, : NA
## values in size_var. Values set to min(0, size_var)
#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 représenter le graph des variables

###ACM - graph des variables

plot.MCA(res.MCA, choix='var',title="Graphe des variables")
## Warning: ggrepel: 12 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps

  1. CAH

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

Construction de la CAH

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 ###CAH - Gains d’inertie

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 ###Création des 4 clusters

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 ###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 ###graph des individus par cluster - Axes et 2

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

###graph des individus en 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 (sur ind_3d uniquement !)
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.)

###Nuage des individus (axes 1 et 2) avec modalités quali supp.

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

###Dendrogramme projeté sur le nuage des individus

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

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)

###Parangons et individus spécifiques

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)

###liens ACM et classification

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)

#modalités caractéristiques des clusters

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

Modalités caractéristiques du cluster 2

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

Modalités caractéristiques du cluster 3

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

Modalités caractéristiques du cluster 4

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 avec ces modalités

###nuage des individus par cluster+ modalités caractéristiques

# 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
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 + clusters (corrigé)
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()