ACP des régions Bulgares et des inégalités
Raphaëlle
17/06/2025
Options générales du script et téléchargement des packages
options("scipen" =100)
ggrepel.max.overlaps=Inf
library(dplyr)##
## Attachement du package : 'dplyr'## Les objets suivants sont masqués depuis 'package:stats':
##
## filter, lag## Les objets suivants sont masqués depuis 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(FactoMineR)
library(factoextra)## Le chargement a nécessité le package : ggplot2## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBalibrary(psych)##
## Attachement du package : 'psych'## Les objets suivants sont masqués depuis 'package:ggplot2':
##
## %+%, alphalibrary(Rcpp)
library(data.table)##
## Attachement du package : 'data.table'## Les objets suivants sont masqués depuis 'package:dplyr':
##
## between, first, lastlibrary(questionr)##
## Attachement du package : 'questionr'## L'objet suivant est masqué depuis 'package:psych':
##
## describelibrary(explor)
library(ade4)##
## Attachement du package : 'ade4'## L'objet suivant est masqué depuis 'package:FactoMineR':
##
## reconstlibrary(cluster)
library(corrplot)## corrplot 0.95 loadedlibrary(missMDA)
library(stats)
library(reshape2)##
## Attachement du package : 'reshape2'## Les objets suivants sont masqués depuis 'package:data.table':
##
## dcast, meltlibrary(ggplot2)
library(readxl)
library(tibble)
library(shiny)
library(readr)Importation des données
df <- read.csv2("C:/Users/Raph/Documents/thesebulgarie/STATISTIQUES/analysesR/ACP_CAHperiph/2025/Variables_Metadonnee_CAH Bulgarie.csv") #importation du tableau avec les données
row.names(df)<- df$REG_FR #on nomme la variable qui indique le nom de ligne
df2 <- df [,c(4:19)] #on supprime les lignes en trop (nom de la région en cyrillique + code)
summary <- summary(df2)
print(summary)## RevHab_24 Sal_Moy_23 Pop65_24 TxMig_14.24
## Min. :17555 Min. :15999 Min. :19.21 Min. :-87.848
## 1st Qu.:21483 1st Qu.:17812 1st Qu.:24.66 1st Qu.:-24.511
## Median :23653 Median :18684 Median :26.23 Median :-12.819
## Mean :24106 Mean :19303 Mean :26.10 Mean : 2.329
## 3rd Qu.:26355 3rd Qu.:19448 3rd Qu.:28.15 3rd Qu.: 37.675
## Max. :31829 Max. :34262 Max. :31.39 Max. :188.399
## DensPop_24 NonBG_21 AgriVA_23 IndusVA_23
## Min. : 23.21 Min. : 5.871 Min. : 0.09226 Min. :12.92
## 1st Qu.: 32.61 1st Qu.:11.371 1st Qu.: 3.75334 1st Qu.:24.58
## Median : 43.51 Median :18.633 Median : 5.85799 Median :29.10
## Mean : 78.46 Mean :23.810 Mean : 6.73498 Mean :31.64
## 3rd Qu.: 48.38 3rd Qu.:27.220 3rd Qu.: 9.90983 3rd Qu.:35.00
## Max. :964.95 Max. :73.520 Max. :16.48687 Max. :65.57
## PIBhab_23 PopRural_24 LitsHab_23 TxRisq_24
## Min. :13012 Min. : 4.863 Min. : 310.0 Min. :16.40
## 1st Qu.:15604 1st Qu.:27.644 1st Qu.: 785.8 1st Qu.:24.75
## Median :17416 Median :33.768 Median : 1033.5 Median :27.90
## Mean :20586 Mean :33.617 Mean : 1859.8 Mean :29.24
## 3rd Qu.:22179 3rd Qu.:39.788 3rd Qu.: 1989.8 3rd Qu.:33.15
## Max. :61833 Max. :59.304 Max. :11040.0 Max. :48.10
## EtSup_21 POP_24 POP_2021.2011 EVO_POP_2011.2021
## Min. :13.99 Min. : 70542 Min. :-51123 Min. :-25.40
## 1st Qu.:17.58 1st Qu.: 105956 1st Qu.:-37451 1st Qu.:-18.43
## Median :18.99 Median : 149379 Median :-26879 Median :-16.55
## Mean :20.61 Mean : 229906 Mean :-30171 Mean :-14.97
## 3rd Qu.:22.23 3rd Qu.: 223796 3rd Qu.:-22497 3rd Qu.:-10.68
## Max. :43.61 Max. :1295931 Max. :-11631 Max. : -1.30Analyse des données
-Matrices de corrélations
matrix<-cor(df2)
matrix## RevHab_24 Sal_Moy_23 Pop65_24 TxMig_14.24 DensPop_24
## RevHab_24 1.00000000 0.32320910 0.1473535374 -0.03988019 0.42741512
## Sal_Moy_23 0.32320910 1.00000000 -0.3731600992 0.27684058 0.87791033
## Pop65_24 0.14735354 -0.37316010 1.0000000000 0.01215190 -0.45278293
## TxMig_14.24 -0.03988019 0.27684058 0.0121518979 1.00000000 0.18864507
## DensPop_24 0.42741512 0.87791033 -0.4527829298 0.18864507 1.00000000
## NonBG_21 -0.18747719 -0.11910907 -0.0109813467 0.44321245 -0.07921474
## AgriVA_23 -0.32595209 -0.55742351 0.1453592178 -0.20041543 -0.39269513
## IndusVA_23 -0.10684557 0.10039424 -0.0122052563 0.13162602 -0.27895610
## PIBhab_23 0.35699611 0.95173991 -0.4066632394 0.19655631 0.86448275
## PopRural_24 -0.34519041 -0.54810282 -0.0715788123 -0.02664754 -0.52473899
## LitsHab_23 0.41377406 0.81274325 -0.3318930802 0.27211392 0.84838550
## TxRisq_24 -0.11979852 -0.01250864 0.0008314837 -0.01479616 -0.09921621
## EtSup_21 0.42953542 0.82692345 -0.2050126049 0.16495283 0.82760799
## POP_24 0.38648988 0.85252718 -0.3937831695 0.31955490 0.90251055
## POP_2021.2011 0.01213585 0.07120069 -0.2437991473 0.20663052 0.17798433
## EVO_POP_2011.2021 0.16089286 0.61278517 -0.2814663001 0.67736355 0.53917319
## NonBG_21 AgriVA_23 IndusVA_23 PIBhab_23 PopRural_24
## RevHab_24 -0.18747719 -0.32595209 -0.106845568 0.35699611 -0.34519041
## Sal_Moy_23 -0.11910907 -0.55742351 0.100394244 0.95173991 -0.54810282
## Pop65_24 -0.01098135 0.14535922 -0.012205256 -0.40666324 -0.07157881
## TxMig_14.24 0.44321245 -0.20041543 0.131626018 0.19655631 -0.02664754
## DensPop_24 -0.07921474 -0.39269513 -0.278956102 0.86448275 -0.52473899
## NonBG_21 1.00000000 0.54164103 -0.076420946 -0.20278981 0.59459290
## AgriVA_23 0.54164103 1.00000000 -0.349461991 -0.60128870 0.69362489
## IndusVA_23 -0.07642095 -0.34946199 1.000000000 0.13437522 0.16813744
## PIBhab_23 -0.20278981 -0.60128870 0.134375217 1.00000000 -0.58507086
## PopRural_24 0.59459290 0.69362489 0.168137443 -0.58507086 1.00000000
## LitsHab_23 -0.18085885 -0.59699877 -0.154301874 0.80624771 -0.59827563
## TxRisq_24 0.24059238 0.05017972 0.009425989 -0.06607604 0.11769258
## EtSup_21 -0.37351221 -0.67200581 -0.176267496 0.85692630 -0.81285909
## POP_24 -0.12563249 -0.57297693 -0.203148151 0.84163698 -0.60634348
## POP_2021.2011 0.30019869 0.25775948 -0.020224916 0.04503348 0.33306569
## EVO_POP_2011.2021 0.11490137 -0.59103089 0.106953044 0.55961374 -0.30693025
## LitsHab_23 TxRisq_24 EtSup_21 POP_24
## RevHab_24 0.41377406 -0.1197985178 0.4295354 0.38648988
## Sal_Moy_23 0.81274325 -0.0125086405 0.8269234 0.85252718
## Pop65_24 -0.33189308 0.0008314837 -0.2050126 -0.39378317
## TxMig_14.24 0.27211392 -0.0147961591 0.1649528 0.31955490
## DensPop_24 0.84838550 -0.0992162106 0.8276080 0.90251055
## NonBG_21 -0.18085885 0.2405923823 -0.3735122 -0.12563249
## AgriVA_23 -0.59699877 0.0501797226 -0.6720058 -0.57297693
## IndusVA_23 -0.15430187 0.0094259888 -0.1762675 -0.20314815
## PIBhab_23 0.80624771 -0.0660760370 0.8569263 0.84163698
## PopRural_24 -0.59827563 0.1176925782 -0.8128591 -0.60634348
## LitsHab_23 1.00000000 -0.0340952460 0.8416671 0.97536572
## TxRisq_24 -0.03409525 1.0000000000 -0.1436434 -0.03606047
## EtSup_21 0.84166712 -0.1436434251 1.0000000 0.86716764
## POP_24 0.97536572 -0.0360604691 0.8671676 1.00000000
## POP_2021.2011 -0.17101406 -0.1025496471 -0.1775574 -0.09104488
## EVO_POP_2011.2021 0.68673322 0.0005055666 0.5009681 0.73535819
## POP_2021.2011 EVO_POP_2011.2021
## RevHab_24 0.01213585 0.1608928594
## Sal_Moy_23 0.07120069 0.6127851720
## Pop65_24 -0.24379915 -0.2814663001
## TxMig_14.24 0.20663052 0.6773635534
## DensPop_24 0.17798433 0.5391731870
## NonBG_21 0.30019869 0.1149013695
## AgriVA_23 0.25775948 -0.5910308884
## IndusVA_23 -0.02022492 0.1069530440
## PIBhab_23 0.04503348 0.5596137363
## PopRural_24 0.33306569 -0.3069302541
## LitsHab_23 -0.17101406 0.6867332173
## TxRisq_24 -0.10254965 0.0005055666
## EtSup_21 -0.17755738 0.5009681077
## POP_24 -0.09104488 0.7353581935
## POP_2021.2011 1.00000000 0.1121536350
## EVO_POP_2011.2021 0.11215364 1.0000000000#matrix<-cor(dfpourmatrice)
write.csv2(matrix, "C:/Users/Raph/Documents/thesebulgarie/STATISTIQUES/analysesR/ACP_CAHperiph/2025/matricecorrelationSOFIAV2.csv")-densité de population se recoupe avec rural, PIB, études, lits hop
-AgriVA se recoupe avec rural
-PIB/hab se recoupe avec salaires
-Analyse bivariée (exemple)
#ggplot(ACP, aes(x=RevHab_24, y=TxRisq_24))+geom_point (size=2, shape=20)+ geom_text(label=rownames(ACP))+geom_smooth(method="auto", se=TRUE, fullrange=FALSE, level=0.95)
#ggplot(NSACP, aes(x=TxRisq_24, y=Sal_Moy_23))+geom_point (size=2, shape=20)+ geom_text(label=rownames(NSACP))+geom_smooth(method="auto", se=TRUE, fullrange=FALSE, level=0.95)
#ggplot(NSACP, aes(x=RevHab_24, y=IndusVA_23))+geom_point (size=2, shape=20)+ geom_text(label=rownames(NSACP))+geom_smooth(method="auto", se=TRUE, fullrange=FALSE, level=0.95)
#ggplot(ACP, aes(x=CohesHab,y=IdePIB))+geom_point (size=2, shape=20)+ geom_text(label=rownames(ACP))+geom_smooth(method="auto", se=TRUE, fullrange=FALSE, level=0.95)-Tests de redondance
—Test de Bartlett
Le test de spécificité de Bartlett permet de voir dans quelle
mesure la matrice de corrélation diverge de la matrice unité, càd de la
matrice théorique de colinéarité parfaite sous l’hypothèse nulle
(H=0).
Il faut que l’hypothèse nulle soit démentie par les données. Si
l’hypothèse nulle est rejetée, on peut compresser l’information. Si R=0
alors il y a colinéarité parfaite. Si R = 1 alors aucune corrélation
entre les données.
Si R est inférieur a 0,00001 : on considère qu’il y a une très forte redondance entre les données.
det(matrix)## [1] 0.00000000007272682cortest.bartlett(matrix, n=28)## $chisq
## [1] 486.3398
##
## $p.value
## [1] 0.000000000000000000000000000000000000000000001378018
##
## $df
## [1] 120La matrice de corrélation s’écarte significativement de la matrice unité : pvalue < 0,05
—Test de solution factorielle KMO :
permet de voir la corrélation nette entre deux variables, c’est à dire en retranchant l’influence des autres variables dans les corrélations obtenues sur la matrice. Si la corrélation nette est inférieure à la corrélation brute alors les liaisons sont déterminées par d’autres variables. Cela veut dire qu’il y a bcp de redondance. Si la corrélation brute > corrélation nette ou équivalente alors la relation directe entre les variables est réelle et sera prise en comtpe par l’ACP. Les variables déterminerons des axes.
KMO(matrix)## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = matrix)
## Overall MSA = 0.62
## MSA for each item =
## RevHab_24 Sal_Moy_23 Pop65_24 TxMig_14.24
## 0.62 0.82 0.34 0.59
## DensPop_24 NonBG_21 AgriVA_23 IndusVA_23
## 0.71 0.65 0.52 0.15
## PIBhab_23 PopRural_24 LitsHab_23 TxRisq_24
## 0.80 0.71 0.73 0.09
## EtSup_21 POP_24 POP_2021.2011 EVO_POP_2011.2021
## 0.69 0.66 0.25 0.50Réalisation de l’analyse à composantes principales
-Centrer réduire les données
Analyse de la variabilité et homogénéisation (scaling and centering)
df_scale <- scale(df2)-ACP
ACP <- PCA(df_scale, ncp = 4, graph = TRUE)## Warning: ggrepel: 7 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps
-Visualisation des composantes
—Tableau des valeurs propres
get_eigenvalue(ACP)## eigenvalue variance.percent cumulative.variance.percent
## Dim.1 7.170969415 44.81855884 44.81856
## Dim.2 2.331004769 14.56877981 59.38734
## Dim.3 1.556123674 9.72577297 69.11311
## Dim.4 1.259893644 7.87433528 76.98745
## Dim.5 1.133549167 7.08468230 84.07213
## Dim.6 0.868724841 5.42953026 89.50166
## Dim.7 0.569597408 3.55998380 93.06164
## Dim.8 0.524073458 3.27545911 96.33710
## Dim.9 0.212234733 1.32646708 97.66357
## Dim.10 0.143775026 0.89859391 98.56216
## Dim.11 0.079601465 0.49750916 99.05967
## Dim.12 0.064393943 0.40246215 99.46213
## Dim.13 0.044818112 0.28011320 99.74225
## Dim.14 0.024764106 0.15477566 99.89702
## Dim.15 0.013175575 0.08234734 99.97937
## Dim.16 0.003300662 0.02062914 100.000004 dimensions choisies
—Visualisation de l’inertie des dimensions : diagramme de coude de Castells
screen.plot <- fviz_eig(ACP, addlabels = T, ylim=c(0,40))
screen.plot## Warning in geom_bar(stat = "identity", fill = barfill, color = barcolor, :
## Ignoring empty aesthetic: `width`.
-Explor ACP : analyse
explor(ACP)Commentaire de l’ACP
Les axes restent les mêmes que Sofia soit inclus ou exclus
-Premier axe (33%)
Le premier axe résume 33% de l’inertie des données. Les variables qui y contribuent le plus sont :
-la population totale en 2024 (19%), le nombre de lits d’hôpitaux par habitant, (18%) le pourcentage de personnes ayant réalisé des études supérieures (17,6%) , le PIB par habitant (12,35%), l’augmentation de la population (9,56 %)
-d’un autre côté : la population rurale (12,15%),
Cet axe est donc nettement un axe urbain - rural. Le taux de risque de pauvreté et le revenu par habitant ne sont pas corrélé à cet axe.
Les régions qui contribuent le plus à cet axe sont : Plovdiv (25%), Varna (17,5%), Stara Zagora (9%) et Burgas (9%)
-Second axe (20%)
Le 2nd axe résume 20% de l’inertie des données. Les variables qui y contribuent le plus sont :
-d’un côté, la part de personnes se déclarant non bulgares (22%), le taux migratoire plutôt positif (20,33%) de même que l’évolution de la population (17,37%) et son caractère rural (12,62%)
-d’un autre côté la population âgée (6,34), le revenu par habitant (pensions e retraites) (6.29)
Cet axe est un axe où s’opposent des régions un peu plus dynamiques sur le plan démographique, y compris du point de vue de l’accroissement migratoire, où une partie plus importante de la population qu’ailleurs se déclare non bulgares mais qui sont assez pauvres en terme de revenus et marquées par une forte ruralité
À l’inverse, on a des régions où la population est en déclin, peu attractive, où la part de la population âgée de plus de 65 ans est plus importante qu’ailleurs et qui ont des revenus plus importants, du fait des pensions de retraite
Le PIB par habitant , les lits d’hôpitaux ne sont pas corrélé à cet axe
Contribuent tres largement Kardzhali, (42%) suivi de la région de Sofia (6,5%( et de Razgrad (5,3%) et, de l’autre côté, Gabrovo (9,88%) et Smoljan (7,24%)
-Troisième axe (13%)
Le troisième axe résume 13% de l’inertie des données
Il est tiré par la variable de la part de l’industrie dans la VA, d’un côté, avec 33,17% et le PIB par habitant (21%) Vraca (25%), Stara(19), Sofia, region 9) Lovec (7,64) == région rurale industrielle
De l’autre côté : région non indutrielle et population âgée (21%) ==> région rurale ou urbaine avec population plus âgée. PIB par hab moindre soit parce que bcp hab soit parce que peu PIB
-Quatrième axe (9,8%)
Tiré par le revenu par habitant (22,79) et la population âgée (18,5) et la part de l’industrie dans la valeur ajouté (18,24) et le taux migratoire = Gabrovo (14%)
== le revenu par habitant peut être tiré soit par les pensions de retraite, soit par la part de l’industrie dans la VA
D’un autre côté le taux de risque de pauvreté (14,20)=Vidin (15%)
Classification ascendante hiérarchique - CAH
(6 classes)
CAH <- agnes (df_scale, metric = "euclidean", method = "ward")#Matrice des distances entre individus
CAH_dist <-dist(df_scale,method="euclidian")
#Aggrégation selon le critère de Ward et dendogramme
CAH_dendogramme <- as.data.frame(df_scale)
CAH_dendogramme6CL <- HCPC(CAH_dendogramme, nb.clust = 6, graph=FALSE)
#plot.HCPC(CAH_dendogramme6CL, choice = "3D.map")
plot.HCPC(CAH_dendogramme6CL, choice = "tree")
Ajout des clusters et création de leur profil
clusCAH <- cutree(CAH, k=6) #on le fait pour 6 classes
#ajout des clusters aux deux dataframe dans une nouvelle colonne
##dataframe non mis à l'échelle
df2 <- as.data.frame(df2)
df2$clusCAH <- factor(clusCAH, levels = 1:6, labels = paste("CLUS", 1:6))
#dataframe original
df$clusCAH<- factor(clusCAH, levels = 1:6, labels = paste("CLUS", 1:6))
##dataframe mis à l'échelle
df_scale <- as.data.frame(df_scale)
df_scale$clusCAH<-factor(clusCAH, levels =1:6, labels =paste("CLUST",1:6 ))
#sur les clusters mis à l'échelle, moyennes
clusProfile6cl <- aggregate (df_scale[, 1:16], by=list(df_scale$clusCAH), mean)
#faire les moyennes sur les clusters non mis à l'échelle
moyennesclus <-aggregate(df2[, 1:16], by=list(df2$clusCAH), mean)
write.csv2(moyennesclus, "C:/Users/Raph/Documents/thesebulgarie/STATISTIQUES/analysesR/ACP_CAHperiph/2025/moyennesclus.csv")
#graphique comparant les moyennes en sur et en sous représentation
colnames(clusProfile6cl) [1] <- "CLUSTER"
clusLong <- melt(clusProfile6cl, id.vars = "CLUSTER")
ggplot(clusLong)+geom_bar(aes(x=variable, y=value, fill=CLUSTER), stat="identity")+scale_fill_grey () + facet_wrap (~CLUSTER)+coord_flip()+theme_bw()
write.csv2(df,"C:/Users/Raph/Documents/thesebulgarie/STATISTIQUES/analysesR/ACP_CAHperiph/2025/CAH Bulgarie CLUSTER Avec Sofia cluster 6V2.csv")