ALGORITMOS DE AGRUPAMENTO EM DADOS SÓCIO-ECONÔMICOS DOS PAÍSES
Introdução
Problema
Agrupar países de acordo com indicadores sócio-econômicos.
Serão aplicados três algoritmos de clusterização a fim de verificar o que tem melhor desempenho: K-Means, agrupamento hierárquico e DBScan.
Pacotes
library(factoextra)
library(fpc)
library(dbscan)
library(cluster)
library(factoextra)
library(DT)
library(ggplot2)
library(dplyr)
library(tidyr)
library(ggcorrplot)Dataset
Conjunto de dados com indicadores de 167 países.
data<-read.csv('dataset/dados.csv', row.names = 1)
DT::datatable(data, options = list(scrollX = TRUE, scrollCollapse = TRUE))Inspeção e tratamento
O dataset já está pré-processado, mas ainda deve ser feito o escalonamento das variáveis, pois os algoritmos aplicados são baseados em distâncias.
Tipo de variáveis
Variáveis todas numéricas, como se espera em um problema de agrupamento.
str(data)'data.frame': 167 obs. of 9 variables:
$ child_mort: num 90.2 16.6 27.3 119 10.3 14.5 18.1 4.8 4.3 39.2 ...
$ exports : num 10 28 38.4 62.3 45.5 18.9 20.8 19.8 51.3 54.3 ...
$ health : num 7.58 6.55 4.17 2.85 6.03 8.1 4.4 8.73 11 5.88 ...
$ imports : num 44.9 48.6 31.4 42.9 58.9 16 45.3 20.9 47.8 20.7 ...
$ income : int 1610 9930 12900 5900 19100 18700 6700 41400 43200 16000 ...
$ inflation : num 9.44 4.49 16.1 22.4 1.44 20.9 7.77 1.16 0.873 13.8 ...
$ life_expec: num 56.2 76.3 76.5 60.1 76.8 75.8 73.3 82 80.5 69.1 ...
$ total_fer : num 5.82 1.65 2.89 6.16 2.13 2.37 1.69 1.93 1.44 1.92 ...
$ gdpp : int 553 4090 4460 3530 12200 10300 3220 51900 46900 5840 ...Escalonamento
Escalonamento por padronização com média 0 e desvio padrão 1, guardando média e desvio padrão para poder reverter os valores posteriormente.
mean_data<-sapply(data, mean)
sd_data<-sapply(data, sd)
data<-as.data.frame(scale(data))
head(data) child_mort exports health imports income
Afghanistan 1.2876597 -1.13486665 0.27825140 -0.08220771 -0.80582187
Albania -0.5373329 -0.47822017 -0.09672528 0.07062429 -0.37424335
Algeria -0.2720146 -0.09882442 -0.96317624 -0.63983800 -0.22018227
Angola 2.0017872 0.77305618 -1.44372888 -0.16481961 -0.58328920
Antigua and Barbuda -0.6935483 0.16018613 -0.28603389 0.49607554 0.10142673
Argentina -0.5894047 -0.81019144 0.46756001 -1.27594958 0.08067776
inflation life_expec total_fer gdpp
Afghanistan 0.1568645 -1.6142372 1.89717646 -0.67714308
Albania -0.3114109 0.6459238 -0.85739418 -0.48416709
Algeria 0.7869076 0.6684130 -0.03828924 -0.46398018
Angola 1.3828944 -1.1756985 2.12176975 -0.51472026
Antigua and Barbuda -0.5999442 0.7021467 -0.54032130 -0.04169175
Argentina 1.2409928 0.5897009 -0.38178486 -0.14535428Análise exploratória dos dados
Estatística descritiva
summary(data) child_mort exports health imports
Min. :-0.8845 Min. :-1.4957 Min. :-1.8223 Min. :-1.9341
1st Qu.:-0.7444 1st Qu.:-0.6314 1st Qu.:-0.6901 1st Qu.:-0.6894
Median :-0.4704 Median :-0.2229 Median :-0.1805 Median :-0.1483
Mean : 0.0000 Mean : 0.0000 Mean : 0.0000 Mean : 0.0000
3rd Qu.: 0.5909 3rd Qu.: 0.3736 3rd Qu.: 0.6496 3rd Qu.: 0.4899
Max. : 4.2086 Max. : 5.7964 Max. : 4.0353 Max. : 5.2504
income inflation life_expec total_fer
Min. :-0.8577 Min. :-1.1344 Min. :-4.3242 Min. :-1.1877
1st Qu.:-0.7153 1st Qu.:-0.5649 1st Qu.:-0.5910 1st Qu.:-0.7616
Median :-0.3727 Median :-0.2263 Median : 0.2861 Median :-0.3554
Mean : 0.0000 Mean : 0.0000 Mean : 0.0000 Mean : 0.0000
3rd Qu.: 0.2934 3rd Qu.: 0.2808 3rd Qu.: 0.7021 3rd Qu.: 0.6157
Max. : 5.5947 Max. : 9.1023 Max. : 1.3768 Max. : 3.0003
gdpp
Min. :-0.69471
1st Qu.:-0.63475
Median :-0.45307
Mean : 0.00000
3rd Qu.: 0.05924
Max. : 5.02140 Distribuição das variáveis
data_gather <- data %>%
as_data_frame() %>%
gather(key = "variable", value = "value")
ggplot(data_gather, aes(value)) +
geom_density() +
facet_wrap(~variable)
Correlações
tabcor<-cor(data)
ggcorrplot(tabcor, lab=TRUE, type = "lower")
Algoritmos
K-Means
Elbow method
Uso do “método do cotovelo” com a soma dos quadrados intracluster. O resultado da visualização é um tanto ambíguo, mas k=4 parece uma escolha razoável.
fviz_nbclust(data, FUNcluster = kmeans, method = "wss")
Implementação
kmeans_clusters <- eclust(data, FUNcluster = 'kmeans' , k = 4, graph = FALSE)# Resultado
kmeans_clusters$centers child_mort exports health imports income inflation
1 -0.8261247 0.172103053 0.856613486 -0.29548409 1.4578905 -0.47675466
2 -0.4185681 0.006628559 -0.211088772 0.04743879 -0.2166227 -0.03484844
3 1.3561391 -0.436221182 -0.155516293 -0.18863644 -0.6848344 0.40090504
4 -0.8464575 4.920873128 -0.008138555 4.53442030 2.4322274 -0.50269428
life_expec total_fer gdpp
1 1.1043279 -0.7613916 1.6569189
2 0.2676147 -0.4369082 -0.3298134
3 -1.2783352 1.3608511 -0.6024306
4 1.2231457 -1.0357477 2.4334786#Cada país agrupado num cluster com rótulo 1, 2, 3 ou 4.
head(kmeans_clusters$cluster,8) Afghanistan Albania Algeria Angola
3 2 2 3
Antigua and Barbuda Argentina Armenia Australia
2 2 2 1 #Tamanho de cada cluster.
kmeans_clusters$size[1] 30 87 47 3Visualização
Gráfico, usando PCA, para visualizar os grupos em duas dimensões. Por falta de espaço, nem todos os países são exibidos.
fviz_cluster(kmeans_clusters, geom='text', xlab='', ylab='', main='K-Means',
labelsize=10, repel=TRUE)
Avaliação
Método da silhueta para avaliar a qualidade do agrupamento. Como os resultados mostram, o k-means teve bom desempenho. No entanto, a Coréia do Sul e alguns países que estão na vizinhança entre os grupos 2 e 3, como Botswana, conforme já sugeria a visualização acima, podem ter sido classificados errado.
kmeans_silhouette<-kmeans_clusters$silinfo
head(kmeans_silhouette$widths[order(kmeans_silhouette$widths$sil_width),],10) cluster neighbor sil_width
Botswana 3 2 -0.079653471
Iraq 3 2 -0.068529312
South Korea 1 2 -0.048579689
Namibia 3 2 -0.022262588
South Africa 3 2 -0.011982782
Lao 3 2 0.002380055
Gabon 3 2 0.035521674
Kiribati 3 2 0.041619782
Cyprus 1 2 0.045731665
Bahamas 2 1 0.059603555fviz_silhouette(kmeans_clusters) cluster size ave.sil.width
1 1 30 0.30
2 2 87 0.33
3 3 47 0.25
4 4 3 0.39
Agrupamento hierárquico
Implementação
Usando os principais métodos aglomerativos.
Ward1
#Implementação
hc_ward1 <- eclust(data, FUNcluster = 'hclust', hc_method='ward.D')
#Dendograma
fviz_dend(hc_ward1, main="Ward1", cex = 0.6)
Análise por silhueta
Como se oberva, os resultados são inferiores ao k-means, com mais erros de classificação e, em média, valores menores de silhueta.
fviz_silhouette(hc_ward1) cluster size ave.sil.width
1 1 65 0.15
2 2 68 0.38
3 3 34 0.08
Ward2
#Implementação
hc_ward2 <- eclust(data, FUNcluster = 'hclust', hc_method='ward.D2')
#Dendograma
fviz_dend(hc_ward2, main="Ward2", cex = 0.6)
Análise por silhueta
Ward2 se saiu melhor que Ward1, mas ainda inferior aos resultados do k-means.
fviz_silhouette(hc_ward2) cluster size ave.sil.width
1 1 27 0.45
2 2 106 0.21
3 3 34 0.19
Single linkage
O single linkage não conseguiu discriminar bem os grupos, deixando praticamente todos os países num cluster só.
#Implementação
hc_sl <- eclust(data, FUNcluster = 'hclust', hc_method='single')
#Dendograma
fviz_dend(hc_sl, main="Single linkage", cex = 0.6)
Análise por silhueta
fviz_silhouette(hc_sl) cluster size ave.sil.width
1 1 165 0.58
2 2 1 0.00
3 3 1 0.00
Complete linkage
#Implementação
hc_cl <- eclust(data, FUNcluster = 'hclust', hc_method='complete')
#Dendograma
fviz_dend(hc_cl, main="Complete linkage", cex = 0.6)
Análise por silhueta
Foi o melhor dos 4 métodos aglomerativos, ainda assim inferior ao k-means.
fviz_silhouette(hc_cl) cluster size ave.sil.width
1 1 55 0.27
2 2 109 0.30
3 3 3 0.43
DBScan
Será utilizado um número mínimo de 3 pontos na região do epsilon para que a observação seja colocada no grupo. Para a definição do epsilon, o pacote dbscan oferece o gráfico kNNdistplot, um gráfico de distâncias para o kNN que pode ser utilizado para definir o melhor epsilon do dbscan observando onde fica o “joelho” da curva. 2 parece um bom epsilon.
minpts<-3
kNNdistplot(data, k = minpts)
abline(h = 2)
#Implementação
dbscan_cluster<-fpc::dbscan(data, eps=2, MinPts =minpts)#Grupos
table(dbscan_cluster$cluster)
0 1
6 161 Vê-se que, a exemplo do método single linkage, no agrupamento hierárquico, as observações ficaram num só grupo (0 é não classificado). Considerando que os dados foram padronizados com média 0 e desvio padrão 1, epsilon=2 pode ser grande demais para que o algoritmo consiga discriminar mais grupos. Reduzindo o valor de epsilon para 1, o algoritmo forma mais clusters, mas não consegue classificar 72 observações, o que é muito para um conjunto de 163 países.
dbscan_cluster<-fpc::dbscan(data, eps=1, MinPts =minpts)
table(dbscan_cluster$cluster)
0 1 2 3 4 5 6
72 8 59 16 4 5 3 Conclusão
Conforme os resultados acima, o algoritmo de melhor desempenho em separar os países por clusters é o k-means com 4 grupos. Os demais algortimos ou não se saíram tão bem em colocar cada país no grupo correto, ou foram incapazes de formar mais do que um cluster e rotular todas as observações.