1 Introduction

Dans le cadre du cours de fouille de données du master 1 Méga Données et Analyse Sociale du CNAM, nous avons abordé l’analyse de clusters, en utilisant les méthodes K-means et K-medoids.

Ces méthodes d’apprentissage non supervisées sont utilisées pour regrouper les données dans différents clusters en fonction de la similarité de leurs caractéristiques. Le clustering est donc très utile dans l’exploration des mégadonnées, permettant de révéler des tendances et des indices pour une analyse plus approfondie des données.

Pour mener à bien ce projet, nous avons d’abord analysé les différents mesures de distance, puis le fonctionnement de la normalisation et du traitement des données binaires, et enfin nous avons abordé les méthodes K-means et K-medoids. Sur cette base, ce document présentera une analyse des inégalités en Europe en utilisant les données d’Eurostat.

2 Méthodes de mesure de distance

Les mesures de distance constituent la base de nombreux algorithmes d’apprentissage supervisé et non supervisé, notamment les K-means et les K-medoids.

Une fonction de distance doit satisfaire certaines propriétés ou axiomes parmi lesquels on trouve trois axiomes principaux.

Le principe d’identité des indiscernables ;
Le principe de symétrie et;
Le principe de l’inégalité triangulaire

Dans cette section, nous avons traité les mesures de distance Euclidienne, de Manhattan, de Minkowski et de Canberra.

2.1 Distance Euclidienne

Il s’agit probablement du type de distance le plus couramment choisi, qui correspond à la distance géométrique dans l’espace multidimensionnel.

Elle est définie par : \[ d(\textbf x,\textbf y):=\sqrt {\sum _{j=1}^m \left( x_{j}-y_{j}\right)^2. } \] Il convient de préciser que la distance euclidienne au carré ne forme pas un espace métrique, car elle ne satisfait pas la condition de l’inégalité triangulaire.

Elle est définie par :

\[ d\left( x,y\right)^2 = {\sum _{j=1}^{m} \left( x_{j}-y_{j}\right)^2. } \]

2.2 Distance de Manhattan

Définie par Hermann Minkowski, la distance de Manhattan est la distance entre deux points parcourue par un taxi dans une ville où les rues sont disposées en grille, comme dans l’image ci-dessus :

La ligne verte représente la distance euclidienne, tandis que les autres lignes colorées représentent la distance de Manhattan.

Cette distance est définie par: \[ d(\textbf x,\textbf y):=\sum_{j=1}^m |x_j-y_j|. \] - Exemple de calcul de distance entre un point a = (2, 4, 4, 6) et un point b = (5, 5, 7, 8) en utilisant la mesure de Manhattan:

manhattan_dist <- function(a, b){
     dist <- abs(a-b)
     dist <- sum(dist)
     return(dist)
}
a <- c(2, 4, 4, 6)
b <- c(5, 5, 7, 8)

manhattan_dist(a,b)

## [1] 9

Calcul de la distance entre les vecteurs x = (0,0) et y = (6,6) en utilisant les mesures de distance Euclidienne et de Manhattan :

x = c(0,0)
y = c(6,6)

#Distance Euclidienne

de<-dist(rbind(x,y),method = "euclidian", diag=T, upper=T)%>%
  as.matrix()%>%
  kbl(caption = "Distance Euclidienne") %>%
  kable_classic(full_width = F, html_font = "Cambria")

#Distance de Manhattan

dm<-dist(rbind(x,y),method = "manhattan", diag=T, upper=T)%>%
  as.matrix()%>%
  kbl(caption = "Manhattan") %>%
  kable_classic(full_width = F, html_font = "Cambria")

knitr::kables(list(de,dm))%>%
  kable_styling(position = "center", full_width = F)

Distance Euclidienne
	x	y
x	0.000000	8.485281
y	8.485281	0.000000

Manhattan
	x	y
x	0	12
y	12	0

2.3 Distance de Canberra

La distance de Canberra est une mesure numérique de la distance entre des points dans un espace vectoriel. Il s’agit d’une version pondérée de la distance de Manhattan.

Elle est définie par :

\[ d(\textbf x,\textbf y):=\sum_{j=1}^{m} {\frac{|x_{j} - y_{j}|} {|x_{j}| + |y_{j}|}}. \] - Calcul de la distance entre les vecteurs x = (0,0) et y = (6,6) en utilisant la mesure de Canberra :

data.frame(x = c(0,0),y = c(6,6)) %>%
  t() %>%
  dist(method = "canberra",TRUE,TRUE) %>%
  as.matrix() %>%
  kbl(caption = "Distance de Canberra") %>%
kable_classic(full_width = F, html_font = "Canberra")

Distance de Canberra
	x	y
x	0	2
y	2	0

2.4 Minkowski distance

La distance de Minkowski est une mesure de distance entre deux points dans l’espace vectoriel normé. Cette mesure est une généralisation de la distance euclidienne et de la distance de Manhattan.

Elle est définie par :

\[ d(\textbf x,\textbf y):=\left[\sum_{j=1}^m |x_j-y_j|^p\right]^{1/p}. \] - Calcul de la distance entre les vecteurs x = (0,0) et y = (6,6) en utilisant la mesure de Minkowski :

data.frame(x = c(0,0),y = c(6,6)) %>% 
  t() %>% 
  dist(method="minkowski",p=1)%>% 
  as.matrix() %>% kbl(caption = "Distance de Minkowski") %>%
  kable_classic(full_width = F, html_font = "Minkowski")

Distance de Minkowski
	x	y
x	0	12
y	12	0

Le graphique suivant montre le comportement de la distance de Minkowski entre les vecteurs x = (0, 0) et y = (6, 6) en fonction du paramètre p. Lorsque p=1 , la distance correspond à la distance de Manhattan, lorsque p=2, la distance correspond à la distance euclidienne.

minkowski <- function(p) {
  res <- as.matrix(data.frame(x=c(0,0), y=c(6,6))) %>%
  t() %>%
  dist(method = "minkowski", p = p, diag = TRUE, upper = TRUE)
  res <- as.matrix(res)[1,2]
  return(res)
}

res = c()
for(p in seq(1,5,0.01)){
  res = c(res, minkowski(p))
}

plot(seq(1,5,0.01),res,type ="l",main = "Distance de Minkowski en fonction du paramètre 'p'", xlab = "p", ylab="Distance de Minkowski", col="red", lwd=3)

3 Normalisation

Nous allons maintenant aborder les méthodes de normalisation des données.

Les méthodes de normalisation des données sont utilisées pour que les variables, mesurées à différentes échelles (tels comme la taille en centimètres et le poids en kilos) aient des valeurs comparables.

Nous revenons à l’exemple de Kaufman et Rousseeuw qui présentent des données sur l’âge et la taille des individus :

df_personnes <- data.frame(Person = c("A","B","C","D"),
                           Age = c(35,40,35,40),
                           Height = c(190,190,160,160))

df_personnes%>%
  kbl(caption = "Âge et taille de quatre personnes")%>%
  kable_classic(full_width = F)

Âge et taille de quatre personnes
Person	Age	Height
A	35	190
B	40	190
C	35	160
D	40	160

Exploration graphique des données :

#Graphique 1
ggplot(df_personnes, aes(x=Age, y=Height))+
  geom_point(color="blue")+
  geom_text(label=df_personnes$Person,
            nudge_x = 0.10,nudge_y= 2.5,
            check_overlap = T) +
  xlab("Âge")+
  ylab("Taille (cm)")+
  labs(title = "Âge par taille(cm) - Données non normalisées")+
  theme(axis.title = element_text(face = "bold"),
    plot.title = element_text(face = "bold"))+
  theme(plot.title = element_text(hjust = 0.5))

#Graphique 2
ggplot(df_personnes, aes(x=Age, y=Height/30.48))+
  geom_point(color="green")+
  geom_text(label=df_personnes$Person,
            nudge_x = 0,nudge_y= 0.50,
            check_overlap = T)+
  expand_limits(x=c(34,42),
                y=c(0,9))+xlab("Âge")+
  ylab("Taille (ft)")+
  theme(axis.title = element_text(face = "bold"),
    plot.title = element_text(face = "bold"))+
  labs(title = "Âge par taille(ft) - Données non normalisées") +
  theme(plot.title = element_text(hjust = 0.5))

Maintenant, nous procédons à la normalisation.

df_personnes_n<-data.frame(scale(df_personnes[-1]))

#Graphique 3
ggplot(df_personnes_n,aes(x=Age, y=Height))+
geom_point(color="red")+
  geom_text(label=df_personnes$Person,
            nudge_x = 0,nudge_y= 0.10,
            check_overlap = T)+
  expand_limits(x=c(0,1),y=c(0,1))+
  xlab("Äge")+
  ylab("Taille(cm)")+
  theme(axis.title = element_text(face = "bold"),
    plot.title = element_text(face = "bold"))+
  labs(title = "Âge par taille(cm) - données normalisées") +
  theme(plot.title = element_text(hjust = 0.5))

Ces graphiques permettent de constater que les mesures utilisées, ainsi que la normalisation ou non des données, influencent la manière dont les données seront représentées.

4 Mesures de similarité pour les données binaires

Les données binaires sont celles qui portent sur la présence ou absence de caractères qualitatifs à 2 niveaux ; lorsqu’il y a n caractères, la présence du caractère est notée par 1 et son absence par 0.

Prenons un autre exemple de Kaufman et Rousseeuw contenant des données binaires de huit personnes :

dfbinaire <- data.frame(person=c("Ilan","Talia","Jacqueline","Kim",
                                 "Lieve","Leon","Peter","Tina"),
                        sex=c(1,0,0,0,0,1,1,0),
                        married_single=c(0,0,1,0,1,1,1,0),
                        hair_fair_dark=c(1,0,0,1,0,0,0,0),
                        eyes_blue_brown=c(1,1,0,0,0,0,0,1),
                        glasses=c(0,0,1,0,0,1,1,0),
                        face_round_oval=c(0,1,0,0,0,1,0,1),
                        pesimist_optimist=c(1,0,0,1,0,0,1,0),
                        evening_morning=c(0,0,0,0,1,1,1,0),
                        only_child=c(0,0,0,0,1,1,0,0),
                        left_right=c(0,0,0,1,0,0,0,0))

#Visualisation des données
dfbinaire%>%
  head(4)%>%
  kbl(caption = "<center><strong>Variables binaires pour 8 personnes</center></strong>")%>%
  kable_classic(full_width = F)

**Variables binaires pour 8 personnes**
person	sex	married_single	hair_fair_dark	eyes_blue_brown	glasses	face_round_oval	pesimist_optimist	left_right
Ilan	1	0	1	1	0	0	1	0
Talia	0	0	0	1	0	1	0	0
Jacqueline	0	1	0	0	1	0	0	0
Kim	0	0	1	0	0	0	1	1

#Calcul de distance à l'aide de la librairie "ade4".

dist_dfbinaire <-dfbinaire%>%
  select(-person)%>%
  dist.binary(method=2,diag=FALSE, upper=FALSE)%>%
as.matrix()

row.names(dist_dfbinaire) <- c("Ilan","Talia","Jacqueline","Kim","Lieve","Leon","Peter","Tina")
colnames(dist_dfbinaire) <- c("Ilan","Talia","Jacqueline","Kim","Lieve","Leon","Peter","Tina")

4.1 Représentation de la matrice des similarités

Utilisons corplot pour faire cette représentation.
Malheureusement, une corrélation ne s’apparente pas à une distance mais plutôt à une similarité.
Nous allons donc représenter directement les similarités fournies par la matrice des distances ci-dessus.

On constate que les deux personnes les plus semblables sont Talia et Tina.

corrplot(1-(dist_dfbinaire^2),method ="circle", type="upper", diag=FALSE,title="Graphique de corrélation entre les individus", mar=c(0,0,1.5,0))

Examinons un autre exemple d’application avec les données du Titanic récupérées dans Kaggle.

titanic <- read.csv('titanic.csv')%>%
  head(20)%>%
  select(-c(X, Age, Fare, Family_size))%>%
  drop_na()

titanic_m <- titanic%>%
  select(-PassengerId)%>%
  as.matrix()

row.names(titanic_m)<- titanic$PassengerId

dist_titanic <-titanic_m%>%
  dist.binary(method=2,diag=FALSE, upper=FALSE)%>%
  as.matrix()

Voici la représentation de la matrice des similarités :

corrplot(1-(dist_titanic^2),method =  "circle", type="upper", diag=FALSE, title= "Matrice des similarités des passagers du Titanic", mar=c(0,0,1.3,0))

5 La dissimilarité de Gower

Cette méthode est utilisée lors que chaque observation est constituée de variables de plusieurs types.

Prenons l’exemple suivant en utilisant la base de données “flowers” disponible dans le système :

data(flower)

df_flower<- flower

row.names(df_flower) <- c("Begonia", "Broom", "Camellia", "Dahlia", "Forget-me-not", "Fuchsia", "Geranium", "Gladiolus", "Heather", "Hydrangea", "Iris", "Lily", "Lily-valley", "Peony", "Pink-carnation","Red rose", "Scotch Rose", "Tulip")

dist1 = daisy(df_flower, metric= "gower")
as.matrix(dist1)[1:2,1:2]

##           Begonia     Broom
## Begonia 0.0000000 0.8875408
## Broom   0.8875408 0.0000000

fviz_dist(dist1, show_labels = T) +
  theme(plot.title = element_text(face = "bold"))+
  labs(title = "Graphique de corrélation")

Prenons un autre exemple avec des données organiques sur les diamants :

diamonds <- diamonds%>%
  head(20)

diamonds%>%
  head(4)%>%
  kbl(caption = "<center><strong>Jeu de données sur les diamants</center></strong>")%>%
  kable_classic(full_width = F)

**Jeu de données sur les diamants**
carat	cut	color	clarity	depth	table	price	x	y	z
0.23	Ideal	E	SI2	61.5	55	326	3.95	3.98	2.43
0.21	Premium	E	SI1	59.8	61	326	3.89	3.84	2.31
0.23	Good	E	VS1	56.9	65	327	4.05	4.07	2.31
0.29	Premium	I	VS2	62.4	58	334	4.20	4.23	2.63

dist2 = daisy(diamonds, metric= "Gower")
as.matrix(dist2)[1:2,1:2]

##           1         2
## 1 0.0000000 0.1896755
## 2 0.1896755 0.0000000

fviz_dist(dist2) +
  theme(plot.title = element_text(face = "bold"))+
  labs(title = "Graphique de corrélation")

6 K-means

L’objectif de l’algorithme K-Means est de fournir une classification des informations en fonction des données elles-mêmes. Cette classification est basée sur l’analyse et la comparaison des valeurs numériques des données. De cette façon, l’algorithme fournit une classification automatique sans besoin de supervision humaine, c’est-à-dire sans aucune pré-classification existante.

Pour générer les classes et classer les occurrences, l’algorithme effectue une comparaison entre chaque valeur de chaque ligne en utilisant la distance, généralement euclidienne. Ensuite, l’algorithme calcule les centroïdes pour chacune des classes. Enfin, l’algorithme génère k centroïdes et classe les occurrences du tableau en fonction de leur distance par rapport à ces centroïdes.

6.1 Jeu de données plats et leurs valeurs nutritionnelles

Nous avons repris l’exemple de J. Hartigan sur les plats et leurs valeurs nutritionnelles :

hartigan<-read.csv("Hartigandata1.csv")%>%
  select(3,4,6)%>%
  head(8)

hartigan[3,1]<-13 # Corriger l'erreur en ligne 3
hartigan[6,1]<-4 # Corriger l'erreur en ligne 6
hartigan[7,3]<-1 # Corriger l'erreur en ligne 7

rownames(hartigan)<-c("BB","HR","BR","BS","BC","CB","CC","BH")
colnames(hartigan)<-c("Energy","Protein","Calcium")

Voici les données en question :

**Plats et leurs valeurs nutritionnelles**
	Energy	Protein	Calcium
BB	11	29	1
HR	8	30	1
BR	13	21	1

Pour effectuer le clustering, nous transformons le data frame en une matrice, en ne conservant que les valeurs numériques, puis nous utilisons la méthode “fviz_nbclust” pour définir le nombre idéal de “k”.

# Transformer le dataframe en matrice
hartigan<-hartigan%>%
  as.matrix()

set.seed(1) #Sert à partir de la même configuration initiale 

km <- kmeans(hartigan, centers = 4, nstart= 25)
#km$tot.withinss # L'erreur quadratique inter-cluster 

# Mèthode pour voir le nombre idéel de "K"
fviz_nbclust(hartigan, kmeans, method = "wss", k.max = 7)

En définissant “K” égal à 4, on obtient les groupes suivants :

fviz_cluster(km, data = hartigan)

Pour vérifier la pertinence du regroupement, il est possible d’utiliser la méthode de la silhouette qui permet l’interprétation et la validation de la cohérence au sein de l’analyse des groupes. Cette technique fournit une représentation graphique succincte de la qualité de la classification de chaque observation.

s<-silhouette(km$cluster, dist(hartigan))
row.names(s)<-row.names(hartigan)

fviz_silhouette(s, label=TRUE)

##   cluster size ave.sil.width
## 1       1    2          0.60
## 2       2    1          0.00
## 3       3    2          0.79
## 4       4    3          0.41

s%>%
  as.data.frame.matrix()%>%
  arrange(cluster)%>%
  kable(caption = "<center><strong>Valeurs des silhouettes</strong></center>", col.names = c("Cluster","Voisin","Largeur de la silhouette"))%>%
  kable_styling(full_width = F, position = "center",row_label_position="c")%>%
   row_spec(1:1, bold = T, background = "#B3E5FC")%>%
  row_spec(2:3, bold = T, background = "#FFF59D")%>%
  row_spec(4:5, bold = T, background = "#FFAB91")%>%
  row_spec(6:8, bold = T, background = "#C8E6C9")

**Valeurs des silhouettes**
	Cluster	Voisin	Largeur de la silhouette
BB	1	4	0.5710731
BS	1	2	0.6323927
BR	2	1	0.0000000
CC	3	4	0.7764139
BH	3	4	0.8061654
HR	4	1	0.1947596
BC	4	3	0.5168427
CB	4	3	0.5312237

6.2 Dataset USArrests

Nous allons reproduire un autre exemple avec l’ensemble de données sur les arrestations aux États-Unis.

Quatre groupes ont été identifiés. Cependant, la méthode de la silhouette montre que l’Alaska est un cas atypique dans le groupe 2.

arrests <- USArrests
arrests%>%
  head(4)%>%
  kbl(caption = "<center><strong>Arrestations aux États-Unis</center></strong>")%>%
  kable_classic(full_width = T)

**Arrestations aux États-Unis**
	Murder	Assault	UrbanPop	Rape
Alabama	13.2	236	58	21.2
Alaska	10.0	263	48	44.5
Arizona	8.1	294	80	31.0
Arkansas	8.8	190	50	19.5

arrests <- na.omit(arrests)

arrests <- scale(arrests)

fviz_nbclust(arrests, kmeans, method = "wss")

set.seed(1)

km <- kmeans(arrests, centers = 4, nstart = 25)

fviz_cluster(km, data = arrests)

s<-silhouette(km$cluster, dist(arrests))
row.names(s)<-row.names(arrests)

fviz_silhouette(s, label=TRUE)+labs(x = NULL)

##   cluster size ave.sil.width
## 1       1   13          0.37
## 2       2   13          0.27
## 3       3   16          0.34
## 4       4    8          0.39

7 K-medoids

La méthode de K-means peut être influencée par des valeurs aberrantes. Une alternative souvent utilisée est le clustering k-medoids.

En comparaison avec l’algorithme k-means, k-medoids choisit des points de données réels comme centres (medoids ou exemplars), et permet ainsi une plus grande interprétabilité des centres de clusters que dans k-means.

Les données aberrantes peuvent être identifiées à l’aide de la fonction “Summary”, par un histogramme ou un boxplot.

Par exemple, dans les données sur les arrestations aux États-Unis, on remarque les aberrations suivantes :

arrests%>%
  as.tibble()%>%
  ggplot(aes(y=Rape)) + 
  geom_boxplot(notch=TRUE,outlier.shape=8, outlier.colour="red") +
  theme(plot.title = element_text(face = "bold",
    hjust = 0.5)) +
  labs(title = "Visualisation des outliers")

Visualisons maintenant la différence de résultat sur les mêmes données à l’aide de K-medoid :

En suivant cette méthode et en conservant quatre groupes, on obtient deux états atypiques dans le groupe 3.

fviz_nbclust(arrests, pam, method = "wss")

set.seed(1)

kmed <- pam(arrests, k = 4)

fviz_cluster(kmed, data = arrests)

s2<-silhouette(kmed$clustering, dist(arrests))
row.names(s2)<-row.names(arrests)

fviz_silhouette(s2, label=TRUE)+labs(x = NULL)

##   cluster size ave.sil.width
## 1       1    8          0.39
## 2       2   12          0.31
## 3       3   20          0.28
## 4       4   10          0.46

Nous avons également effectué cette analyse avec les données des pays proposés par P. Rousseeuw :

Les pays ont été regroupés en deux groupes, l’Inde étant atypique dans le group 1.

df_Rousseeuw<-read.csv("Political_science_data - Sheet1.csv")

df_Rousseeuw%>%
  head(4)%>%
  kbl(caption = "<center><strong>Dissimilitudes entre douze pays</center></strong>")%>%
  kable_classic(full_width = T)

**Dissimilitudes entre douze pays**
X	BEL	BRA	CHI	CUB	EGY	FRA	IND	ISR	USA	USS	YUG	ZAI
BEL	0.00	5.58	7.00	7.08	4.83	2.17	6.42	3.42	2.50	6.08	5.25	4.75
BRA	5.58	0.00	6.50	7.00	5.08	5.75	5.00	5.50	4.92	6.67	6.83	3.00
CHI	7.00	6.50	0.00	3.83	8.17	6.67	5.58	6.42	6.25	4.25	4.50	6.08
CUB	7.08	7.00	3.83	0.00	5.83	6.92	6.00	6.42	7.33	2.67	3.75	6.67

row.names(df_Rousseeuw)=df_Rousseeuw$X

df_Rousseeuw<-df_Rousseeuw%>%
  select(-X)%>%
  as.matrix()

PAM_Rousseeuw<-pam(df_Rousseeuw,diss = TRUE,2)

sil_Rousseeuw<-silhouette(PAM_Rousseeuw$clustering, df_Rousseeuw)
row.names(sil_Rousseeuw)=row.names(df_Rousseeuw)

fviz_silhouette(sil_Rousseeuw,label=TRUE, print.summary = TRUE) +
  coord_flip()

##   cluster size ave.sil.width
## 1       1    7          0.30
## 2       2    5          0.26

8 Data visualisation - Eurostats

Dans cette partie du projet, nous avons utilisé les donnes d’Eurostat.

Ce site fournit les données sur les distributions de salaire en Europe, ainsi que d’autres indicateurs économiques et sociaux.

8.1 Les données du projet

Ces sont les quartiles, les quantiles, les déciles, etc., qui sont fournis par le site. Voici une image d’une information fournie sur l’année 2011.

Dans le tableau ci-dessus le chiffre 10,663 correspond au premier quartile dans la zone EU-27. Cela veut dire que 25% des habitants de la zone ont un revenu inférieur ou égale à ce montant.

euro_stat <- get_eurostat(id='ilc_di03')%>%
  filter(age=="TOTAL" & sex=="T" & indic_il=="MEI_E" & unit == 'EUR'& nchar(geo)<3 & geo!="EA" )%>%
  mutate(Year= year(time))%>%
  select(geo, values, Year)

euro_stat$name<-countrycode(euro_stat$geo,"iso2c","country.name")

euro_stat<-euro_stat%>%
  filter(!is.na(name))%>%
  arrange(name,Year)

euro_stat%>%
 spread(geo,values)%>%
 select(-Year)%>%
 as.data.frame()%>%
 stargazer(title = "Descriptive statistics for the mean revenue in Europe",digits = 0,type = "html", dep.var.caption  = "<b>Statistiques</b>")

**Descriptive statistics for the mean revenue in Europe**

Statistic	N	Mean	St. Dev.	Min	Pctl(25)	Pctl(75)	Max

AL	4	2,511	348	2,143	2,290	2,700	2,943
AT	25	21,617	4,675	15,343	16,611	25,958	29,503
BE	25	20,334	3,719	15,015	17,163	23,429	27,641
BG	15	3,702	1,204	1,582	3,277	4,346	5,927
CH	14	42,984	7,186	31,656	36,179	49,111	50,859
CY	16	18,246	1,386	15,068	17,150	19,333	20,218
CZ	16	8,340	1,875	4,838	7,688	8,926	11,885
DE	23	20,631	3,705	15,035	17,225	23,018	27,520
DK	18	28,647	4,135	22,515	25,309	31,985	34,346
EE	17	7,984	3,103	3,245	6,333	10,102	13,705
ES	24	13,487	3,602	7,445	10,392	16,308	18,116
FI	23	21,791	5,040	13,874	17,399	26,185	28,683
FR	24	20,805	4,300	14,469	16,364	24,745	26,210
HR	11	6,709	951	5,799	6,029	7,111	8,643
HU	16	5,256	834	3,915	4,778	5,444	7,278
IE	25	21,315	6,353	9,747	15,487	25,635	30,672
IS	15	28,794	6,982	20,670	23,903	33,002	43,769
IT	24	15,671	3,928	8,352	11,228	18,232	20,449
LT	16	5,990	2,170	2,554	4,802	7,164	10,491
LU	25	33,263	6,785	22,109	26,360	38,442	43,687
LV	16	6,343	2,172	2,569	5,380	7,602	10,413
ME	8	3,973	329	3,584	3,694	4,236	4,449
MK	8	2,526	292	2,153	2,291	2,729	2,972
MT	16	13,586	2,853	9,657	11,637	15,726	19,048
NL	23	20,745	5,035	13,005	15,148	23,558	29,297
NO	18	38,312	6,031	29,053	33,292	42,832	46,968
PL	16	5,931	1,526	3,040	5,072	6,697	8,907
PT	24	9,201	2,048	5,330	7,470	10,440	12,696
RO	14	2,875	869	1,940	2,360	2,981	4,846
RS	8	3,166	529	2,838	2,847	3,196	4,281
SE	17	23,926	3,644	18,393	20,178	27,218	27,935
SI	16	12,755	1,658	9,539	12,417	13,304	15,836
SK	16	6,650	1,679	3,115	6,012	7,507	9,003
TR	15	4,401	585	3,256	4,048	4,714	5,434

Nous récupérons les données sur le revenu médian en Europe pour l’année 2019.

euro_2019 <- euro_stat%>%
  filter(Year==2019)
colnames(euro_2019)[1] <- "id"

mapdata<- get_eurostat_geospatial(nuts_level = 0)%>% right_join(euro_2019, by="id")%>%
  mutate(cat=cut_to_classes(values,n=4,decimals=1))

worldMap<- map_data("world", region = euro_2019$name)%>%
  select(-subregion)%>%
  group_by(region) %>%
  summarise(long = mean(long), lat = mean(lat))%>%
  st_as_sf(coords=c('long','lat'))

8.2 Représentation du revenu moyen en Europe en 2019

Il est possible d’observer que les pays de l’Est ont un niveau de revenu plus faible, alors que la Norvège et la Suisse ont un niveau de revenu plus élevé.

ggplot() + 
  geom_sf(data = mapdata, aes(fill = values, color=values), size=0.1, color="#E8EAF6")+
  geom_sf_text(aes(label =mapdata$name, geometry=mapdata$geometry),colour = "#546E7A", size = 2.5)+
  coord_sf(datum = NA, xlim = c(-12, 44), ylim = c(33, 70), expand = FALSE)+
  scale_fill_viridis(direction = -1, option="G") + 
  labs(title = "Niveau de revenu moyen en Europe en 2019",caption = "Source: Eurostat ; 2019")+
  labs(x = NULL, y = NULL)+labs(colour = "Revenu", fill = "Revenu") +
  theme(plot.title = element_text(face = "bold"),
    panel.background = element_rect(fill = NA))

8.3 Clusterisation des pays

En tenant compte des données sur le revenu moyen, il est possible de faire un cluster composé de 3 groupes de pays :

euro_2019<-euro_stat%>%
  filter(Year==2019)

euro_matrix<-euro_2019%>%
  select(-c(Year,name,geo))%>%
  as.matrix()

rownames(euro_matrix)<-euro_2019$name


k.max <- 20
data <- euro_matrix
wss <- sapply(1:k.max, 
              function(k){kmeans(data, k, nstart=50,iter.max = 15 )$tot.withinss})

plot(1:k.max, wss,
     type="b", pch = 19, frame = FALSE, 
     xlab="Number of clusters K",
     ylab="Total within-clusters sum of squares",
     title="Nombre optimal de clusters")

set.seed(1)

km <- kmeans(euro_matrix, centers = 3, nstart= 50)

euro_2019<- euro_2019%>%
  mutate(cluster = km$cluster)

#On va joindre la table précédente aux données géographiques. 
joined_data <- get_eurostat_geospatial(nuts_level = 0)%>% left_join(euro_2019, by=c('id'='geo'))%>%
  mutate(cat=cut_to_classes(values,n=4,decimals=1))

# On la cartographie

joined_data$cluster <- as.character(joined_data$cluster)

joined_data%>%
  ggplot() + 
  geom_sf(data = joined_data, aes(fill = cluster, color=cluster), size=0.1, color="#E8EAF6")+
  geom_sf_text(aes(label =joined_data$name, geometry=joined_data$geom),colour = "black", size = 2.5)+
  scale_fill_manual(labels = c("Groupe 1 - Revenu élevé", "Group 2 - Revenu faible", "Group 3 - Revenu moyen"),
                    values = c("1" = "#4A148C",
                               "2" ="#FFF59D",
                               "3"="#00ACC1"))+
    scale_color_manual(labels = c("Groupe 1 - Revenu élevé", "Group 2 - Revenu faible", "Group 3 - Revenu moyen"),
                       values = c("1" = "#4A148C",
                                  "2" ="#FFF59D",
                                  "3"="#00ACC1"))+
  coord_sf(datum = NA, xlim = c(-12, 44), ylim = c(33, 70), expand = FALSE)+
  labs(title = "Pays ayant des niveaux de revenus similaires en Europe",caption = "Source: Eurostat ; 2019")+
  labs(x = NULL, y = NULL)+
  labs(colour = "Cluster", fill = "Cluster") +
  theme(plot.title = element_text(face = "bold"),
    panel.background = element_rect(fill = NA))+
  theme(plot.title = element_text(hjust = 0.5))

8.4 Evolution de la richesse en Europe

A travers un gif, il est possible d’observer l’évolution du revenu moyen en Europe entre 2007 et 2020.

colnames(euro_stat)[1] <- "id"

mapdata1<- get_eurostat_geospatial(nuts_level = 0)%>% right_join(euro_stat, by="id")

mapdata1<-mapdata1%>%
  filter(Year > 2006)

mapdata1<- mapdata1%>%
  select(-c(CNTR_CODE,NUTS_NAME,LEVL_CODE,FID, FID,NUTS_ID,geo))

mapdata1$Year <- as.Date.character(as.character(mapdata1$Year), format = "%Y")

label_centroid<- worldMap%>%
  right_join(euro_stat, by=c("region"="name"))%>%
  filter(Year > 2006)

labels_all<- mapdata1%>%
  st_centroid()

mapdata1$values[is.na(mapdata1$values)]<-0

anim= tmap_mode("plot")+
  tm_shape(mapdata1, bbox=tmaptools::bb(xlim = c(-12, 44), ylim = c(33, 70)))+
  tm_polygons("values", id="name", palette="-viridis",style="jenks",
              title = "Revenu", colorNULL='grey')+
  tm_facets(along="Year", free.coords= F)+
  tm_shape(label_centroid)+
  tm_text("region", size= 0.5,root = 5, remove.overlap = TRUE)+
  tm_facets(along="Year", free.coords= F)+
  tm_layout(legend.outside = T, legend.outside.position = 'right')

tmap_animation(tm=anim, filename="anim.gif", delay=100)

Revenu net équivalent moyen en Europe entre 2007 et 2020

Source : Eurostat

8.5 Indice de GINI

Le revenu moyen n’est pas un indicateur capable de mesurer les inégalités dans un pays ; un pays comptant un petit nombre de personnes très riches et un très grand nombre de personnes pauvres peut avoir un revenu moyen élevé, qui ne correspond pas à la réalité de la majorité de la population. Pour analyser les inégalités, nous utiliserons donc l’indice de Gini.

Si on dispose de données bruites \(x_1,x_2,\cdots,x_n\),où \(n\) est le nombre d’individus, l’indice de Gini est donné par:

\[ G=\frac{sum_{i=1}^n\sum_{j=1}^n|x_i-x_j|/n^2}{2\sum_{i=1}^nx_i/n} \]

Si on double le salaire de tous les individus le Gini reste invariant.
Si on rajoute 100 euros a tous le monde le numérateur augmente.

Graphiquement, l’indice de Gini est représenté par la courbe de Lorenz, comme dans l’image suivante. Il montre l’accumulation des revenus par rapport à la population générale d’une localité.

Désavantages de l’indice

Représente l’inégalité de manière statique, et ne permet donc pas de montrer les tendances.
Une bonne répartition des revenus dans un pays ne correspond pas nécessairement à la justice sociale car cet indice ne tient pas compte du pouvoir d’achat que peut présenter un revenu X dans différentes parties d’un même territoire.
Les données sont fournies volontairement par les gouvernements et les organismes de recherche. Par conséquent, en fonction des différents intérêts, l’information peut présenter des distorsions.

Eurostat fournit des données sur le coefficient de Gini en Europe, sur une échelle de 0 à 100, les pays proches de 0 étant moins inégaux, tandis que ceux proches de 100 sont plus inégaux.

#Gini coefficient of equivalised disposable income

search_eurostat(pattern = "Gini coefficient of equivalised disposable income - EU-SILC survey")%>%
  select(-c(title,values))%>%
  kbl(caption = "<center><strong>Gini coefficient of equivalised disposable income - EU-SILC survey</center></strong>")%>%
  kable_classic(full_width = F)

**Gini coefficient of equivalised disposable income - EU-SILC survey**
code	type	last update of data	last table structure change	data start	data end
ilc_di12	dataset	11.04.2022	19.05.2021	1995	2020

euro_stat_gini <- get_eurostat(id="ilc_di12")%>%
  filter(geo!="EA")%>%
  mutate(Year= year(time))%>%
  select(geo, values, Year, time)

euro_stat_gini%>%
  head(3)%>%
   kbl(caption = "<center><strong>Gini coefficient of equivalised disposable income</center></strong>")%>%
  kable_classic(full_width = F)

**Gini coefficient of equivalised disposable income**
geo	values	Year	time
AL	33.2	2020	2020-01-01
AT	27.0	2020	2020-01-01
BE	25.4	2020	2020-01-01

colnames(euro_stat_gini)[1] <- "id"

euro_stat_gini$name<-countrycode(euro_stat_gini$id,"iso2c","country.name")

euro_stat_gini<- euro_stat_gini%>%
  drop_na()%>%
  arrange(name,Year)

euro_stat_gini%>%
 spread(id,values)%>%
 select(-c(Year, time))%>%
 as.data.frame()%>%
 stargazer(title = "Descriptive statistics for the gini coefficient of equivalised disposable income in Europe",digits = 0,type = "html")

**Descriptive statistics for the gini coefficient of equivalised disposable income in Europe**

Statistic	N	Mean	St. Dev.	Min	Pctl(25)	Pctl(75)	Max

AL	4	35	2	33	34	36	37
AT	25	27	1	24	26	28	28
BE	25	27	1	25	26	28	30
BG	18	34	5	25	33	38	41
CH	14	30	1	28	30	31	31
CY	17	30	2	29	29	31	35
CZ	17	25	1	24	25	25	26
DE	23	28	2	25	26	30	34
DK	22	25	3	20	24	27	28
EE	20	33	2	30	31	35	37
ES	25	33	1	31	32	34	35
FI	24	25	1	22	25	26	27
FR	25	29	1	27	28	29	31
HR	11	30	1	28	30	31	32
HU	19	27	2	24	25	28	33
IE	25	31	2	28	30	32	34
IS	15	25	2	23	24	26	30
IT	24	32	1	29	32	33	33
LT	18	35	2	31	34	37	38
LU	25	28	2	25	27	29	32
LV	17	36	1	34	35	36	39
ME	8	36	2	33	35	37	38
MK	8	34	3	31	32	36	39
MT	17	28	1	26	27	29	30
NL	24	27	1	25	26	27	29
NO	18	25	2	22	24	25	29
PL	18	31	2	27	30	31	36
PT	24	35	2	31	34	37	38
RO	17	34	2	29	34	35	38
RS	8	37	3	33	35	39	40
SE	21	25	2	21	23	27	28
SI	19	24	1	22	23	24	25
SK	16	24	2	21	24	26	28
TR	16	43	1	41	42	43	46

Dans la représentation suivante, le niveau d’inégalité des pays peut être visualisé ; dans les pays à faible revenu, comme la Turquie et la Bulgarie, les inégalités sont également plus élevées. Toutefois, certains pays à faible revenu, comme la République tchèque et la Slovaquie, sont assez égalitaires.

Nous concluons alors qu’un coefficient de Gini faible n’implique pas nécessairement que la richesse est plus élevée.

euro_gini_2019 <- euro_stat_gini%>%
  filter(Year==2019)%>%
  select(-c(Year,time))

mapdata2<- get_eurostat_geospatial(nuts_level = 0)%>% right_join(euro_gini_2019, by="id")%>%
  mutate(cat=cut_to_classes(values,n=4,decimals=1))

ggplot() + 
  geom_sf(data = mapdata2, aes(fill = values, color=values), size=0.1, color="#E8EAF6")+
  geom_sf_text(aes(label =mapdata2$name, geometry=mapdata2$geom),colour = "#546E7A", size = 2.5)+
  coord_sf(datum = NA, xlim = c(-12, 44), ylim = c(33, 70), expand = FALSE)+
  scale_fill_viridis(direction = -1, option="G") + 
  labs(title = "Coefficient de Gini en Europe",caption = "Source: Eurostat ; 2019")+
  labs(x = NULL, y = NULL)+labs(colour = "Gini", fill = "Gini") +
  theme(plot.title = element_text(face = "bold"),
    panel.background = element_rect(fill = NA))

8.6 Evolution des inégalités en Europe

A travers un gif, il est possible d’observer l’évolution du revenu moyen en Europe entre 2007 et 2020.

mapdata3<- get_eurostat_geospatial(nuts_level = 0)%>% right_join(euro_stat_gini, by="id")%>%
  mutate(cat=cut_to_classes(values,n=4,decimals=1))

mapdata3<-mapdata3%>%
  filter(Year > 2006)%>%
  st_transform(4326)

mapdata3<- mapdata3%>%
  select(-c(CNTR_CODE,NUTS_NAME,LEVL_CODE,FID, FID,NUTS_ID,geo, cat))

label_centroid<- worldMap%>%
  right_join(euro_stat_gini, by=c("region"="name"))%>%
  filter(Year > 2006)

anim= tmap_mode("plot")+
  tm_shape(mapdata3, bbox=tmaptools::bb(xlim = c(-12, 40), ylim = c(33, 70)))+
  tm_polygons("values", id="name", palette="-viridis", style="jenks",
              title = "Gini")+
  tm_facets(along="time", free.coords= F)+
  tm_shape(label_centroid)+
  tm_text("region", size= 0.5,root = 5, remove.overlap = TRUE)+
  tm_layout(legend.outside = T, legend.outside.position = 'right')

tmap_animation(tm=anim, filename="anim1.gif", delay=100)

Ci-dessous, une carte représentant l’indice de Gini et le revenu moyen en Europe en 2019.

colnames(mapdata)[8] <- "income"
colnames(mapdata3)[2] <- "gini"

gini_revenu<- mapdata%>%
  st_join(mapdata3, st_within)

gini_revenu<-st_crop(gini_revenu, xmin = -20, xmax = 45,ymin = 30, ymax = 73)%>%
  st_transform(4326)

ggplot(gini_revenu) +
  geom_sf(aes(fill=income)) +
  coord_sf(crs = 4326, datum = NA) +
  geom_point(
    aes(size = gini, geometry = geometry),color="#FFA726",
    stat = "sf_coordinates")+
  coord_sf(datum = NA)+
  scale_fill_viridis(direction = -1, option="G", name = "Revenu") +
  scale_color_viridis(direction = -1, option="G", name = "Revenu") +
  labs(x = NULL, y = NULL, fill = "Gini", size = "Gini",
    alpha = 0.5, caption = "Source: Eurostat 2019") +
  theme(plot.title = element_text(face = "bold"),
    panel.background = element_rect(fill = NA)) +
  theme(plot.caption = element_text(size = 8,
    face = "italic")) +
  labs(title = "Richesse et inégalités en Europe",subtitle= "Calculé sur l'indice de gini et le revenu moyen") +
  theme(legend.text = element_text(size = 8),
    legend.title = element_text(size = 8))

Regroupement par revenu moyen et indice de Gini :

euro_revenu_2019 <- euro_2019%>%
  select(-c(Year,name, cluster))

colnames(euro_revenu_2019)[2] <- "revenu"
colnames(euro_gini_2019)[2] <- "gini" 

gini_revenu_2019 <- euro_gini_2019%>%
  inner_join(euro_revenu_2019, by=c("id"="geo"))

gini_revenu_2019_matrix <- gini_revenu_2019%>%
  select(c(revenu,gini))%>%
  as.matrix()

rownames(gini_revenu_2019_matrix) <- gini_revenu_2019$name

gini_revenu_2019_matrix <- na.omit(gini_revenu_2019_matrix)

gini_revenu_2019_matrix <- scale(gini_revenu_2019_matrix)

fviz_nbclust(gini_revenu_2019_matrix, kmeans, method = "wss")

set.seed(1)

km <- kmeans(gini_revenu_2019_matrix, centers = 3, nstart = 25)

fviz_cluster(km, data = gini_revenu_2019_matrix)

gini_revenu_2019<- gini_revenu_2019%>%
  mutate(cluster = km$cluster)

mapdata4<- get_eurostat_geospatial(nuts_level = 0)%>%
  right_join(gini_revenu_2019, by="id")

mapdata4$cluster <- as.character(mapdata4$cluster)

ggplot(mapdata4) + 
  geom_sf(data = mapdata4, aes(fill = cluster, color=cluster), size=0.1, color="#E8EAF6")+
  geom_sf_text(aes(label =mapdata4$name, geometry=mapdata4$geom),colour = "black", size = 2.5)+
  scale_fill_manual(labels = c("Groupe 1", "Groupe 2", "Groupe 3"),
                    values = c("1" = "#4A148C",
                               "2" ="#FFF59D",
                               "3"="#00ACC1"))+
    scale_color_manual(labels = c("Groupe 1", "Groupe 3", "Groupe 3"),
                       values = c("1" = "#4A148C",
                                  "2" ="#FFF59D",
                                  "3"="#00ACC1"))+
  coord_sf(datum = NA, xlim = c(-12, 44), ylim = c(33, 70), expand = FALSE)+
  labs(title = "Pays ayant des niveaux de revenus et d'inigalités similaires en Europe",caption = "Source: Eurostat ; 2019")+
  labs(x = NULL, y = NULL)+
  labs(colour = "Cluster", fill = "Cluster") +
  theme(plot.title = element_text(face = "bold"),
    panel.background = element_rect(fill = NA)) + theme(plot.title = element_text(hjust = 0.25))

8.7 Autres indicateurs

Le taux de chômage est également un indicateur important de l’égalité et de la richesse d’un pays. À partir des taux de chômage d’Eurostat, exprimés en pourcentage, il est possible d’observer qu’un niveau de revenu plus élevé ne diminue pas nécessairement le chômage ; les pays à revenu moyen comme la France et l’Italie ont eu, certaines années, un taux supérieur ou égal à celui des pays à faible revenu.
Entre 2009 et 2015, il est possible de visualiser les vestiges de la crise économique de 2008, avec des niveaux de chômage en hausse dans la plupart des pays. En 2016, ces niveaux ont commencé à reculer.

chomage <- get_eurostat(id="lfst_r_lfu3rt")%>%
  filter(age=="Y15-74" & isced11 == "TOTAL" & sex=="T" & nchar(geo)<3 & geo!="EA" )%>%
  select(c(geo, values, time))%>%
  mutate(Year= year(time))%>%
  arrange(geo)

colnames(chomage)[2] <- "Chômage"
colnames(mapdata1)[2] <- "Revenu"

chomage<-chomage%>%
  filter(Year>2006)

chomage$name<-countrycode(chomage$geo,"iso2c","country.name")

label_centroid<- worldMap%>%
  right_join(chomage, by=c("region"="name"))

anim= tmap_mode("plot")+
  tm_shape(mapdata1, bbox=tmaptools::bb(xlim = c(-12, 40), ylim = c(33, 70)))+
  tm_polygons("Revenu", palette="Blues", id="name")+
tm_shape(label_centroid)+
  tm_bubbles(size="Chômage", col="red")+
  tm_facets(along="Year", free.coords= F)+
  tm_layout(legend.outside = T, legend.outside.position = 'right')

tmap_animation(tm=anim, filename="anim2.gif", delay=100)

Evolution du chômage en Europe Source : Eurostat

Fouille de données - Clusterisation et visualisation de données

Hully CRETENET et Narimene LOUATI

29/04/2022

1 Introduction

2 Méthodes de mesure de distance

2.1 Distance Euclidienne

2.2 Distance de Manhattan

2.3 Distance de Canberra

2.4 Minkowski distance

3 Normalisation

4 Mesures de similarité pour les données binaires

4.1 Représentation de la matrice des similarités

5 La dissimilarité de Gower

6 K-means

6.1 Jeu de données plats et leurs valeurs nutritionnelles

6.2 Dataset USArrests

7 K-medoids

8 Data visualisation - Eurostats

8.1 Les données du projet

8.2 Représentation du revenu moyen en Europe en 2019

8.3 Clusterisation des pays

8.4 Evolution de la richesse en Europe

8.5 Indice de GINI

8.6 Evolution des inégalités en Europe

8.7 Autres indicateurs