Country Clustering using Unsupervised Learning
Muhammad Ammar
5/20/2021
Halo!!
Pada LBB kali ini saya akan menggunakan dataset dari HELP International, sebuah NGO yang berkomitmen untuk melawan kemiskinan dan menyediakan fasilitas dasar dan bantuan kepada orang-orang di negara-negara terbelakang selama masa bencana. Dataset ini saya dapatkan dari https://www.kaggle.com/rohan0301/unsupervised-learning-on-country-data?select=Country-data.csv
LBB ini bertujuan mencari clustering dari negara-negara yang menjadi urutan prioritas bagi HELP International dalam mengalirkan dana kepada target kegiatan NGO tersebut dengan menggunakan metode Unsupervised Learning. Let’s get started.
Preparation
library(tidyverse)
library(lubridate)
library(cluster)
library(factoextra)
library(GGally)
library(scales)
library(cowplot)
library(FactoMineR)
library(factoextra)
library(plotly)
library(gridExtra)
options(scipen = 999)country <- read.csv("Country-data.csv")
head(country)read.csv("data-dictionary.csv")EDA & Data Preprocessing
colSums(is.na(country))## country child_mort exports health imports income inflation
## 0 0 0 0 0 0 0
## life_expec total_fer gdpp
## 0 0 0str(country)## 'data.frame': 167 obs. of 10 variables:
## $ country : chr "Afghanistan" "Albania" "Algeria" "Angola" ...
## $ 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 ...- country : Name of the country
- child_mort : Death of children under 5 years of age per 1000 live births
- exports : Exports of goods and services per capita. Given as %age of the GDP per capita
- health : Total health spending per capita. Given as %age of GDP per capita
- imports : Imports of goods and services per capita. Given as %age of the GDP per capita
- income : Net income per person
- inflation : The measurement of the annual growth rate of the Total GDP
- life_expec : The average number of years a new born child would live if the current mortality patterns are to remain the same
- total_fer : The number of children that would be born to each woman if the current age-fertility rates remain the same.
- gdpp : The GDP per capita. Calculated as the Total GDP divided by the total population.
summary(country)## country child_mort exports health
## Length:167 Min. : 2.60 Min. : 0.109 Min. : 1.810
## Class :character 1st Qu.: 8.25 1st Qu.: 23.800 1st Qu.: 4.920
## Mode :character Median : 19.30 Median : 35.000 Median : 6.320
## Mean : 38.27 Mean : 41.109 Mean : 6.816
## 3rd Qu.: 62.10 3rd Qu.: 51.350 3rd Qu.: 8.600
## Max. :208.00 Max. :200.000 Max. :17.900
## imports income inflation life_expec
## Min. : 0.0659 Min. : 609 Min. : -4.210 Min. :32.10
## 1st Qu.: 30.2000 1st Qu.: 3355 1st Qu.: 1.810 1st Qu.:65.30
## Median : 43.3000 Median : 9960 Median : 5.390 Median :73.10
## Mean : 46.8902 Mean : 17145 Mean : 7.782 Mean :70.56
## 3rd Qu.: 58.7500 3rd Qu.: 22800 3rd Qu.: 10.750 3rd Qu.:76.80
## Max. :174.0000 Max. :125000 Max. :104.000 Max. :82.80
## total_fer gdpp
## Min. :1.150 Min. : 231
## 1st Qu.:1.795 1st Qu.: 1330
## Median :2.410 Median : 4660
## Mean :2.948 Mean : 12964
## 3rd Qu.:3.880 3rd Qu.: 14050
## Max. :7.490 Max. :105000dim(country)## [1] 167 10cov(country[2:10])## child_mort exports health imports income
## child_mort 1626.42271 -351.651128 -22.1999431 -124.201982 -407635.982
## exports -351.65113 751.418298 -8.6145337 489.350622 273094.598
## health -22.19994 -8.614534 7.5451162 6.365141 6861.669
## imports -124.20198 489.350622 6.3651406 586.104198 57128.722
## income -407635.98227 273094.598023 6861.6690711 57128.721588 371643894.155
## inflation 122.89363 -31.090078 -7.4150930 -63.208898 -30110.122
## life_expec -318.00826 77.110598 5.1468078 11.710284 104916.786
## total_fer 51.80116 -13.279671 -0.8178281 -5.829066 -14645.728
## gdpp -357046.30615 210378.470377 17417.9712174 51250.050217 316443012.157
## inflation life_expec total_fer gdpp
## child_mort 122.893627 -318.008262 51.8011616 -357046.31
## exports -31.090078 77.110598 -13.2796711 210378.47
## health -7.415093 5.146808 -0.8178281 17417.97
## imports -63.208898 11.710284 -5.8290657 51250.05
## income -30110.122438 104916.785517 -14645.7279269 316443012.16
## inflation 111.739781 -22.533965 5.0715086 -42940.42
## life_expec -22.533965 79.088507 -10.2435847 97814.72
## total_fer 5.071509 -10.243585 2.2917344 -12622.33
## gdpp -42940.421636 97814.722603 -12622.3336570 335941419.96country %>%
gather(Attributes, values, c(2:4, 7:8)) %>%
ggplot(aes(x=reorder(Attributes, values, FUN=median), y=values, fill=Attributes)) +
geom_boxplot(show.legend=FALSE) +
labs(title="Country Data - Boxplots") +
theme_bw() +
theme(axis.title.y=element_blank(),
axis.title.x=element_blank()) +
ylim(0, 210) +
coord_flip()
country %>%
gather(Attributes, value, 2:10) %>%
ggplot(aes(x=value, fill=Attributes)) +
geom_histogram(colour="white", show.legend=FALSE) +
facet_wrap(~Attributes, scales="free_x") +
labs(x="Values", y="Frequency",
title="Country Data - Histograms") +
theme_bw()## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
# Melihat korelasi
ggcorr(country)## Warning in ggcorr(country): data in column(s) 'country' are not numeric and were
## ignored
Insight:
- Tidak terdapat missing values dari dataset yang berarti sangat bagus untuk masalah konsistensi dalam analisis nantinya
- Terdapat outlier pada sebagian besar variabel. Saya memutuskan untuk mempertahankan outlier tersebut karena kemungkinan besar outlier tadi merepresentasikan kondisi negaranya yang sangat buruk dan pantas untuk mendapat bantuan finansial.
- Dari histogram dapat kita katakan bahwa sebagian besar variabelnya tidak memiliki distribusi yang normal.
- Terdapat 3 variabel yang sangat kuat (life_expec, income and total_fer) dan mungkin dapat kita gunakan PCA untuk mereduksi kuantitas variabel.
Data Preprocessing : Scaling
num_country <- country %>%
select_if(is.numeric) %>%
scale()Modelling
Mencari k-optimal
Silhouette Method
fviz_nbclust(num_country, FUN = hcut, method = "silhouette")
Elbow Method
fviz_nbclust(num_country, kmeans, method = "wss") + labs(subtitle = "Elbow method")
Gap Statistic Method
fviz_nbclust(num_country, kmeans, "gap_stat") + labs(subtitle = "Gap Statistic method")
Dari perbandingan ketiga metode di atas terdapat 3 pilihan nilai k-optimum: 2, 6, dan 3. Untuk clustering negara dengan k = 2 terlalu sedikit dan masih bias, begitu juga dengan k = 6 yang terlalu banyak. Oleh sebab itu k = 3 menjadi pilihan terbaik dan paling rasional dinilai dari tujuan case ini yaitu clustering negara mana yang paling membutuhkan bantuan.
K-Means Clustering
# k-means clustering
set.seed(123)
model_country<- kmeans(num_country, 3)
# result analysis
model_country## K-means clustering with 3 clusters of sizes 36, 84, 47
##
## Cluster means:
## child_mort exports health imports income inflation
## 1 -0.8249676 0.64314557 0.7252301 0.19006732 1.4797922 -0.48346661
## 2 -0.4052346 -0.03155768 -0.2237978 0.02408916 -0.2510155 -0.01711594
## 3 1.3561391 -0.43622118 -0.1555163 -0.18863644 -0.6848344 0.40090504
## life_expec total_fer gdpp
## 1 1.0763414 -0.7895024 1.6111498
## 2 0.2539698 -0.4230704 -0.3534185
## 3 -1.2783352 1.3608511 -0.6024306
##
## Clustering vector:
## [1] 3 2 2 3 2 2 2 1 1 2 2 1 2 2 2 1 2 3 2 2 2 3 2 1 2 3 3 2 3 1 2 3 3 2 2 2 3
## [38] 3 3 2 3 2 1 1 1 2 2 2 2 3 3 2 2 1 1 3 3 2 1 3 1 2 2 3 3 2 3 2 1 2 2 2 3 1
## [75] 1 1 2 1 2 2 3 3 1 2 3 2 2 3 3 2 2 1 2 3 3 2 2 3 1 3 2 2 2 2 2 2 3 2 3 2 1
## [112] 1 3 3 1 2 3 2 2 2 2 2 1 1 2 2 3 2 2 3 2 2 3 1 1 1 2 3 1 1 2 2 3 2 1 1 2 3
## [149] 2 3 3 2 2 2 2 3 2 1 1 1 2 2 2 2 2 3 3
##
## Within cluster sum of squares by cluster:
## [1] 297.2279 259.5575 269.6604
## (between_SS / total_SS = 44.7 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"# additional information
model_country$tot.withinss # total within sum of squares## [1] 826.4458model_country$betweenss # between sum of squares## [1] 667.5542model_country$totss # total sum of squares## [1] 1494model_country$iter # number of iteration needed to obtain optimum clustering## [1] 2Selanjutnya mari masukkan data cluster ke data awal dan coba lakukan cluster profiling.
# melakukan profiling dengan summarise data
country_profile <- country %>%
mutate(cluster = as.factor(model_country$cluster)) %>%
group_by(cluster) %>%
summarise_all(.funs = "mean")## Warning in mean.default(country): argument is not numeric or logical: returning
## NA
## Warning in mean.default(country): argument is not numeric or logical: returning
## NA
## Warning in mean.default(country): argument is not numeric or logical: returning
## NAcountry_profileProfiling:
- Cluster 1 berisi negara-negara dengan life expectancy tinggi, child mortality rendah, dan GDPP besar
- Cluter 2 berisi negara-negara dengan life expectancy tinggi, namun memiliki rata-rata health paling rendah dibanding cluster lain
- Cluster 3 berisi negara-negara dengan life expectancy rendah, child mortality tinggi, GDPP sangat kecil, dan inflasi tertinggi.
Sehingga dapat disimpulkan urutan prioritas negara yang membutuhkan bantuan yaitu Cluster 3, 2, 1.
Untuk lebih jelasnya, dapat kita visualisasikan hasil clustering di atas.
fviz_cluster(object = model_country,
data = country %>% select(-country))
PCA
Berdasar hasil EDA kita di atas, terdapat 3 variabel yang sangat kuat (life_expec, income and total_fer) dan mungkin dapat kita gunakan PCA untuk mereduksi kuantitas variabel.
Kelebihan melakukan PCA sebelum modeling:
+ Kita mengurangi kolom yang otomatis mengurangi komputasi
+ Kita langsung mengambil kolom yang korelasi tinggi
+ Menghilangkan correlation, dapat menghilankan masalah multicol
Kekurangan melakukan PCA sebelum modeling:
- Kita tidak bisa melakukan interpretasi.
Modelling PCA
country_pca <- prcomp(num_country)
plot(country_pca)
Terdapat 3 komponen dari country_pca:
country_pca$sdev## [1] 2.0336314 1.2435217 1.0818425 0.9973889 0.8127847 0.4728437 0.3368067
## [8] 0.2971790 0.2586020country_pca$rotation## PC1 PC2 PC3 PC4 PC5
## child_mort -0.4195194 -0.192883937 0.02954353 -0.370653262 0.16896968
## exports 0.2838970 -0.613163494 -0.14476069 -0.003091019 -0.05761584
## health 0.1508378 0.243086779 0.59663237 -0.461897497 -0.51800037
## imports 0.1614824 -0.671820644 0.29992674 0.071907461 -0.25537642
## income 0.3984411 -0.022535530 -0.30154750 -0.392159039 0.24714960
## inflation -0.1931729 0.008404473 -0.64251951 -0.150441762 -0.71486910
## life_expec 0.4258394 0.222706743 -0.11391854 0.203797235 -0.10821980
## total_fer -0.4037290 -0.155233106 -0.01954925 -0.378303645 0.13526221
## gdpp 0.3926448 0.046022396 -0.12297749 -0.531994575 0.18016662
## PC6 PC7 PC8 PC9
## child_mort -0.200628153 0.07948854 0.68274306 0.32754180
## exports 0.059332832 0.70730269 0.01419742 -0.12308207
## health -0.007276456 0.24983051 -0.07249683 0.11308797
## imports 0.030031537 -0.59218953 0.02894642 0.09903717
## income -0.160346990 -0.09556237 -0.35262369 0.61298247
## inflation -0.066285372 -0.10463252 0.01153775 -0.02523614
## life_expec 0.601126516 -0.01848639 0.50466425 0.29403981
## total_fer 0.750688748 -0.02882643 -0.29335267 -0.02633585
## gdpp -0.016778761 -0.24299776 0.24969636 -0.62564572head(country_pca$x)## PC1 PC2 PC3 PC4 PC5 PC6
## [1,] -2.90428986 -0.09533386 0.7159652 -1.00224038 0.1578353 0.253834026
## [2,] 0.42862224 0.58639208 0.3324855 1.15757715 -0.1741535 -0.084325021
## [3,] -0.28436983 0.45380957 -1.2178421 0.86551146 -0.1560055 0.400491017
## [4,] -2.92362976 -1.69047094 -1.5204709 -0.83710739 0.2723897 0.546352696
## [5,] 1.03047668 -0.13624894 0.2250441 0.84452276 0.1924282 0.206298298
## [6,] 0.02234007 1.77385167 -0.8673884 0.03685602 -0.9781148 0.003585307
## PC7 PC8 PC9
## [1,] -0.38185183 -0.41383141 -0.01410602
## [2,] -0.24817249 0.22037967 0.17279609
## [3,] 0.08695208 0.18360988 0.08378519
## [4,] 0.43951279 0.35493006 -0.09106518
## [5,] -0.24125232 0.02361042 0.09398709
## [6,] 0.15038009 -0.12557185 0.12570099Reduce Dimension
Misal kita hanya ingin mereduksi 7 dimensi menjadi 5 dimensi, maka kita gunakan kolom PC1 sampai PC5 pada pca$x. Namun bagaimana kita memilih berapa dimensi yang kita pertahankan? Kita melihat cumulative variance untuk melakukan dimensionality reduction dengan fungsi summary().
summary(country_pca)## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 2.0336 1.2435 1.0818 0.9974 0.8128 0.47284 0.3368
## Proportion of Variance 0.4595 0.1718 0.1300 0.1105 0.0734 0.02484 0.0126
## Cumulative Proportion 0.4595 0.6313 0.7614 0.8719 0.9453 0.97015 0.9828
## PC8 PC9
## Standard deviation 0.29718 0.25860
## Proportion of Variance 0.00981 0.00743
## Cumulative Proportion 0.99257 1.00000fviz_eig(country_pca, ncp = 9, addlabels = T, main = "Variance explained by each dimensions")
Pada proses PCA, kita dapat mempertahankan beberapa komponen utama yang informatif dari dataset untuk melakukan pengurangan dimensi. Dengan melakukan PCA, kita dapat mengurangi dimensi sekaligus menyimpan informasi sebanyak mungkin. Dalam kasus ini saya akan menyimpan setidaknya 90% informasi dari data. Dari ringkasan PCA, kita pilih PC1 - PC5 dari total 9 PC. Dengan melakukan ini, kita dapat mengurangi ~44% dimensi dari data asli kita sambil mempertahankan 94.53% informasi dari data.
Kemudian saya akan ekstrak data dari PC1 - PC5 dan memasukkannya ke data frame baru. Data frame ini dapat digunakan untuk analisis menggunakan supervised learning atau tujuan lain.
country_x <- PCA(country[,2:10], graph = F, ncp = 5)$ind$coord
country_x <- cbind(country_x, cluster = model_country$cluster) %>% as.data.frame()
head(country_x)Visualisasi PCA
Kemudian kita visualisasikan data PCA dengan hasil cluster.
country_xc <- cbind(country_x, cluster = model_country$cluster)
plot_ly(country_xc, x = ~Dim.1, y = ~Dim.2, z = ~Dim.3, color = ~cluster, colors = c("black",
"red", "green", "blue")) %>% add_markers() %>% layout(scene = list(xaxis = list(title = "Dim.1"),
yaxis = list(title = "Dim.2"), zaxis = list(title = "Dim.3")))Conclusion
Dari hasil unsupervised learning diatas, dapat disimpulkan bahwa :
- K-means clustering bisa dilakukan dengan dataset Country ini. Dataset dipecah menjadi 3 Cluster.
- Pengurangan dimensi dapat dilakukan dengan dataset ini. Dari 9 PC yang ada, bisa diambil 5 PC saja dengan tetap mempertahan 94.53% informasi.
- Cluster 3 memiliki profiling kondisi negara yang paling membutuhkan bantuan dari HELP International dan diharapkan setelah cluster 3 mendapat bantuan, dapat dilanjutkan dengan cluster 2 dan cluster 1 (just in case cluster 1 sangat membutuhkan). Berikut saya lampirkan 10 negara yang masuk cluster 3 dan memiliki tingkat GDPP rendah.
country %>%
mutate(cluster = as.factor(model_country$cluster)) %>%
filter(cluster == 3) %>%
arrange(gdpp) %>%
head(10)