TD Analyse des profils des pays en économie du travail
Jérémie KPOGHOMOU
2026-02-23
#knitr::opts_chunk$set(echo = TRUE, message=FALSE, warning=FALSE)# Chargement des packages nécessaires
library(tidyverse) # Manipulation et visualisation de données## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.2.0 ✔ readr 2.2.0
## ✔ forcats 1.0.1 ✔ stringr 1.6.0
## ✔ ggplot2 4.0.2 ✔ tibble 3.3.1
## ✔ lubridate 1.9.5 ✔ tidyr 1.3.2
## ✔ purrr 1.2.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(FactoMineR) # Analyses factorielles (ACP, etc.)
library(factoextra) # Visualisation des résultats d'ACP## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBalibrary(corrplot) # Visualisation des matrices de corrélation## corrplot 0.95 loadedlibrary(data.table) # Pour fread() - IMPORTANT: ajouté pour corriger l'erreur##
## Attachement du package : 'data.table'
##
## Les objets suivants sont masqués depuis 'package:lubridate':
##
## hour, isoweek, isoyear, mday, minute, month, quarter, second, wday,
## week, yday, year
##
## Les objets suivants sont masqués depuis 'package:dplyr':
##
## between, first, last
##
## L'objet suivant est masqué depuis 'package:purrr':
##
## transposelibrary(tinytex)
# Option pour éviter la notation scientifique
options(scipen = 999)1. Présentation des variables
Variables de la base
salmoyPPP : salaire annuel moyen en parité de pouvoir d’achat (dollar US)
ecart : écart salarial hommes/femmes (% du salaire médian)
d9_d1 : rapport interdéciles D9/D1 (mesure des inégalités salariales)
tx_chom : taux de chômage (% population active 15–64 ans)
tx_inact : taux d’inactivité (% population 15–64 ans)
heures : nombre moyen d’heures annuelles travaillées
tx_syndic : taux de syndicalisation
empl_jeunes : taux d’emploi des 15–19 ans
empl_age : taux d’emploi des plus de 65 ans
protec : indice de protection de l’emploi (CDI)
UE : appartenance à l’Union Européenne (0/1)
Objectif : classifier les pays selon leur profil en économie du travail.
1. Importation et description des données
Le fichier travail.csv a été importé dans R et nommé my_data.
#knitr::opts_chunk$set(echo = TRUE, message=FALSE, warning=FALSE)my_data <- fread("C:/Users/USER/Desktop/Cours/Data/travail.csv",
encoding = "UTF-8")
# Vérification de la structure des données
str(my_data)## Classes 'data.table' and 'data.frame': 32 obs. of 12 variables:
## $ Pays : chr "Australie" "Autriche" "Belgique" "Canada" ...
## $ salmoyPPP : num 49126 50349 49675 47622 25879 ...
## $ ecart : num 14.3 15.7 3.7 18.2 21.1 ...
## $ d9_d1 : num 3.32 3.27 2.41 3.61 4.32 ...
## $ tx_chom : num 5.76 5.58 7.15 6.39 7.01 ...
## $ tx_inact : num 22.6 23.6 32 21.5 32.6 ...
## $ heures : num 1676 1487 1546 1695 1954 ...
## $ tx_syndic : num 14.6 26.9 54.2 26.3 17.7 ...
## $ empl_jeunes: num 43.7 31.8 6 41.6 10.4 ...
## $ empl_age : num 12.81 4.8 2.52 13.49 24.13 ...
## $ protec : num 1.667 2.369 1.893 0.921 2.627 ...
## $ UE : int 0 1 1 0 0 1 1 1 0 1 ...
## - attr(*, ".internal.selfref")=<externalptr># Exploration rapide des données
dim(my_data)## [1] 32 12head(my_data)## Pays salmoyPPP ecart d9_d1 tx_chom tx_inact
## <char> <num> <num> <num> <num> <num>
## 1: Australie 49125.87 14.286311 3.324824 5.759536 22.55099
## 2: Autriche 50348.94 15.670900 3.271053 5.578426 23.57500
## 3: Belgique 49675.00 3.701299 2.409763 7.147249 31.97500
## 4: Canada 47621.84 18.221154 3.605346 6.394011 21.54332
## 5: Chili 25878.95 21.052632 4.318182 7.008574 32.59680
## 6: R\xe9publiquetch\xe8que 25372.04 15.614011 3.453708 2.940991 24.10000
## heures tx_syndic empl_jeunes empl_age protec UE
## <num> <num> <num> <num> <num> <int>
## 1: 1675.9 14.62790 43.652034 12.810401 1.6666666 0
## 2: 1487.0 26.92521 31.817148 4.799532 2.3690476 1
## 3: 1546.0 54.23405 5.996652 2.519975 1.8928572 1
## 4: 1695.0 26.29624 41.623341 13.491795 0.9206349 0
## 5: 1954.0 17.69605 10.410969 24.130476 2.6269841 0
## 6: 1776.0 10.47115 4.978073 6.347621 2.9246032 1summary(my_data)## Pays salmoyPPP ecart d9_d1
## Length:32 Min. :15314 Min. : 3.403 Min. :2.250
## Class :character 1st Qu.:26801 1st Qu.: 8.811 1st Qu.:2.817
## Mode :character Median :42678 Median :13.768 Median :3.298
## Mean :40955 Mean :13.270 Mean :3.273
## 3rd Qu.:49843 3rd Qu.:15.871 3rd Qu.:3.637
## Max. :63062 Max. :34.617 Max. :5.066
## tx_chom tx_inact heures tx_syndic
## Min. : 2.910 Min. :11.35 Min. :1356 Min. : 4.487
## 1st Qu.: 4.386 1st Qu.:21.68 1st Qu.:1514 1st Qu.:12.446
## Median : 5.669 Median :24.71 Median :1691 Median :17.494
## Mean : 6.641 Mean :25.18 Mean :1667 Mean :26.319
## 3rd Qu.: 7.057 3rd Qu.:29.07 3rd Qu.:1759 3rd Qu.:28.922
## Max. :21.653 Max. :36.61 Max. :2257 Max. :85.518
## empl_jeunes empl_age protec UE
## Min. : 2.640 Min. : 2.048 Min. :0.2567 Min. :0.0000
## 1st Qu.: 6.646 1st Qu.: 4.530 1st Qu.:1.6488 1st Qu.:0.0000
## Median :17.438 Median : 9.952 Median :2.1389 Median :1.0000
## Mean :22.572 Mean :12.308 Mean :2.0227 Mean :0.5938
## 3rd Qu.:33.427 3rd Qu.:18.470 3rd Qu.:2.3730 3rd Qu.:1.0000
## Max. :68.621 Max. :38.177 Max. :3.1845 Max. :1.0000# Vérification des types de variables
sapply(my_data, class)## Pays salmoyPPP ecart d9_d1 tx_chom tx_inact
## "character" "numeric" "numeric" "numeric" "numeric" "numeric"
## heures tx_syndic empl_jeunes empl_age protec UE
## "numeric" "numeric" "numeric" "numeric" "numeric" "integer"Graphiques descriptifs
• Construire des tableaux et graphiques descriptifs pour chacune des variables de l’étude.
# Histogrammes pour toutes les variables numériques
my_data %>%
select(where(is.numeric), -UE) %>% # Exclut UE (variable binaire)
pivot_longer(everything()) %>%
ggplot(aes(x = value)) +
geom_histogram(bins = 20, fill = "steelblue", color = "white") +
facet_wrap(~name, scales = "free") +
labs(title = "Distribution des variables",
x = "Valeur", y = "Fréquence") +
theme_minimal()
Les lignes représentent les pays et les colonnes les variables
quantitatives décrivant le marché du travail.
Une première analyse descriptive (moyenne, écart-type, minimum, maximum) montre :
• salmoyPPP: Une forte hétérogénéité des salaires moyens . • d9_d1, ecart: Des écarts marqués d’inégalités salariales. • tx_chom et d’inactivité tx_inact: Des disparités importantes de chômage. • protec: Une variabilité notable de la protection de l’emploi.
Les histogrammes révèlent que certaines variables présentent une asymétrie à droite (notamment salmoyPPP et d9_d1).
Établir et commenter la matrice des corrélations
Matrice des corrélations
# Sélection des variables numériques (sans UE)
num_data <- my_data %>% select(where(is.numeric), -UE)
# Calcul de la matrice de corrélation
cor_mat <- cor(num_data, use = "complete.obs")
round(cor_mat, 2)## salmoyPPP ecart d9_d1 tx_chom tx_inact heures tx_syndic empl_jeunes
## salmoyPPP 1.00 -0.17 -0.29 -0.23 -0.52 -0.69 0.46 0.63
## ecart -0.17 1.00 0.48 -0.31 -0.14 0.30 -0.36 0.01
## d9_d1 -0.29 0.48 1.00 -0.15 0.29 0.57 -0.58 -0.20
## tx_chom -0.23 -0.31 -0.15 1.00 0.32 0.12 -0.02 -0.41
## tx_inact -0.52 -0.14 0.29 0.32 1.00 0.62 -0.37 -0.74
## heures -0.69 0.30 0.57 0.12 0.62 1.00 -0.53 -0.42
## tx_syndic 0.46 -0.36 -0.58 -0.02 -0.37 -0.53 1.00 0.40
## empl_jeunes 0.63 0.01 -0.20 -0.41 -0.74 -0.42 0.40 1.00
## empl_age 0.01 0.52 0.23 -0.44 -0.30 0.32 0.15 0.40
## protec -0.30 -0.11 -0.27 0.16 0.16 -0.11 0.09 -0.29
## empl_age protec
## salmoyPPP 0.01 -0.30
## ecart 0.52 -0.11
## d9_d1 0.23 -0.27
## tx_chom -0.44 0.16
## tx_inact -0.30 0.16
## heures 0.32 -0.11
## tx_syndic 0.15 0.09
## empl_jeunes 0.40 -0.29
## empl_age 1.00 -0.22
## protec -0.22 1.00Matrice des corrélations
Plus visuel
# Visualisation 1: heatmap avec ggplot2
cor_df <- as.data.frame(as.table(cor_mat))
ggplot(cor_df, aes(Var1, Var2, fill = Freq)) +
geom_tile() +
scale_fill_gradient2(low = "blue", high = "red", mid = "white",
midpoint = 0, limit = c(-1,1)) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(title = "Matrice de corrélation", fill = "Corrélation")
# Visualisation 2: avec corrplot (plus détaillée)
corrplot(cor_mat, method = "color", type = "upper", order = "hclust",
tl.col = "black", tl.srt = 45, addCoef.col = "black", number.cex = 0.7)
Autre méthode de corrélation 2 à 2
# Correction des problèmes d'encodage si nécessaire
if("Pays" %in% colnames(my_data)) {
my_data$Pays <- iconv(my_data$Pays, from = "latin1", to = "UTF-8")
}
# Graphique salaire vs chômage
if("Pays" %in% colnames(my_data)) {
ggplot(my_data, aes(x = salmoyPPP, y = tx_chom, label = Pays)) +
geom_point() +
geom_text(size = 3, vjust = -0.5, check_overlap = TRUE) +
theme_minimal() +
labs(title = "Relation entre salaire moyen et taux de chômage",
x = "Salaire moyen (PPP)", y = "Taux de chômage")
}
# Version avec ggrepel (si installé)
# if(require(ggrepel)) {
# ggplot(my_data, aes(x = salmoyPPP, y = tx_chom, label = Pays)) +
# geom_point() +
# geom_text_repel(size = 3) +
# theme_minimal()
# }
# Graphique emploi jeunes vs chômage
if("Pays" %in% colnames(my_data)) {
ggplot(my_data, aes(x = empl_jeunes, y = tx_chom, label = Pays)) +
geom_point() +
geom_text(size = 2, vjust = -0.5, check_overlap = TRUE) +
theme_minimal() +
labs(title = "Relation entre emploi des jeunes et taux de chômage")
}
# Graphique emploi âgés vs chômage
if("Pays" %in% colnames(my_data)) {
ggplot(my_data, aes(x = empl_age, y = tx_chom, label = Pays)) +
geom_point() +
geom_text(size = 2, vjust = -0.5, check_overlap = TRUE) +
theme_minimal() +
labs(title = "Relation entre emploi des seniors et taux de chômage")
}
sapply(my_data, class)## Pays salmoyPPP ecart d9_d1 tx_chom tx_inact
## "character" "numeric" "numeric" "numeric" "numeric" "numeric"
## heures tx_syndic empl_jeunes empl_age protec UE
## "numeric" "numeric" "numeric" "numeric" "numeric" "integer"#——————–Allez plus loin—————#
Méthode de justification de la corrélation
# Test de normalité de Shapiro-Wilk
# H0: la distribution est normale
# Si p-value < 0.05, on rejette H0 (distribution non normale)
shapiro.test(num_data$salmoyPPP)##
## Shapiro-Wilk normality test
##
## data: num_data$salmoyPPP
## W = 0.95386, p-value = 0.1853My_Data <- my_data
# apply(num_data, 2, shapiro.test)
# Transformation logarithmique pour normaliser certaines variables
My_Data$d9_d1_log <- log(My_Data$d9_d1)
My_Data$salmoyPPP_log <- log(My_Data$salmoyPPP)
# Toutes les variables
# apply(my_data[, -which(colnames(my_data)=="UE")], 2, shapiro.test)Pourquoi ?
Le test de Shapiro vérifie si les données suivent une distribution normale. Une variable qualitative n’a pas de distribution continue, donc le test n’a aucun sens statistique.
Exemple sur d’autres variables
| Type | Exemple |
|---|---|
| Quantitative continue | Salaire, âge, taux de chômage |
| Quantitative discrète | Nombre d’enfants |
| Qualitative nominale | Sexe, pays |
| Qualitative ordinale | Niveau d’étude |
Résumé global
| Variables | Test paramétrique | Test non paramétrique |
|---|---|---|
| Quant ↔︎ Quant | Pearson | Spearman |
| Quant ↔︎ Qual (2) | t-test | Wilcoxon |
| Quant ↔︎ Qual (>2) | ANOVA | Kruskal |
| Qual ↔︎ Qual | Chi² | Fisher |
# Analyse de la relation entre salmoyPPP et UE
# salmoyPPP (quantitative) vs UE (qualitative binaire)
# Test de normalité pour salmoyPPP
shapiro.test(my_data$salmoyPPP)##
## Shapiro-Wilk normality test
##
## data: my_data$salmoyPPP
## W = 0.95386, p-value = 0.1853# Conversion de UE en facteur
my_data$UE <- as.factor(my_data$UE)
# Test d'homogénéité des variances (condition pour le t-test)
if(require(car)) {
car::leveneTest(salmoyPPP ~ UE, data = my_data)
}## Le chargement a nécessité le package : car## Le chargement a nécessité le package : carData##
## Attachement du package : 'car'## L'objet suivant est masqué depuis 'package:dplyr':
##
## recode## L'objet suivant est masqué depuis 'package:purrr':
##
## some## Levene's Test for Homogeneity of Variance (center = median)
## Df F value Pr(>F)
## group 1 0.0319 0.8595
## 30# Test de Student (paramétrique)
t.test(salmoyPPP ~ UE, data = my_data)##
## Welch Two Sample t-test
##
## data: salmoyPPP by UE
## t = 1.2031, df = 24.046, p-value = 0.2407
## alternative hypothesis: true difference in means between group 0 and group 1 is not equal to 0
## 95 percent confidence interval:
## -4091.673 15531.634
## sample estimates:
## mean in group 0 mean in group 1
## 44351.71 38631.72# Vérification de la structure
str(my_data)## Classes 'data.table' and 'data.frame': 32 obs. of 12 variables:
## $ Pays : chr "Australie" "Autriche" "Belgique" "Canada" ...
## $ salmoyPPP : num 49126 50349 49675 47622 25879 ...
## $ ecart : num 14.3 15.7 3.7 18.2 21.1 ...
## $ d9_d1 : num 3.32 3.27 2.41 3.61 4.32 ...
## $ tx_chom : num 5.76 5.58 7.15 6.39 7.01 ...
## $ tx_inact : num 22.6 23.6 32 21.5 32.6 ...
## $ heures : num 1676 1487 1546 1695 1954 ...
## $ tx_syndic : num 14.6 26.9 54.2 26.3 17.7 ...
## $ empl_jeunes: num 43.7 31.8 6 41.6 10.4 ...
## $ empl_age : num 12.81 4.8 2.52 13.49 24.13 ...
## $ protec : num 1.667 2.369 1.893 0.921 2.627 ...
## $ UE : Factor w/ 2 levels "0","1": 1 2 2 1 1 2 2 2 1 2 ...
## - attr(*, ".internal.selfref")=<externalptr># Si non normalité, test de Wilcoxon (non paramétrique)
wilcox.test(salmoyPPP ~ UE, data = my_data)##
## Wilcoxon rank sum exact test
##
## data: salmoyPPP by UE
## W = 152, p-value = 0.2872
## alternative hypothesis: true location shift is not equal to 0# La règle d'or avant l'ACP
sapply(my_data, class)## Pays salmoyPPP ecart d9_d1 tx_chom tx_inact
## "character" "numeric" "numeric" "numeric" "numeric" "numeric"
## heures tx_syndic empl_jeunes empl_age protec UE
## "numeric" "numeric" "numeric" "numeric" "numeric" "factor"#—————————FIN———————#
Commenter ces résultats descriptifs. Justifier l’utilisation d’une ACP normée avant la classification automatique.
Justification de l’ACP normée
Commentaire
L’ACP normée est utilisée afin d’éviter que les variables à forte variance dominent l’analyse.
La standardisation (scale.unit = TRUE) permet de donner le même poids à toutes les variables et de réduire la redondance.
L’ACP étant une méthode adaptée à des données “multinormales” (ou normales multivariées), il convient d’identifier les variables dont la distribution n’est pas normale et de transformer ces variables pour les “normaliser”. Effectuer ce(s) transformation(s)
Transformation pour l’ACP (Analyse en Composantes Principales
• L’ACP étant une méthode adaptée à des données “multinormales” (ou normales multivariées), il convient d’identifier les variables dont la distribution n’est pas normale et de transformer ces variables pour les “normaliser”.
Effectuer ce(s) transformation(s).
# Vérification de l'existence de la colonne Pays
if("Pays" %in% colnames(my_data)) {
# Mise en forme des données pour l'ACP
my_data_acp <- my_data %>%
column_to_rownames(var = "Pays")
} else {
# Si pas de colonne Pays, on utilise les rownames existants ou on crée un index
my_data_acp <- my_data
warning("La colonne 'Pays' n'existe pas. Les noms de lignes ne sont pas définis.")
}
# Réalisation de l'ACP
# Sélection des variables quantitatives (exclure UE qui est qualitative)
vars_quant <- my_data_acp %>%
select(where(is.numeric)) #%>%
#select(-UE) # Exclure UE car variable qualitative
#res_acp <- PCA(vars_quant,
# scale.unit = TRUE, # ACP normée
# graph = FALSE, # Pas de graphique automatique
# ncp = 5) # Nombre de composantes à calculer3. Analyse en composantes principales et interprétation des axes
a. Réaliser une analyse en composante principale sur les 10 variables quantitatives
C’est quoi un ACP et son objectif ?
Définition: Une methode statistique exploratoire qui permet: - Resume un grand nombre de variable - Reduire la dimension des donées - Mettre en evidence les rélations entre les variables - Visualiser les individus
Objectif: Capter le maximum de variance pssible Sont ordonnées: - 1er composante explique le plus de variance - 2eme explique le maximum restant
a. Réaliser une analyse en composante principale sur les 10 variables quantitatives
# Réalisation de l'ACP
res_acp <- PCA(vars_quant,
scale.unit = TRUE, # ACP normée
graph = FALSE, # Pas de graphique automatique
ncp = 5) b. Afficher les valeurs propres et le graphique associé (“éboulis” des valeurs propres, obtenu avec barplot(res_acp$eig[,1])). Combien d’axes proposez-vous de garder pour l’interprétation ? Quel pourcentage de l’inertie est projetée sur le sous-espace vectoriel ainsi retenu ?
# Valeurs propres et variance expliquée
res_acp$eig## eigenvalue percentage of variance cumulative percentage of variance
## comp 1 3.60933554 36.0933554 36.09336
## comp 2 2.56013785 25.6013785 61.69473
## comp 3 1.07883682 10.7883682 72.48310
## comp 4 0.85246216 8.5246216 81.00772
## comp 5 0.62528907 6.2528907 87.26061
## comp 6 0.43222791 4.3222791 91.58289
## comp 7 0.37233225 3.7233225 95.30622
## comp 8 0.27116334 2.7116334 98.01785
## comp 9 0.14220351 1.4220351 99.43988
## comp 10 0.05601156 0.5601156 100.00000# Graphique des valeurs propres (éboulis des valeurs propres)
fviz_eig(res_acp, addlabels = TRUE, ylim = c(0, 50)) +
labs(title = "Éboulis des valeurs propres",
x = "Dimensions", y = "Pourcentage de variance expliquée")## Warning in geom_bar(stat = "identity", fill = barfill, color = barcolor, :
## Ignoring empty aesthetic: `width`.
# Version barplot de base
barplot(res_acp$eig[,1],
main = "Éboulis des valeurs propres",
ylab = "Valeurs propres",
xlab = "Composantes",
names.arg = paste0("Comp", 1:nrow(res_acp$eig)))
# Interprétation des composantes principales :
1️⃣ Que représente Comp1 ?
C’est la dimension qui explique le plus de variance
Elle contient l’information principale
Elle structure le nuage des pays
Si Comp1 explique par exemple 45 %, cela signifie que presque la moitié de l’information totale est résumée par cet axe
2️⃣ Comp2 ?
Deuxième plus grande valeur propre
Explique la variance restante après Comp1
Indépendante de Comp1 (orthogonale)
Si Comp1 = 45 % et Comp2 = 25 %, alors les deux premiers axes expliquent 70 % → très bon résumé
3️⃣ Comp7 et Comp10 ?
Leur valeur propre est généralement faible
Elles expliquent très peu de variance (ex: 2 % ou moins)
Elles correspondent souvent à du bruit
Comment analyser le graphique ?
La décroissance : si la chute est forte entre Comp1 et Comp2 → structure dominante
Le “coude” (elbow) : on cherche le point où la courbe devient presque plate
Règles classiques
Critère de Kaiser : on garde les axes avec valeur propre > 1
Variance cumulée : on garde assez d’axes pour atteindre 60–80 %
Méthode du coude : on garde avant la stabilisation
Comment répondre en examen :
Le diagramme des valeurs propres montre une forte décroissance entre la première et la deuxième composante, indiquant que l’essentiel de l’information est capté par les deux premiers axes. Les composantes 7 à 10 expliquent une part très faible de la variance totale et correspondent essentiellement à du bruit. Ainsi, il est pertinent de retenir uniquement les deux premières dimensions pour l’analyse.
c. Établir le cercle des corrélations et interpréter tous les axes factoriels retenus.
# Cercle des corrélations
fviz_pca_var(res_acp,
col.var = "contrib", # Coloriage par contribution
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE) + # Évite le chevauchement des labels
labs(title = "Cercle des corrélations - Dim1 et Dim2")## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## ℹ The deprecated feature was likely used in the ggpubr package.
## Please report the issue at <https://github.com/kassambara/ggpubr/issues>.
## This warning is displayed once per session.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation idioms with `aes()`.
## ℹ See also `vignette("ggplot2-in-packages")` for more information.
## ℹ The deprecated feature was likely used in the factoextra package.
## Please report the issue at <https://github.com/kassambara/factoextra/issues>.
## This warning is displayed once per session.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
# Version simple
# fviz_pca_var(res_acp)Qu’est-ce que le cercle des corrélations ?
C’est la projection des variables sur le plan Dim1 × Dim2 dans un cercle de rayon 1, représentant leurs corrélations avec les axes.
Comment interpréter le cercle ?
1️⃣ Longueur du vecteur
Proche du cercle → variable bien représentée
Courte → mal représentée
2️⃣ Angle entre deux variables
Proche de 0° → Corrélation positive forte
180° → Corrélation négative
90° → Indépendance
3️⃣ Position par rapport aux axes
Fortement positive sur Dim1 → définit l’axe 1
Fortement négative sur Dim1 → opposée
d. Quelles variables contribuent le plus à la formation du premier axe factoriel ? du deuxième axe factoriel ?
# Contributions des variables aux axes
# Pour l’axe 1 :
contrib_axis1 <- round(res_acp$var$contrib[,1], 2)
sort(contrib_axis1, decreasing = TRUE)## heures salmoyPPP tx_inact empl_jeunes tx_syndic d9_d1
## 18.72 18.28 17.35 17.20 14.03 9.36
## tx_chom ecart protec empl_age
## 2.53 1.69 0.47 0.37# Pour l’axe 2 :
contrib_axis2 <- round(res_acp$var$contrib[,2], 2)
sort(contrib_axis2, decreasing = TRUE)## empl_age ecart tx_chom d9_d1 protec empl_jeunes
## 24.25 21.33 15.24 13.01 9.29 6.48
## heures tx_inact tx_syndic salmoyPPP
## 4.15 3.84 2.29 0.13# Visualisation des contributions
fviz_contrib(res_acp, choice = "var", axes = 1, top = 10) +
labs(title = "Contributions des variables à Dim1")
fviz_contrib(res_acp, choice = "var", axes = 2, top = 10) +
labs(title = "Contributions des variables à Dim2")
# Comment interpréter les contributions ?
Plus la contribution est élevée, plus la variable structure l’axe
Une variable peut être corrélée mais peu contributive
Autrement
Les variables contribuant le plus à la formation du premier axe sont celles dont la contribution dépasse la moyenne (100/p). Ces variables structurent la dimension principale de l’analyse. Le deuxième axe est principalement formé par les variables présentant les contributions les plus élevées sur la seconde dimension, traduisant une structure secondaire indépendante de la première.
Astuce importante
Seuil moyen de contribution : 100 / p (où p = nombre de variables) Exemple : 10 variables → seuil = 10 % ; Toute variable > 10 % contribue fortement.
4. Étude des pays
a. Afficher le graphique des individus-pays dans le premier plan factoriel
if("Pays" %in% colnames(my_data)) {
# Mise en forme des données pour l'ACP
my_data_acp <- my_data %>%
column_to_rownames(var = "Pays")
} else {
# Si pas de colonne Pays, on utilise les rownames existants ou on crée un index
my_data_acp <- my_data
warning("La colonne 'Pays' n'existe pas. Les noms de lignes ne sont pas définis.")
}
# RÉALISATION DE L'ACP (à faire avant le graphique)
vars_quant <- my_data_acp %>%
select(where(is.numeric)) %>%
select(-any_of("UE"))
#res_acp <- PCA(vars_quant, scale.unit = TRUE, graph = FALSE, ncp = 5)
# Graphique des individus (utiliser res_acp, pas my_data_acp)
fviz_pca_ind(res_acp,
geom = "text", # Afficher les noms
repel = TRUE, # Éviter le chevauchement
col.ind = "cos2", # Coloriage par qualité de représentation
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07")) +
labs(title = "Projection des pays sur le plan factoriel",
subtitle = "Coloriage par qualité de représentation (cos²)")
# Version simple
# fviz_pca_ind(res_acp, geom = "text", repel = TRUE)Que faut-il remarquer ?
Pays proches → profils similaires
Pays éloignés du centre → profils atypiques
Pays très éloignés des autres → profils très différents
b. Contributions des individus et cosinus carrés
# Contributions des individus aux axes
# Axe 1
contrib_ind_axis1 <- round(res_acp$ind$contrib[,1], 2)
head(sort(contrib_ind_axis1, decreasing = TRUE), 10)## Islande Mexique Danemark Chili Corée Grèce Suisse Norvège
## 21.00 8.03 7.94 6.80 6.49 5.59 5.34 4.87
## Suède Pologne
## 4.62 3.63# Axe 2
contrib_ind_axis2 <- round(res_acp$ind$contrib[,2], 2)
head(sort(contrib_ind_axis2, decreasing = TRUE), 10)## Corée États-Unis Italie Grèce Estonie Belgique Islande
## 12.09 11.96 10.55 10.42 7.30 7.12 5.13
## Espagne Japon Luxembourg
## 4.77 4.25 3.77# Axe 3
if(ncol(res_acp$ind$contrib) >= 3) {
contrib_ind_axis3 <- round(res_acp$ind$contrib[,3], 2)
head(sort(contrib_ind_axis3, decreasing = TRUE), 10)
}## États-Unis Suède Corée Canada
## 26.98 9.89 6.43 5.35
## Irlande Portugal Républiquetchèque Chili
## 5.01 4.83 4.60 4.53
## Royaume-Uni Islande
## 3.96 3.62c. Quels individus sont les mieux représentés sur le premier axe factoriel ? sur le deuxième ?
# Visualisation des contributions des individus
fviz_contrib(res_acp, choice = "ind", axes = 1, top = 20) +
labs(title = "Contributions des individus à Dim1")
fviz_contrib(res_acp, choice = "ind", axes = 2, top = 20) +
labs(title = "Contributions des individus à Dim2")
Interprétation
Un individu contribue fortement si sa contribution est supérieure à la moyenne. Seuil moyen : 100 / n (où n = nombre d’individus)
# Qualité de représentation des variables (cos2)
round(res_acp$var$cos2, 3)## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## salmoyPPP 0.660 0.003 0.130 0.008 0.001
## ecart 0.061 0.546 0.059 0.084 0.126
## d9_d1 0.338 0.333 0.072 0.017 0.001
## tx_chom 0.091 0.390 0.024 0.085 0.381
## tx_inact 0.626 0.098 0.009 0.033 0.107
## heures 0.676 0.106 0.002 0.152 0.003
## tx_syndic 0.506 0.059 0.081 0.197 0.004
## empl_jeunes 0.621 0.166 0.002 0.009 0.001
## empl_age 0.013 0.621 0.149 0.168 0.000
## protec 0.017 0.238 0.550 0.099 0.001# Cosinus carrés (qualité de représentation)
# Pour tous les axes
round(res_acp$ind$cos2, 3)## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## Australie 0.210 0.290 0.191 0.014 0.010
## Autriche 0.329 0.026 0.001 0.489 0.001
## Belgique 0.048 0.582 0.023 0.056 0.122
## Canada 0.101 0.435 0.311 0.019 0.063
## Chili 0.626 0.129 0.125 0.012 0.001
## Républiquetchèque 0.320 0.004 0.224 0.271 0.045
## Danemark 0.778 0.125 0.007 0.016 0.012
## Estonie 0.213 0.515 0.067 0.012 0.128
## Finlande 0.356 0.130 0.127 0.055 0.080
## France 0.027 0.611 0.025 0.172 0.003
## Allemagne 0.194 0.006 0.026 0.718 0.002
## Grèce 0.281 0.372 0.024 0.147 0.150
## Hongrie 0.498 0.004 0.088 0.017 0.135
## Islande 0.704 0.122 0.036 0.100 0.000
## Irlande 0.044 0.019 0.684 0.078 0.037
## Italie 0.079 0.742 0.027 0.054 0.008
## Japon 0.001 0.493 0.014 0.001 0.014
## Corée 0.333 0.440 0.099 0.002 0.003
## Luxembourg 0.063 0.368 0.103 0.022 0.207
## Mexique 0.438 0.091 0.041 0.195 0.128
## Pays-Bas 0.419 0.000 0.021 0.284 0.002
## Nouvelle-Zélande 0.151 0.161 0.009 0.156 0.003
## Norvège 0.743 0.049 0.087 0.015 0.058
## Pologne 0.700 0.037 0.003 0.020 0.177
## Portugal 0.413 0.045 0.213 0.081 0.028
## Républiqueslovaque 0.658 0.064 0.027 0.041 0.015
## Slovenie 0.092 0.466 0.051 0.027 0.114
## Espagne 0.143 0.387 0.072 0.004 0.383
## Suède 0.499 0.066 0.319 0.011 0.030
## Suisse 0.594 0.075 0.063 0.038 0.032
## Royaume-Uni 0.196 0.232 0.316 0.036 0.003
## États-Unis 0.010 0.463 0.440 0.004 0.003# Pour un axe précis
round(res_acp$ind$cos2[,1], 3) # Axe 1## Australie Autriche Belgique Canada
## 0.210 0.329 0.048 0.101
## Chili Républiquetchèque Danemark Estonie
## 0.626 0.320 0.778 0.213
## Finlande France Allemagne Grèce
## 0.356 0.027 0.194 0.281
## Hongrie Islande Irlande Italie
## 0.498 0.704 0.044 0.079
## Japon Corée Luxembourg Mexique
## 0.001 0.333 0.063 0.438
## Pays-Bas Nouvelle-Zélande Norvège Pologne
## 0.419 0.151 0.743 0.700
## Portugal Républiqueslovaque Slovenie Espagne
## 0.413 0.658 0.092 0.143
## Suède Suisse Royaume-Uni États-Unis
## 0.499 0.594 0.196 0.010round(res_acp$ind$cos2[,2], 3) # Axe 2## Australie Autriche Belgique Canada
## 0.290 0.026 0.582 0.435
## Chili Républiquetchèque Danemark Estonie
## 0.129 0.004 0.125 0.515
## Finlande France Allemagne Grèce
## 0.130 0.611 0.006 0.372
## Hongrie Islande Irlande Italie
## 0.004 0.122 0.019 0.742
## Japon Corée Luxembourg Mexique
## 0.493 0.440 0.368 0.091
## Pays-Bas Nouvelle-Zélande Norvège Pologne
## 0.000 0.161 0.049 0.037
## Portugal Républiqueslovaque Slovenie Espagne
## 0.045 0.064 0.466 0.387
## Suède Suisse Royaume-Uni États-Unis
## 0.066 0.075 0.232 0.463if(ncol(res_acp$ind$cos2) >= 3) {
round(res_acp$ind$cos2[,3], 3) # Axe 3
}## Australie Autriche Belgique Canada
## 0.191 0.001 0.023 0.311
## Chili Républiquetchèque Danemark Estonie
## 0.125 0.224 0.007 0.067
## Finlande France Allemagne Grèce
## 0.127 0.025 0.026 0.024
## Hongrie Islande Irlande Italie
## 0.088 0.036 0.684 0.027
## Japon Corée Luxembourg Mexique
## 0.014 0.099 0.103 0.041
## Pays-Bas Nouvelle-Zélande Norvège Pologne
## 0.021 0.009 0.087 0.003
## Portugal Républiqueslovaque Slovenie Espagne
## 0.213 0.027 0.051 0.072
## Suède Suisse Royaume-Uni États-Unis
## 0.319 0.063 0.316 0.440c. Quels individus sont les mieux représentés sur le premier axe factoriel ? sur le deuxième ?
# Individus les mieux représentés sur l'axe 1
best_axis1 <- sort(res_acp$ind$cos2[,1], decreasing = TRUE)
head(best_axis1, 10)## Danemark Norvège Islande Pologne
## 0.7783317 0.7432218 0.7038122 0.6996794
## Républiqueslovaque Chili Suisse Suède
## 0.6583244 0.6260269 0.5942347 0.4987695
## Hongrie Mexique
## 0.4984532 0.4379316# Individus les mieux représentés sur l'axe 2
best_axis2 <- sort(res_acp$ind$cos2[,2], decreasing = TRUE)
head(best_axis2, 10)## Italie France Belgique Estonie Japon Slovenie États-Unis
## 0.7424186 0.6112673 0.5822748 0.5145638 0.4931454 0.4656048 0.4631353
## Corée Canada Espagne
## 0.4399562 0.4348666 0.3870004Différence importante
Contribution : Influence sur la construction de l’axe
cos² : Qualité de représentation sur l’axe
Un pays peut contribuer beaucoup mais être mal représenté, ou être bien représenté mais peu contributif.
# Résumé des contributions et cos² pour les premiers axes
contrib_summary <- round(cbind(res_acp$ind$contrib[,1:3],
res_acp$ind$cos2[,1:2]), 3)
colnames(contrib_summary) <- c("Contrib_Dim1", "Contrib_Dim2", "Contrib_Dim3",
"Cos2_Dim1", "Cos2_Dim2")
head(contrib_summary[order(-contrib_summary[,4]), ], 10) # Tri par cos² Dim1## Contrib_Dim1 Contrib_Dim2 Contrib_Dim3 Cos2_Dim1 Cos2_Dim2
## Danemark 7.937 1.790 0.230 0.778 0.125
## Norvège 4.875 0.452 1.907 0.743 0.049
## Islande 20.996 5.131 3.620 0.704 0.122
## Pologne 3.626 0.269 0.049 0.700 0.037
## Républiqueslovaque 2.802 0.384 0.391 0.658 0.064
## Chili 6.801 1.983 4.531 0.626 0.129
## Suisse 5.339 0.950 1.899 0.594 0.075
## Suède 4.623 0.869 9.886 0.499 0.066
## Hongrie 2.916 0.032 1.730 0.498 0.004
## Mexique 8.030 2.365 2.505 0.438 0.091# Résumé des contributions et cos² pour les premiers axes
contrib_summary <- round(cbind(res_acp$ind$contrib[,1:3],
res_acp$ind$cos2[,1:2]), 3)
colnames(contrib_summary) <- c("Contrib_Dim1", "Contrib_Dim2", "Contrib_Dim3",
"Cos2_Dim1", "Cos2_Dim2")
head(contrib_summary[order(-contrib_summary[,4]), ], 10) # Tri par cos² Dim1## Contrib_Dim1 Contrib_Dim2 Contrib_Dim3 Cos2_Dim1 Cos2_Dim2
## Danemark 7.937 1.790 0.230 0.778 0.125
## Norvège 4.875 0.452 1.907 0.743 0.049
## Islande 20.996 5.131 3.620 0.704 0.122
## Pologne 3.626 0.269 0.049 0.700 0.037
## Républiqueslovaque 2.802 0.384 0.391 0.658 0.064
## Chili 6.801 1.983 4.531 0.626 0.129
## Suisse 5.339 0.950 1.899 0.594 0.075
## Suède 4.623 0.869 9.886 0.499 0.066
## Hongrie 2.916 0.032 1.730 0.498 0.004
## Mexique 8.030 2.365 2.505 0.438 0.091d. Construire la variable cos2_12
# Extraire les cos2 des individus
cos2 <- res_acp$ind$cos2
# Construire cos2_12 (somme des cos² sur Dim1 et Dim2)
cos2_12 <- cos2[,1] + cos2[,2]
# Transformer en data frame
cos2_12_df <- data.frame(
Pays = rownames(cos2),
cos2_12 = round(cos2_12, 3)
)
# Trier du plus grand au plus petit
cos2_12_df <- cos2_12_df[order(-cos2_12_df$cos2_12), ]
# Afficher les 10 premiers
head(cos2_12_df, 10)## Pays cos2_12
## Danemark Danemark 0.903
## Islande Islande 0.826
## Italie Italie 0.821
## Norvège Norvège 0.792
## Corée Corée 0.773
## Chili Chili 0.756
## Pologne Pologne 0.737
## Estonie Estonie 0.727
## Républiqueslovaque Républiqueslovaque 0.722
## Suisse Suisse 0.669# Pays le mieux représenté
best_represented <- cos2_12_df[1, ]
print(paste("Le pays le mieux représenté sur le plan 1-2 est :", best_represented$Pays))## [1] "Le pays le mieux représenté sur le plan 1-2 est : Danemark"print(paste("Avec un cos² de :", best_represented$cos2_12))## [1] "Avec un cos² de : 0.903"# Valeur maximale
max(cos2_12)## [1] 0.9028498Interprétation
Un cos² élevé (proche de 1) signifie que le plan 1–2 résume très bien le profil du pays, sa position sur le graphique est fiable, et il est fortement structuré par les deux premiers axes.
5. Graphe conjoint des variables et des individus
# Biplot (graphique conjoint)
fviz_pca_biplot(res_acp,
repel = TRUE,
col.var = "blue", # Couleur des variables
col.ind = "black", # Couleur des individus
alpha.var = 0.5, # Transparence des flèches
label = "all", # Afficher toutes les étiquettes
title = "Biplot - Individus et variables") +
theme_minimal()
Comment interpréter un biplot ?
1- Les flèches représentent les variables
2- Les points représentent les pays
3- Si un pays est dans la direction d’une variable, il a une forte valeur pour cette variable
4- S’il est opposé, il a une faible valeur
# Nuage des individus sur axes 1 et 3
fviz_pca_ind(res_acp,
axes = c(1, 3),
geom = "text",
repel = TRUE,
col.ind = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07")) +
labs(title = "Projection des pays - Dimensions 1 et 3")
# Nuage des individus sur axes 3 et 4
if(ncol(res_acp$ind$coord) >= 4) {
fviz_pca_ind(res_acp,
axes = c(3, 4),
geom = "text",
repel = TRUE,
col.ind = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07")) +
labs(title = "Projection des pays - Dimensions 3 et 4")
}
## Pourquoi regarder 1–3 ou 3–4 ?
L’axe 3 peut révéler une structure cachée
Certains pays mal représentés sur 1–2 peuvent être mieux représentés sur 1–3 ou 3–4
Réponse type examen
La variable cos2_12 a été construite comme la somme des cos² des individus sur les deux premières dimensions. L’individu présentant la valeur maximale est le mieux représenté sur le premier plan factoriel. Le biplot permet d’analyser simultanément la position des individus et l’influence des variables. Les projections sur les plans (1,3) et (3,4) permettent d’explorer des structures secondaires éventuellement invisibles sur le plan principal.
6. Points et variables supplémentaires
6.1 États-Unis et Islande comme points supplémentaires
# Identification des indices des États-Unis et de l'Islande
# À adapter selon les noms exacts dans vos données
usa_index <- which(rownames(vars_quant) == "États-Unis" |
rownames(vars_quant) == "USA" |
rownames(vars_quant) == "United States")
islande_index <- which(rownames(vars_quant) == "Islande" |
rownames(vars_quant) == "Iceland")
if(length(usa_index) > 0 & length(islande_index) > 0) {
ind_supp <- c(usa_index, islande_index)
# ACP avec points supplémentaires
res_acp_supp <- PCA(vars_quant,
scale.unit = TRUE,
ind.sup = ind_supp, # Points supplémentaires
graph = FALSE,
ncp = 5)
# Visualisation avec points supplémentaires
fviz_pca_ind(res_acp_supp,
geom.ind = "point",
col.ind = "black",
fill.ind = "white",
pointshape = 21,
pointsize = 2,
geom.sup = "point",
col.sup = "red",
repel = TRUE) +
labs(title = "ACP avec États-Unis et Islande comme points supplémentaires",
subtitle = "Points rouges = États-Unis et Islande (supplémentaires)")
} else {
print("Les indices des États-Unis et/ou de l'Islande n'ont pas été trouvés.")
print("Noms des pays disponibles :")
print(rownames(vars_quant))
}
Intérêt de cette démarche :
Les points supplémentaires ne participent pas à la construction des axes
Permet de positionner des pays atypiques sans influencer l’analyse
Utile pour valider la robustesse des axes
Permet de comparer des pays spécifiques au cadre général
6.2 Variable UE comme variable qualitative supplémentaire
# ACP avec variable qualitative supplémentaire
# Création d'un data frame avec la variable UE
# Solution simplifiée
if("UE" %in% colnames(my_data_acp)) {
# Création du data frame
df_complet <- cbind(vars_quant, UE = as.factor(my_data_acp$UE))
# ACP
res_acp_qual <- PCA(df_complet,
scale.unit = TRUE,
quali.sup = ncol(df_complet), # Dernière colonne = UE
graph = FALSE,
ncp = 5)
# Graphique
fviz_pca_ind(res_acp_qual,
geom.ind = "point",
col.ind = df_complet$UE,
palette = c("#E69F00", "#56B4E9"),
addEllipses = TRUE,
ellipse.level = 0.95,
title = "Projection par appartenance à l'UE")
# Tests rapides
coord <- as.data.frame(res_acp_qual$ind$coord[, 1:2])
df_test <- data.frame(coord, UE = df_complet$UE)
cat("Test Dim1 : p =", t.test(Dim.1 ~ UE, data = df_test)$p.value, "\n")
cat("Test Dim2 : p =", t.test(Dim.2 ~ UE, data = df_test)$p.value, "\n")
} else {
message("UE non trouvée")
}## Test Dim1 : p = 0.3245642
## Test Dim2 : p = 0.00003351217Test statistique approprié :
Pour répondre à la question “les pays de l’UE ont-ils des caractéristiques significativement différentes ?”, on peut utiliser :
ANOVA (Analyse de variance multivariée) pour tester la différence sur l’ensemble des dimensions
Test de Student ou Wilcoxon pour chaque dimension séparément
Test de permutation pour comparer les centres de gravité
6.3 Variable taux de syndicalisation comme variable supplémentaire
# ACP avec taux de syndicalisation comme variable supplémentaire
# Identifier la colonne du taux de syndicalisation
col_syndic <- which(colnames(vars_quant) == "tx_syndic")
if(length(col_syndic) > 0) {
res_acp_syndic <- PCA(vars_quant,
scale.unit = TRUE,
quanti.sup = col_syndic, # Variable quantitative supplémentaire
graph = FALSE,
ncp = 5)
# Cercle des corrélations avec variable supplémentaire
fviz_pca_var(res_acp_syndic,
col.var = "blue",
col.quanti.sup = "red", # Variables supplémentaires en rouge
repel = TRUE) +
labs(title = "Cercle des corrélations - tx_syndic en variable supplémentaire (rouge)")
# Coordonnées de la variable supplémentaire
print("Coordonnées de la variable supplémentaire tx_syndic :")
print(round(res_acp_syndic$quanti.sup$coord, 3))
# Corrélation avec les axes
print("Corrélation de tx_syndic avec les axes :")
print(round(res_acp_syndic$quanti.sup$cor, 3))
} else {
print("La variable 'tx_syndic' n'a pas été trouvée.")
}## [1] "Coordonnées de la variable supplémentaire tx_syndic :"
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## tx_syndic -0.544 -0.295 0.131 0.309 -0.133
## [1] "Corrélation de tx_syndic avec les axes :"
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## tx_syndic -0.544 -0.295 0.131 0.309 -0.133Ce qu’on observe :
La variable supplémentaire ne participe pas à la construction des axes
On peut voir sa corrélation avec les axes existants
Permet de vérifier si elle est bien représentée par les dimensions retenues
Utile pour valider la pertinence d’inclure ou non cette variable dans l’analyse
7. Création d’indices
Démarche proposée pour créer deux indices indépendants :
1- Utiliser les résultats de l’ACP : Les composantes principales sont par construction indépendantes (orthogonales)
2- Premier indice (Dimension 1) :
a- Basé sur les variables les plus corrélées avec Dim1
b- Exemple : Indice de “Qualité de l’emploi” combinant salaire, protection, syndicalisation
3- Deuxième indice (Dimension 2) :
a- Basé sur les variables les plus corrélées avec Dim2
b- Exemple : Indice de “Participation au marché du travail” combinant emploi jeunes/seniors, heures travaillées
# Identification des variables clés pour chaque dimension
# Variables les plus contributives pour Dim1
top_var_dim1 <- names(sort(res_acp$var$contrib[,1], decreasing = TRUE)[1:4])
print("Variables clés pour l'indice 1 (Dim1) :")## [1] "Variables clés pour l'indice 1 (Dim1) :"print(top_var_dim1)## [1] "heures" "salmoyPPP" "tx_inact" "empl_jeunes"# Variables les plus contributives pour Dim2
top_var_dim2 <- names(sort(res_acp$var$contrib[,2], decreasing = TRUE)[1:4])
print("Variables clés pour l'indice 2 (Dim2) :")## [1] "Variables clés pour l'indice 2 (Dim2) :"print(top_var_dim2)## [1] "empl_age" "ecart" "tx_chom" "d9_d1"# Création des indices (exemple avec standardisation)
# Standardisation des variables
vars_std <- scale(vars_quant)
# Indice 1 : moyenne pondérée par les contributions
poids_dim1 <- res_acp$var$contrib[,1] / sum(res_acp$var$contrib[,1])
indice1 <- as.matrix(vars_std) %*% poids_dim1
# Indice 2 : moyenne pondérée par les contributions
poids_dim2 <- res_acp$var$contrib[,2] / sum(res_acp$var$contrib[,2])
indice2 <- as.matrix(vars_std) %*% poids_dim2
# Vérification de l'indépendance
cor(indice1, indice2)## [,1]
## [1,] 0.3524534# Data frame des indices
indices_df <- data.frame(
Pays = rownames(vars_quant),
Indice1 = round(indice1[,1], 3),
Indice2 = round(indice2[,1], 3)
)
head(indices_df[order(-indices_df$Indice1), ], 10)## Pays Indice1 Indice2
## États-Unis États-Unis 0.642 0.370
## Mexique Mexique 0.532 0.442
## Islande Islande 0.449 0.406
## Corée Corée 0.375 1.299
## Chili Chili 0.296 0.905
## Irlande Irlande 0.263 -0.097
## Canada Canada 0.243 0.124
## Luxembourg Luxembourg 0.178 -0.621
## Australie Australie 0.168 0.016
## Danemark Danemark 0.166 -0.4448. Graphique des individus (résumé)
# D'abord, extrayez les coordonnées des individus
coord.ind <- as.data.frame(res_acp$ind$coord)
# Ensuite, utilisez-le dans le graphique
fviz_pca_ind(res_acp,
geom.ind = "point",
col.ind = coord.ind[,1], # Maintenant coord.ind existe
gradient.cols = c("blue", "white", "red"),
pointshape = 21,
pointsize = 3,
fill.ind = coord.ind[,1],
repel = TRUE,
addEllipses = TRUE,
ellipse.type = "confidence") +
labs(title = "Analyse en Composantes Principales",
subtitle = "Projection des pays sur les dimensions 1 et 2",
color = "Dim1", fill = "Dim1")## Warning: Computation failed in `stat_conf_ellipse()`.
## Caused by error in `if (scale[1] > 0) ...`:
## ! valeur manquante là où TRUE / FALSE est requis
# 9. Contributions et cos² (synthèse)
# Synthèse des contributions et cos² pour les premiers axes
synthese_ind <- data.frame(
Pays = rownames(res_acp$ind$contrib),
Contrib_Dim1 = round(res_acp$ind$contrib[,1], 2),
Contrib_Dim2 = round(res_acp$ind$contrib[,2], 2),
Cos2_Dim1 = round(res_acp$ind$cos2[,1], 3),
Cos2_Dim2 = round(res_acp$ind$cos2[,2], 3)
)
# Qualité de représentation sur le plan 1-2
synthese_ind$Cos2_12 <- synthese_ind$Cos2_Dim1 + synthese_ind$Cos2_Dim2
# Tri par qualité de représentation
synthese_ind <- synthese_ind[order(-synthese_ind$Cos2_12), ]
head(synthese_ind, 15)## Pays Contrib_Dim1 Contrib_Dim2 Cos2_Dim1
## Danemark Danemark 7.94 1.79 0.778
## Islande Islande 21.00 5.13 0.704
## Italie Italie 0.80 10.55 0.079
## Norvège Norvège 4.87 0.45 0.743
## Corée Corée 6.49 12.09 0.333
## Chili Chili 6.80 1.98 0.626
## Pologne Pologne 3.63 0.27 0.700
## Estonie Estonie 2.14 7.30 0.213
## Républiqueslovaque Républiqueslovaque 2.80 0.38 0.658
## Suisse Suisse 5.34 0.95 0.594
## Grèce Grèce 5.59 10.42 0.281
## France France 0.11 3.61 0.027
## Belgique Belgique 0.41 7.12 0.048
## Suède Suède 4.62 0.87 0.499
## Slovenie Slovenie 0.23 1.65 0.092
## Cos2_Dim2 Cos2_12
## Danemark 0.125 0.903
## Islande 0.122 0.826
## Italie 0.742 0.821
## Norvège 0.049 0.792
## Corée 0.440 0.773
## Chili 0.129 0.755
## Pologne 0.037 0.737
## Estonie 0.515 0.728
## Républiqueslovaque 0.064 0.722
## Suisse 0.075 0.669
## Grèce 0.372 0.653
## France 0.611 0.638
## Belgique 0.582 0.630
## Suède 0.066 0.565
## Slovenie 0.466 0.558# Pays avec la meilleure qualité de représentation
best_qual <- synthese_ind[1, ]
print(paste("Meilleure qualité de représentation :", best_qual$Pays,
"avec cos² =", round(best_qual$Cos2_12, 3)))## [1] "Meilleure qualité de représentation : Danemark avec cos² = 0.903"10. Biplot (version améliorée)
# Biplot avec plus d'informations
fviz_pca_biplot(res_acp,
geom.ind = "point",
pointshape = 21,
pointsize = 3,
fill.ind = res_acp$ind$cos2[,1], # Coloriage par cos² sur Dim1
col.ind = "black",
gradient.cols = c("blue", "yellow", "red"),
col.var = "contrib", # Coloriage des variables par contribution
gradient.cols.var = c("blue", "green", "red"),
legend.title = list(fill = "Cos² Dim1", color = "Contrib",
alpha = "Contrib"),
repel = TRUE,
title = "Biplot - Relation individus-variables") +
theme_minimal()## Ignoring unknown labels:
## • alpha : "Contrib"
# Version avec flèches + noms personnalisés
fviz_pca_biplot(res_acp,
# Individus
geom.ind = "text",
labelsize = 3,
col.ind = "red",
repel = TRUE,
# Variables : flèches + texte
geom.var = c("arrow", "text"),
col.var = "contrib",
gradient.cols.var = c("blue", "green", "red"),
labelsize.var = 4,
repel.var = TRUE,
title = "Biplot - Pays (rouge) et variables (avec flèches)") +
theme_minimal()
11. Plans factoriels supplémentaires
# Version simple pour p1
# Plan factoriel 1-2 avec identification des pays
# Calculer la distance au centre pour identifier les pays extrêmes
coord_ind <- as.data.frame(res_acp$ind$coord)
distance_centre <- sqrt(coord_ind$Dim.1^2 + coord_ind$Dim.2^2)
# Identifier les pays atypiques (les plus éloignés)
pays_atypiques <- names(sort(distance_centre, decreasing = TRUE)[1:5])
cat("Pays atypiques (les plus éloignés du centre) :\n")## Pays atypiques (les plus éloignés du centre) :print(pays_atypiques)## NULL# Plan 1-2 avec tous les pays
p1 <- fviz_pca_ind(res_acp,
axes = c(1, 2),
geom.ind = "point",
col.ind = "blue",
addEllipses = TRUE,
ellipse.level = 0.95,
title = "Plan factoriel 1-2") +
geom_text(data = as.data.frame(res_acp$ind$coord),
aes(x = Dim.1, y = Dim.2, label = rownames(res_acp$ind$coord)),
size = 3, vjust = -0.7, color = "red", check_overlap = TRUE)
# Plan 3-4 si disponible
if(ncol(res_acp$ind$coord) >= 4) {
p2 <- fviz_pca_ind(res_acp,
axes = c(3, 4),
geom.ind = "point",
col.ind = "red",
addEllipses = TRUE,
ellipse.level = 0.95,
title = "Plan factoriel 3-4") +
geom_text(data = as.data.frame(res_acp$ind$coord),
aes(x = Dim.3, y = Dim.4, label = rownames(res_acp$ind$coord)),
size = 3, vjust = -0.7, color = "blue", check_overlap = TRUE)
library(gridExtra)
grid.arrange(p1, p2, ncol = 2)
} else {
p1
}##
## Attachement du package : 'gridExtra'## L'objet suivant est masqué depuis 'package:dplyr':
##
## combine
# Conclusion L’Analyse en Composantes Principales nous a permis de :
1- Réduire la dimensionnalité des données en passant de 10 variables à quelques axes synthétiques
2- Identifier les axes structurants :
a- Le premier axe oppose probablement les pays à forte protection sociale et hauts salaires à ceux avec fortes inégalités et chômage élevé
b- Le second axe distingue les pays selon le niveau de participation au marché du travail
3- Visualiser les similarités entre pays : les pays proches sur les graphiques ont des profils économiques similaires
4- Repérer les pays atypiques : certains pays (États-Unis, Islande potentiellement) se distinguent nettement
5- Préparer une classification automatique : les coordonnées sur les premiers axes peuvent servir de base à une classification (CAH ou k-means) pour regrouper les pays en profils types
Prochaines étapes possibles :
Réaliser une Classification Ascendante Hiérarchique (CAH) à partir des coordonnées de l’ACP
Valider la robustesse des résultats par bootstrap
Approfondir l’analyse des pays atypiques
Créer des indices synthétiques pour le pilotage des politiques de l’emploi
# Session info pour reproductibilité
sessionInfo()## R version 4.5.2 (2025-10-31 ucrt)
## Platform: x86_64-w64-mingw32/x64
## Running under: Windows 11 x64 (build 26100)
##
## Matrix products: default
## LAPACK version 3.12.1
##
## locale:
## [1] LC_COLLATE=French_France.utf8 LC_CTYPE=French_France.utf8
## [3] LC_MONETARY=French_France.utf8 LC_NUMERIC=C
## [5] LC_TIME=French_France.utf8
##
## time zone: Europe/Paris
## tzcode source: internal
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] gridExtra_2.3 car_3.1-5 carData_3.0-6
## [4] tinytex_0.58 data.table_1.18.2.1 corrplot_0.95
## [7] factoextra_1.0.7 FactoMineR_2.13 lubridate_1.9.5
## [10] forcats_1.0.1 stringr_1.6.0 dplyr_1.2.0
## [13] purrr_1.2.1 readr_2.2.0 tidyr_1.3.2
## [16] tibble_3.3.1 ggplot2_4.0.2 tidyverse_2.0.0
##
## loaded via a namespace (and not attached):
## [1] gtable_0.3.6 xfun_0.56 bslib_0.10.0
## [4] htmlwidgets_1.6.4 rstatix_0.7.3 ggrepel_0.9.6
## [7] lattice_0.22-7 tzdb_0.5.0 vctrs_0.7.1
## [10] tools_4.5.2 generics_0.1.4 cluster_2.1.8.1
## [13] pkgconfig_2.0.3 RColorBrewer_1.1-3 S7_0.2.1
## [16] scatterplot3d_0.3-44 lifecycle_1.0.5 compiler_4.5.2
## [19] farver_2.1.2 leaps_3.2 htmltools_0.5.9
## [22] sass_0.4.10 yaml_2.3.12 Formula_1.2-5
## [25] pillar_1.11.1 ggpubr_0.6.2 jquerylib_0.1.4
## [28] MASS_7.3-65 flashClust_1.01-2 DT_0.34.0
## [31] cachem_1.1.0 abind_1.4-8 tidyselect_1.2.1
## [34] digest_0.6.39 mvtnorm_1.3-3 stringi_1.8.7
## [37] labeling_0.4.3 fastmap_1.2.0 grid_4.5.2
## [40] cli_3.6.5 magrittr_2.0.4 broom_1.0.12
## [43] withr_3.0.2 backports_1.5.0 scales_1.4.0
## [46] estimability_1.5.1 timechange_0.4.0 rmarkdown_2.30
## [49] emmeans_2.0.1 otel_0.2.0 ggsignif_0.6.4
## [52] hms_1.1.4 evaluate_1.0.5 knitr_1.51
## [55] rlang_1.1.7 Rcpp_1.1.1 glue_1.8.0
## [58] rstudioapi_0.18.0 jsonlite_2.0.0 R6_2.6.1
## [61] multcompView_0.1-10#““““““Ajust”““““”
# Contributions des variables aux axes
# Seuil de contribution significative : 100/nb_variables * 100
nb_vars <- ncol(res_acp)
seuil_contrib <- 100/nb_vars
cat("Seuil de contribution significative :", round(seuil_contrib, 2), "%\n")## Seuil de contribution significative : %# Pour l'axe 1
contrib_axis1 <- round(res_acp$var$contrib[,1], 2)
contrib_axis1_trie <- sort(contrib_axis1, decreasing = TRUE)
cat("\n=== CONTRIBUTIONS À L'AXE 1 ===\n")##
## === CONTRIBUTIONS À L'AXE 1 ===print(contrib_axis1_trie)## heures salmoyPPP tx_inact empl_jeunes tx_syndic d9_d1
## 18.72 18.28 17.35 17.20 14.03 9.36
## tx_chom ecart protec empl_age
## 2.53 1.69 0.47 0.37cat("\nVariables contribuant le plus ( >", round(seuil_contrib, 2), "%) :\n")##
## Variables contribuant le plus ( > %) :print(contrib_axis1_trie[contrib_axis1_trie > seuil_contrib])## named numeric(0)# Pour l'axe 2
contrib_axis2 <- round(res_acp$var$contrib[,2], 2)
contrib_axis2_trie <- sort(contrib_axis2, decreasing = TRUE)
cat("\n=== CONTRIBUTIONS À L'AXE 2 ===\n")##
## === CONTRIBUTIONS À L'AXE 2 ===print(contrib_axis2_trie)## empl_age ecart tx_chom d9_d1 protec empl_jeunes
## 24.25 21.33 15.24 13.01 9.29 6.48
## heures tx_inact tx_syndic salmoyPPP
## 4.15 3.84 2.29 0.13cat("\nVariables contribuant le plus ( >", round(seuil_contrib, 2), "%) :\n")##
## Variables contribuant le plus ( > %) :print(contrib_axis2_trie[contrib_axis2_trie > seuil_contrib])## named numeric(0)# Visualisation
library(factoextra)
p1 <- fviz_contrib(res_acp, choice = "var", axes = 1, top = 10) +
labs(title = "Contributions des variables à Dim1")
p2 <- fviz_contrib(res_acp, choice = "var", axes = 2, top = 10) +
labs(title = "Contributions des variables à Dim2")
gridExtra::grid.arrange(p1, p2, ncol = 2)
## Interprétation à rédiger :
Les variables contribuant le plus au premier axe sont [nommer les variables avec contribution > seuil]. Ces variables structurent la dimension principale de l’analyse et représentent [interprétation économique]. Le deuxième axe est principalement formé par [nommer les variables], traduisant une structure secondaire indépendante.
4. Étude des pays
a. Graphique des individus-pays
# Graphique des individus
fviz_pca_ind(res_acp,
geom = "text", # Afficher les noms
repel = TRUE, # Éviter chevauchement
col.ind = "cos2", # Couleur par qualité
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
title = "Projection des pays - Dimensions 1 et 2") +
theme_minimal()
# Identifier les pays atypiques (loin du centre)
coord_ind <- as.data.frame(res_acp$ind$coord)
distance_centre <- sqrt(coord_ind$Dim.1^2 + coord_ind$Dim.2^2)
pays_atypiques <- names(sort(distance_centre, decreasing = TRUE)[1:5])
cat("Pays les plus éloignés du centre (profils atypiques) :\n")## Pays les plus éloignés du centre (profils atypiques) :print(pays_atypiques)## NULLRemarque : Observez les pays aux extrémités du graphique. Ce sont généralement des pays comme les États-Unis, l’Islande, ou d’autres avec des caractéristiques très spécifiques.
b. Contributions et cosinus carrés des individus
# Seuil de contribution pour les individus
n_ind <- nrow(res_acp$ind$contrib)
seuil_contrib_ind <- 100/n_ind
cat("Seuil de contribution individuelle significative :", round(seuil_contrib_ind, 2), "%\n")## Seuil de contribution individuelle significative : 3.12 %# Contributions aux axes
# Axe 1
contrib_ind_axis1 <- round(res_acp$ind$contrib[,1], 2)
top_contrib_axis1 <- sort(contrib_ind_axis1, decreasing = TRUE)[1:10]
cat("\n=== TOP 10 CONTRIBUTIONS À L'AXE 1 ===\n")##
## === TOP 10 CONTRIBUTIONS À L'AXE 1 ===print(top_contrib_axis1)## Islande Mexique Danemark Chili Corée Grèce Suisse Norvège
## 21.00 8.03 7.94 6.80 6.49 5.59 5.34 4.87
## Suède Pologne
## 4.62 3.63# Axe 2
contrib_ind_axis2 <- round(res_acp$ind$contrib[,2], 2)
top_contrib_axis2 <- sort(contrib_ind_axis2, decreasing = TRUE)[1:10]
cat("\n=== TOP 10 CONTRIBUTIONS À L'AXE 2 ===\n")##
## === TOP 10 CONTRIBUTIONS À L'AXE 2 ===print(top_contrib_axis2)## Corée États-Unis Italie Grèce Estonie Belgique Islande
## 12.09 11.96 10.55 10.42 7.30 7.12 5.13
## Espagne Japon Luxembourg
## 4.77 4.25 3.77# Axe 3 (si disponible)
if(ncol(res_acp$ind$contrib) >= 3) {
contrib_ind_axis3 <- round(res_acp$ind$contrib[,3], 2)
top_contrib_axis3 <- sort(contrib_ind_axis3, decreasing = TRUE)[1:10]
cat("\n=== TOP 10 CONTRIBUTIONS À L'AXE 3 ===\n")
print(top_contrib_axis3)
}##
## === TOP 10 CONTRIBUTIONS À L'AXE 3 ===
## États-Unis Suède Corée Canada
## 26.98 9.89 6.43 5.35
## Irlande Portugal Républiquetchèque Chili
## 5.01 4.83 4.60 4.53
## Royaume-Uni Islande
## 3.96 3.62# Visualisation des contributions
fviz_contrib(res_acp, choice = "ind", axes = 1, top = 20) +
labs(title = "Contributions des individus à Dim1")
## Interprétation :
Les individus contribuant fortement à l’axe 1 sont [liste des pays]. Ils participent activement à la structuration de cette dimension. Leur position aux extrémités de l’axe indique qu’ils possèdent des valeurs extrêmes pour les variables associées.
c. Individus les mieux représentés
# Cosinus carrés (qualité de représentation)
# Axe 1
cos2_axis1 <- round(res_acp$ind$cos2[,1], 3)
top_cos2_axis1 <- sort(cos2_axis1, decreasing = TRUE)[1:10]
cat("\n=== TOP 10 COS² - AXE 1 (meilleurs représentés) ===\n")##
## === TOP 10 COS² - AXE 1 (meilleurs représentés) ===print(top_cos2_axis1)## Danemark Norvège Islande Pologne
## 0.778 0.743 0.704 0.700
## Républiqueslovaque Chili Suisse Suède
## 0.658 0.626 0.594 0.499
## Hongrie Mexique
## 0.498 0.438# Axe 2
cos2_axis2 <- round(res_acp$ind$cos2[,2], 3)
top_cos2_axis2 <- sort(cos2_axis2, decreasing = TRUE)[1:10]
cat("\n=== TOP 10 COS² - AXE 2 (meilleurs représentés) ===\n")##
## === TOP 10 COS² - AXE 2 (meilleurs représentés) ===print(top_cos2_axis2)## Italie France Belgique Estonie Japon Slovenie États-Unis
## 0.742 0.611 0.582 0.515 0.493 0.466 0.463
## Corée Canada Espagne
## 0.440 0.435 0.387# Visualisation
fviz_pca_ind(res_acp,
col.ind = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE,
title = "Qualité de représentation (cos²)") +
theme_minimal()
Interprétation :
Les pays les mieux représentés sur l’axe 1 sont [liste], avec des cos² proches de 1. Leur position sur le graphique reflète fidèlement leur profil réel dans l’espace multidimensionnel.
d. Construction de cos2_12
# Construction de cos2_12 (somme des cos² sur Dim1 et Dim2)
cos2_12 <- res_acp$ind$cos2[,1] + res_acp$ind$cos2[,2]
# Création du data frame
cos2_12_df <- data.frame(
Pays = rownames(res_acp$ind$cos2),
Cos2_Dim1 = round(res_acp$ind$cos2[,1], 3),
Cos2_Dim2 = round(res_acp$ind$cos2[,2], 3),
Cos2_12 = round(cos2_12, 3)
)
# Tri par qualité sur le plan 1-2
cos2_12_df <- cos2_12_df[order(-cos2_12_df$Cos2_12), ]
# Affichage
cat("\n=== TOP 10 PAYS MIEUX REPRÉSENTÉS SUR LE PLAN 1-2 ===\n")##
## === TOP 10 PAYS MIEUX REPRÉSENTÉS SUR LE PLAN 1-2 ===print(head(cos2_12_df, 10))## Pays Cos2_Dim1 Cos2_Dim2 Cos2_12
## Danemark Danemark 0.778 0.125 0.903
## Islande Islande 0.704 0.122 0.826
## Italie Italie 0.079 0.742 0.821
## Norvège Norvège 0.743 0.049 0.792
## Corée Corée 0.333 0.440 0.773
## Chili Chili 0.626 0.129 0.756
## Pologne Pologne 0.700 0.037 0.737
## Estonie Estonie 0.213 0.515 0.727
## Républiqueslovaque Républiqueslovaque 0.658 0.064 0.722
## Suisse Suisse 0.594 0.075 0.669# Pays le mieux représenté
meilleur_pays <- cos2_12_df[1, ]
cat("\n🏆 PAYS LE MIEUX REPRÉSENTÉ SUR LE PLAN 1-2 :\n")##
## 🏆 PAYS LE MIEUX REPRÉSENTÉ SUR LE PLAN 1-2 :print(meilleur_pays)## Pays Cos2_Dim1 Cos2_Dim2 Cos2_12
## Danemark Danemark 0.778 0.125 0.903# Visualisation
barplot(cos2_12[order(-cos2_12)][1:15],
las = 2,
col = "steelblue",
main = "Qualité de représentation sur le plan 1-2",
ylab = "Cos² (Dim1 + Dim2)",
xlab = "")
## Interprétation :
Le pays le mieux représenté sur le plan factoriel 1-2 est [nom], avec un cos² de [valeur]. Cela signifie que le plan 1-2 résume très bien son profil multidimensionnel.
5. Graphe conjoint (biplot) et plans supplémentaires
# Biplot (individus + variables)
fviz_pca_biplot(res_acp,
geom.ind = "point",
pointshape = 21,
pointsize = 3,
fill.ind = res_acp$ind$cos2[,1],
col.ind = "black",
col.var = "contrib",
gradient.cols.var = c("blue", "green", "red"),
repel = TRUE,
title = "Biplot - Relations individus-variables") +
theme_minimal()
# Plans supplémentaires
# Plan 1-3
p13 <- fviz_pca_ind(res_acp, axes = c(1, 3),
geom = "text", repel = TRUE,
col.ind = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
title = "Plan factoriel 1-3")
# Plan 3-4 (si disponible)
if(ncol(res_acp$ind$coord) >= 4) {
p34 <- fviz_pca_ind(res_acp, axes = c(3, 4),
geom = "text", repel = TRUE,
col.ind = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
title = "Plan factoriel 3-4")
gridExtra::grid.arrange(p13, p34, ncol = 2)
} else {
p13
}
# Biplot (individus + variables)
fviz_pca_biplot(res_acp,
geom.ind = "point",
pointshape = 21,
pointsize = 3,
fill.ind = res_acp$ind$cos2[,1],
col.ind = "black",
col.var = "contrib",
gradient.cols.var = c("blue", "green", "red"),
repel = TRUE,
title = "Biplot - Relations individus-variables") +
theme_minimal()
# Plans supplémentaires
# Plan 1-3
p13 <- fviz_pca_ind(res_acp, axes = c(1, 3),
geom = "text", repel = TRUE,
col.ind = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
title = "Plan factoriel 1-3")
# Plan 3-4 (si disponible)
if(ncol(res_acp$ind$coord) >= 4) {
p34 <- fviz_pca_ind(res_acp, axes = c(3, 4),
geom = "text", repel = TRUE,
col.ind = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
title = "Plan factoriel 3-4")
gridExtra::grid.arrange(p13, p34, ncol = 2)
} else {
p13
}
Interprétation du biplot :
Le biplot permet d’analyser simultanément la position des pays et l’influence des variables. Les pays situés dans la direction d’une flèche ont des valeurs élevées pour cette variable.
6. Points et variables supplémentaires
a. États-Unis et Islande comme points supplémentaires
# Identifier les indices des pays
noms_pays <- rownames(vars_quant)
cat("Noms des pays disponibles :\n")## Noms des pays disponibles :print(noms_pays)## [1] "Australie" "Autriche" "Belgique"
## [4] "Canada" "Chili" "Républiquetchèque"
## [7] "Danemark" "Estonie" "Finlande"
## [10] "France" "Allemagne" "Grèce"
## [13] "Hongrie" "Islande" "Irlande"
## [16] "Italie" "Japon" "Corée"
## [19] "Luxembourg" "Mexique" "Pays-Bas"
## [22] "Nouvelle-Zélande" "Norvège" "Pologne"
## [25] "Portugal" "Républiqueslovaque" "Slovenie"
## [28] "Espagne" "Suède" "Suisse"
## [31] "Royaume-Uni" "États-Unis"# Rechercher États-Unis et Islande (adapter selon vos noms)
usa_index <- grep("États|USA|United|America", noms_pays, ignore.case = TRUE)
islande_index <- grep("Islande|Iceland", noms_pays, ignore.case = TRUE)
if(length(usa_index) > 0 & length(islande_index) > 0) {
ind_supp <- c(usa_index, islande_index)
# ACP avec points supplémentaires
res_acp_supp <- PCA(vars_quant,
scale.unit = TRUE,
ind.sup = ind_supp,
graph = FALSE,
ncp = 5)
# Visualisation
fviz_pca_ind(res_acp_supp,
geom.ind = "point",
col.ind = "black",
fill.ind = "white",
pointshape = 21,
pointsize = 2,
geom.sup = "point",
col.sup = "red",
repel = TRUE) +
labs(title = "ACP avec points supplémentaires (USA et Islande en rouge)")
cat("\n✅ ACP avec points supplémentaires réalisée\n")
cat("Intérêt : Ces points ne participent pas à la construction des axes\n")
cat("mais sont projetés sur le plan factoriel pour comparaison.\n")
} else {
cat("⚠️ États-Unis et/ou Islande non trouvés dans les données\n")
}##
## ✅ ACP avec points supplémentaires réalisée
## Intérêt : Ces points ne participent pas à la construction des axes
## mais sont projetés sur le plan factoriel pour comparaison.Intérêt de la démarche :
Considérer des points comme supplémentaires permet de ne pas influencer la construction des axes avec des individus atypiques. On peut ainsi vérifier leur position sans biaiser l’analyse.
b. Variable UE comme qualitative supplémentaire
# ACP avec UE comme variable qualitative supplémentaire
df_complet <- cbind(vars_quant, UE = my_data_acp$UE)
res_acp_qual <- PCA(df_complet,
scale.unit = TRUE,
quali.sup = which(colnames(df_complet) == "UE"),
graph = FALSE,
ncp = 5)
# Visualisation avec ellipses
fviz_pca_ind(res_acp_qual,
geom.ind = "point",
col.ind = df_complet$UE,
palette = c("#E69F00", "#56B4E9"),
addEllipses = TRUE,
ellipse.level = 0.95,
legend.title = "UE",
title = "Projection - Coloriage par appartenance UE") +
theme_minimal()## Ignoring unknown labels:
## • linetype : "UE"
# Test de comparaison (MANOVA)
coord_ind <- res_acp_qual$ind$coord[,1:2]
df_test <- data.frame(coord_ind, UE = df_complet$UE)
# Test de Wilks
if(require(car)) {
manova_res <- manova(cbind(Dim.1, Dim.2) ~ UE, data = df_test)
cat("\n=== TEST MANOVA (Wilks) ===\n")
print(summary(manova_res, test = "Wilks"))
}##
## === TEST MANOVA (Wilks) ===
## Df Wilks approx F num Df den Df Pr(>F)
## UE 1 0.51861 13.459 2 29 0.00007332 ***
## Residuals 30
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Tests univariés
cat("\n=== TEST SUR DIM1 ===\n")##
## === TEST SUR DIM1 ===print(t.test(Dim.1 ~ UE, data = df_test))##
## Welch Two Sample t-test
##
## data: Dim.1 by UE
## t = -1.0099, df = 20.045, p-value = 0.3246
## alternative hypothesis: true difference in means between group 0 and group 1 is not equal to 0
## 95 percent confidence interval:
## -2.2889093 0.7954052
## sample estimates:
## mean in group 0 mean in group 1
## -0.443384 0.303368cat("\n=== TEST SUR DIM2 ===\n")##
## === TEST SUR DIM2 ===print(t.test(Dim.2 ~ UE, data = df_test))##
## Welch Two Sample t-test
##
## data: Dim.2 by UE
## t = 4.961, df = 27.097, p-value = 0.00003351
## alternative hypothesis: true difference in means between group 0 and group 1 is not equal to 0
## 95 percent confidence interval:
## 1.273314 3.068921
## sample estimates:
## mean in group 0 mean in group 1
## 1.2891013 -0.8820167Réponse à la question :
Les pays de l’UE semblent [bien/mal] séparés des autres pays. Le test MANOVA (ou des tests de Student sur chaque dimension) permet de vérifier statistiquement cette différence. Si la p-value < 0.05, on conclut à une différence significative.
c. Variable taux de syndicalisation comme supplémentaire
# Identifier la colonne du taux de syndicalisation
col_syndic <- which(colnames(vars_quant) == "tx_syndic")
if(length(col_syndic) > 0) {
res_acp_syndic <- PCA(vars_quant,
scale.unit = TRUE,
quanti.sup = col_syndic,
graph = FALSE,
ncp = 5)
# Cercle avec variable supplémentaire
fviz_pca_var(res_acp_syndic,
col.var = "blue",
col.quanti.sup = "red",
repel = TRUE,
title = "Cercle des corrélations - tx_syndic en rouge") +
theme_minimal()
# Coordonnées de la variable supplémentaire
cat("\n=== COORDONNÉES DE TX_SYNDIC ===\n")
print(round(res_acp_syndic$quanti.sup$coord, 3))
cat("\n=== CORRÉLATION AVEC LES AXES ===\n")
print(round(res_acp_syndic$quanti.sup$cor, 3))
} else {
cat("⚠️ Variable 'tx_syndic' non trouvée\n")
}##
## === COORDONNÉES DE TX_SYNDIC ===
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## tx_syndic -0.544 -0.295 0.131 0.309 -0.133
##
## === CORRÉLATION AVEC LES AXES ===
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## tx_syndic -0.544 -0.295 0.131 0.309 -0.133Interprétation :
La variable taux de syndicalisation est [bien/mal] représentée sur les axes. Elle est principalement corrélée à Dim[X] avec un coefficient de [valeur]. Cela signifie que [interprétation économique].
7. Création d’indices indépendants
Démarche proposée :
# Utiliser les résultats de l'ACP pour créer deux indices
# Les composantes principales sont orthogonales (indépendantes)
# Indice 1 : basé sur les variables clés de Dim1
top_vars_dim1 <- names(sort(res_acp$var$contrib[,1], decreasing = TRUE)[1:4])
cat("Variables pour l'indice 1 (Dim1) :\n")## Variables pour l'indice 1 (Dim1) :print(top_vars_dim1)## [1] "heures" "salmoyPPP" "tx_inact" "empl_jeunes"# Indice 2 : basé sur les variables clés de Dim2
top_vars_dim2 <- names(sort(res_acp$var$contrib[,2], decreasing = TRUE)[1:4])
cat("\nVariables pour l'indice 2 (Dim2) :\n")##
## Variables pour l'indice 2 (Dim2) :print(top_vars_dim2)## [1] "empl_age" "ecart" "tx_chom" "d9_d1"# Création des indices pondérés
vars_std <- scale(vars_quant)
poids_dim1 <- res_acp$var$contrib[,1] / sum(res_acp$var$contrib[,1])
poids_dim2 <- res_acp$var$contrib[,2] / sum(res_acp$var$contrib[,2])
indice1 <- as.matrix(vars_std) %*% poids_dim1
indice2 <- as.matrix(vars_std) %*% poids_dim2
# Vérification de l'indépendance
cor_indices <- cor(indice1, indice2)
cat("\nCorrélation entre les indices :", round(cor_indices, 4))##
## Corrélation entre les indices : 0.3525cat("\n(Proche de 0 → indices indépendants)\n")##
## (Proche de 0 → indices indépendants)# Data frame des indices
indices_df <- data.frame(
Pays = rownames(vars_quant), # Correction : vars_quant
Indice_Economie1 = round(indice1[,1], 3),
Indice_Economie2 = round(indice2[,1], 3)
)
cat("\n=== TOP 10 INDICE 1 ===\n")##
## === TOP 10 INDICE 1 ===print(head(indices_df[order(-indices_df$Indice_Economie1), ], 10))## Pays Indice_Economie1 Indice_Economie2
## États-Unis États-Unis 0.642 0.370
## Mexique Mexique 0.532 0.442
## Islande Islande 0.449 0.406
## Corée Corée 0.375 1.299
## Chili Chili 0.296 0.905
## Irlande Irlande 0.263 -0.097
## Canada Canada 0.243 0.124
## Luxembourg Luxembourg 0.178 -0.621
## Australie Australie 0.168 0.016
## Danemark Danemark 0.166 -0.444cat("\n=== TOP 10 INDICE 2 ===\n")##
## === TOP 10 INDICE 2 ===print(head(indices_df[order(-indices_df$Indice_Economie2), ], 10))## Pays Indice_Economie1 Indice_Economie2
## Corée Corée 0.375 1.299
## Chili Chili 0.296 0.905
## Estonie Estonie -0.342 0.780
## Mexique Mexique 0.532 0.442
## Islande Islande 0.449 0.406
## États-Unis États-Unis 0.642 0.370
## Portugal Portugal -0.263 0.347
## Japon Japon -0.234 0.238
## Canada Canada 0.243 0.124
## Grèce Grèce 0.087 0.111# Visualisation des indices
ggplot(indices_df, aes(x = Indice_Economie1, y = Indice_Economie2, label = Pays)) +
geom_point() +
geom_text(vjust = -0.5, size = 3, check_overlap = TRUE) +
geom_hline(yintercept = 0, linetype = "dashed", color = "gray") +
geom_vline(xintercept = 0, linetype = "dashed", color = "gray") +
labs(title = "Positionnement des pays selon les deux indices",
x = "Indice 1 (Dimension 1)",
y = "Indice 2 (Dimension 2)") +
theme_minimal()
Démarche à expliquer :
Pour créer deux indices indépendants, on peut :
Utiliser les composantes principales de l’ACP qui sont orthogonales
Sélectionner les variables les plus contributives à chaque dimension
Créer une moyenne pondérée par les contributions
Standardiser les indices pour faciliter la comparaison
Les deux indices ainsi créés mesurent des aspects différents et complémentaires de l’économie du travail, sans redondance.
Comment interpreter La matrice de correlation ?
La matrice des corrélations met en évidence :
• Une corrélation négative forte entre tx_inact et empl_jeunes entre heures et salmoyPPP. • Une corrélation positive forte entre empl_jeunes et salmoyPPP. • Une corrélation négative faible entre tx_syndic et tx_chom. • Une corrélation possitive faible entre empl_age et salmoyPPP. Ces corrélations indiquent une structure latente des données, ce qui justifie l’utilisation d’une ACP.