Tugas Individu TPG Praktikum : Analisis Gerombol
Muth’iah Iffa Karimah
2025-11-06
Input Data : Data World Happiness Record 2021 (kaggle)
library(readr)
library(psych)## Warning: package 'psych' was built under R version 4.5.2library(GPArotation)## Warning: package 'GPArotation' was built under R version 4.5.2##
## Attaching package: 'GPArotation'## The following objects are masked from 'package:psych':
##
## equamax, variminlibrary(factoextra)## Warning: package 'factoextra' was built under R version 4.5.2## Loading required package: ggplot2##
## Attaching package: 'ggplot2'## The following objects are masked from 'package:psych':
##
## %+%, alpha## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBalibrary(dplyr) ##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(cluster)
library(factoextra)
library(clusterCrit)## Warning: package 'clusterCrit' was built under R version 4.5.2library(ggplot2)
library(tidyr)
library(scales)## Warning: package 'scales' was built under R version 4.5.2##
## Attaching package: 'scales'## The following objects are masked from 'package:psych':
##
## alpha, rescale## The following object is masked from 'package:readr':
##
## col_factorlibrary(corrplot)## corrplot 0.95 loadedlibrary(cluster)data = read_csv("D:\\Semester 5\\TPG\\TPG\\world-happiness-report-2021.csv")## Rows: 149 Columns: 20
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): Country name, Regional indicator
## dbl (18): Ladder score, Standard error of ladder score, upperwhisker, lowerw...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.str(data)## spc_tbl_ [149 × 20] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ Country name : chr [1:149] "Finland" "Denmark" "Switzerland" "Iceland" ...
## $ Regional indicator : chr [1:149] "Western Europe" "Western Europe" "Western Europe" "Western Europe" ...
## $ Ladder score : num [1:149] 7.84 7.62 7.57 7.55 7.46 ...
## $ Standard error of ladder score : num [1:149] 0.032 0.035 0.036 0.059 0.027 0.035 0.036 0.037 0.04 0.036 ...
## $ upperwhisker : num [1:149] 7.9 7.69 7.64 7.67 7.52 ...
## $ lowerwhisker : num [1:149] 7.78 7.55 7.5 7.44 7.41 ...
## $ Logged GDP per capita : num [1:149] 10.8 10.9 11.1 10.9 10.9 ...
## $ Social support : num [1:149] 0.954 0.954 0.942 0.983 0.942 0.954 0.934 0.908 0.948 0.934 ...
## $ Healthy life expectancy : num [1:149] 72 72.7 74.4 73 72.4 73.3 72.7 72.6 73.4 73.3 ...
## $ Freedom to make life choices : num [1:149] 0.949 0.946 0.919 0.955 0.913 0.96 0.945 0.907 0.929 0.908 ...
## $ Generosity : num [1:149] -0.098 0.03 0.025 0.16 0.175 0.093 0.086 -0.034 0.134 0.042 ...
## $ Perceptions of corruption : num [1:149] 0.186 0.179 0.292 0.673 0.338 0.27 0.237 0.386 0.242 0.481 ...
## $ Ladder score in Dystopia : num [1:149] 2.43 2.43 2.43 2.43 2.43 2.43 2.43 2.43 2.43 2.43 ...
## $ Explained by: Log GDP per capita : num [1:149] 1.45 1.5 1.57 1.48 1.5 ...
## $ Explained by: Social support : num [1:149] 1.11 1.11 1.08 1.17 1.08 ...
## $ Explained by: Healthy life expectancy : num [1:149] 0.741 0.763 0.816 0.772 0.753 0.782 0.763 0.76 0.785 0.782 ...
## $ Explained by: Freedom to make life choices: num [1:149] 0.691 0.686 0.653 0.698 0.647 0.703 0.685 0.639 0.665 0.64 ...
## $ Explained by: Generosity : num [1:149] 0.124 0.208 0.204 0.293 0.302 0.249 0.244 0.166 0.276 0.215 ...
## $ Explained by: Perceptions of corruption : num [1:149] 0.481 0.485 0.413 0.17 0.384 0.427 0.448 0.353 0.445 0.292 ...
## $ Dystopia + residual : num [1:149] 3.25 2.87 2.84 2.97 2.8 ...
## - attr(*, "spec")=
## .. cols(
## .. `Country name` = col_character(),
## .. `Regional indicator` = col_character(),
## .. `Ladder score` = col_double(),
## .. `Standard error of ladder score` = col_double(),
## .. upperwhisker = col_double(),
## .. lowerwhisker = col_double(),
## .. `Logged GDP per capita` = col_double(),
## .. `Social support` = col_double(),
## .. `Healthy life expectancy` = col_double(),
## .. `Freedom to make life choices` = col_double(),
## .. Generosity = col_double(),
## .. `Perceptions of corruption` = col_double(),
## .. `Ladder score in Dystopia` = col_double(),
## .. `Explained by: Log GDP per capita` = col_double(),
## .. `Explained by: Social support` = col_double(),
## .. `Explained by: Healthy life expectancy` = col_double(),
## .. `Explained by: Freedom to make life choices` = col_double(),
## .. `Explained by: Generosity` = col_double(),
## .. `Explained by: Perceptions of corruption` = col_double(),
## .. `Dystopia + residual` = col_double()
## .. )
## - attr(*, "problems")=<externalptr>View(data)Eksplorasi Data
Peubah Relevan
Memilih peubah yang relevan dengan sosial-politik-dan ekoonomi karena peubah seperti log GDP per kapita menunjukkan skor bukan peubah untuk penggerombolan.
# Memilih peubah yang relevan
data_new <- data %>%
select(`Country name`,
`Logged GDP per capita`,
`Social support`,
`Healthy life expectancy`,
`Freedom to make life choices`,
`Generosity`,
`Perceptions of corruption`)
# Lihat 6 baris pertama dari data baru kita
head(data_new)## # A tibble: 6 × 7
## `Country name` `Logged GDP per capita` `Social support` Healthy life expecta…¹
## <chr> <dbl> <dbl> <dbl>
## 1 Finland 10.8 0.954 72
## 2 Denmark 10.9 0.954 72.7
## 3 Switzerland 11.1 0.942 74.4
## 4 Iceland 10.9 0.983 73
## 5 Netherlands 10.9 0.942 72.4
## 6 Norway 11.1 0.954 73.3
## # ℹ abbreviated name: ¹`Healthy life expectancy`
## # ℹ 3 more variables: `Freedom to make life choices` <dbl>, Generosity <dbl>,
## # `Perceptions of corruption` <dbl>View(data_new)Cek Missing Value
# Menghitung jumlah data hilang di tiap kolom
colSums(is.na(data_new))## Country name Logged GDP per capita
## 0 0
## Social support Healthy life expectancy
## 0 0
## Freedom to make life choices Generosity
## 0 0
## Perceptions of corruption
## 0Data sudah bersih, terlihat tidak ada missing value di tiap kolom
Skala Peubah
Menjawab pertanyaan “Apakah perlu standarisasi?”
data.num = data_new %>% select(-`Country name`) # Pengecualian kolom negara untuk dianalisis
summary(data.num) # Ringkasan statistik## Logged GDP per capita Social support Healthy life expectancy
## Min. : 6.635 Min. :0.4630 Min. :48.48
## 1st Qu.: 8.541 1st Qu.:0.7500 1st Qu.:59.80
## Median : 9.569 Median :0.8320 Median :66.60
## Mean : 9.432 Mean :0.8147 Mean :64.99
## 3rd Qu.:10.421 3rd Qu.:0.9050 3rd Qu.:69.60
## Max. :11.647 Max. :0.9830 Max. :76.95
## Freedom to make life choices Generosity Perceptions of corruption
## Min. :0.3820 Min. :-0.28800 Min. :0.0820
## 1st Qu.:0.7180 1st Qu.:-0.12600 1st Qu.:0.6670
## Median :0.8040 Median :-0.03600 Median :0.7810
## Mean :0.7916 Mean :-0.01513 Mean :0.7274
## 3rd Qu.:0.8770 3rd Qu.: 0.07900 3rd Qu.:0.8450
## Max. :0.9700 Max. : 0.54200 Max. :0.9390Nilai peubah “Healthy life expectancy” dan “Logged GDP per capita” cukup berbeda dengan nilai 3 peubah lainnya yang berada di bawah 1. Artinya perlu lakukan standarisasi
Outlier
# Matriks korelasi
corr = cor(data.num)
# Visualisasi
corrplot(corr, method = "number", tl.col = "black", tl.srt = 45)
Dalam data terlihat bahwa korelasi tertinggi antarpeubah adalah
- Helathy life expectancy - Logged GDP per capita = 0.86
- Social support - Logged GDP per capita = 0.79
- Healthy life expecancy - Social support = 0.72
Artinya hasil matriks korelasi ini menunjukkan bahwa ada multikolinearitas pada data, perlu “membuang” salah satu peubah yang menyebabkan redudansi.
Di sini saya akan membuang peubah “Healthy life expectancy” karena peubah tersebut adalah hasil dari peubah “Logged GDP per capita” dan “Social support” yang mana kedua peubah ini adalah pendorong utama dari ekonomi dan sosial.
Boxplot
# Logged GDP per capita
ggplot(data.num, aes(x = "", y = `Logged GDP per capita`)) +
geom_boxplot() +
labs(title = "Boxplot untuk Logged GDP per capita", x = "")
# Social support
ggplot(data.num, aes(x = "", y = `Social support`)) +
geom_boxplot() +
labs(title = "Boxplot untuk Social support", x = "")
# Freedom to make life choices
ggplot(data.num, aes(x = "", y = `Freedom to make life choices`)) +
geom_boxplot() +
labs(title = "Boxplot untuk Freedom to make life choices", x = "")
# Generosity
ggplot(data.num, aes(x = "", y = `Generosity`)) +
geom_boxplot() +
labs(title = "Boxplot untuk Generosity", x = "")
# Perceptions of corruption
ggplot(data.num, aes(x = "", y = `Perceptions of corruption`)) +
geom_boxplot() +
labs(title = "Boxplot untuk Perceptions of corruption", x = "")
Logged GDP per capita –> tidak ada outlier
Social support –> ada 2 outlier di bawah (agak berdekatan)
Freedom to make life choices –> ada 1 oulier di bawah (cukup jauh)
Generosity –> ada 3 outlier di atas (2 outlier terjauh cukup berdektan)
Perceptioin of corruption –> cukup banyak outlier di bawah (ada 1 outlier cukup jauh)
Persiapan Data Final
# Buang peubah healthy life expectancy
data.final = data.num %>% select(-`Healthy life expectancy`)
head(data.final)## # A tibble: 6 × 5
## `Logged GDP per capita` `Social support` Freedom to make life cho…¹ Generosity
## <dbl> <dbl> <dbl> <dbl>
## 1 10.8 0.954 0.949 -0.098
## 2 10.9 0.954 0.946 0.03
## 3 11.1 0.942 0.919 0.025
## 4 10.9 0.983 0.955 0.16
## 5 10.9 0.942 0.913 0.175
## 6 11.1 0.954 0.96 0.093
## # ℹ abbreviated name: ¹`Freedom to make life choices`
## # ℹ 1 more variable: `Perceptions of corruption` <dbl>str(data.final)## tibble [149 × 5] (S3: tbl_df/tbl/data.frame)
## $ Logged GDP per capita : num [1:149] 10.8 10.9 11.1 10.9 10.9 ...
## $ Social support : num [1:149] 0.954 0.954 0.942 0.983 0.942 0.954 0.934 0.908 0.948 0.934 ...
## $ Freedom to make life choices: num [1:149] 0.949 0.946 0.919 0.955 0.913 0.96 0.945 0.907 0.929 0.908 ...
## $ Generosity : num [1:149] -0.098 0.03 0.025 0.16 0.175 0.093 0.086 -0.034 0.134 0.042 ...
## $ Perceptions of corruption : num [1:149] 0.186 0.179 0.292 0.673 0.338 0.27 0.237 0.386 0.242 0.481 ...Standarisasi Data
data.final.new = scale(data.final)
summary(data.final.new)## Logged GDP per capita Social support Freedom to make life choices
## Min. :-2.4143 Min. :-3.0616 Min. :-3.6141
## 1st Qu.:-0.7692 1st Qu.:-0.5635 1st Qu.:-0.6494
## Median : 0.1181 Median : 0.1502 Median : 0.1094
## Mean : 0.0000 Mean : 0.0000 Mean : 0.0000
## 3rd Qu.: 0.8534 3rd Qu.: 0.7856 3rd Qu.: 0.7536
## Max. : 1.9116 Max. : 1.4645 Max. : 1.5742
## Generosity Perceptions of corruption
## Min. :-1.8112 Min. :-3.6013
## 1st Qu.:-0.7359 1st Qu.:-0.3373
## Median :-0.1385 Median : 0.2988
## Mean : 0.0000 Mean : 0.0000
## 3rd Qu.: 0.6248 3rd Qu.: 0.6559
## Max. : 3.6980 Max. : 1.1804Semua nilai peubah data sudah dalam satu skala yang sama.
# Simpan nama negara untuk label di akhir
negara = data_new$`Country name`
head(negara)## [1] "Finland" "Denmark" "Switzerland" "Iceland" "Netherlands"
## [6] "Norway"Menentukan K Optimal
Menggunakan fviz_nbclust untuk mencari jumlah gerombol (K) optimal dengan menggunakan FUNcluster = pam (K-Medoids) dan method = “silhouette” yang robust.
# Penentuan K Optimal
set.seed(123)
plot_k_optimal = fviz_nbclust(data.final.new,
FUNcluster = pam, # Fungsi: K-Medoids
method = "silhouette") # Metode Evaluasi
plot_k_optimal
Terlihat dari plot bahwa K optimalnya adalah 3, maka akan ada 3 gerombol karena ketika menambahkan nilai K Average silhouette width nya mulai menurun sehingga kurang baik.
Metode Hierarki
# Hitung matriks jarak
euclidean = dist(data.final.new, method = "euclidean")
# Jalankan metode hierarki (Metode Ward)
set.seed(123)
hierarki = hclust(euclidean, method = "ward.D2")
# Visualisasi (Dendogram)
plot(hierarki,
main = "Dendogram Negara (Metode Ward, K = 3)",
xlab = "Negara",
sub = "Metode Jarak Euclidean",
labels = FALSE,
cex = 0.6)
rect.hclust(hierarki, k = 3, border = "red") # Menambahkan kotak merah untuk gerombol
# Label Keanggotaan Gerombol
label_hierarki = cutree(hierarki, k=3)
print(table(label_hierarki))## label_hierarki
## 1 2 3
## 16 75 58# Daftar negara tiap gerombol
gerombol = data.frame(
Negara = negara,
Gerombol = label_hierarki
)
head(gerombol)## Negara Gerombol
## 1 Finland 1
## 2 Denmark 1
## 3 Switzerland 1
## 4 Iceland 2
## 5 Netherlands 1
## 6 Norway 1# Dapatkan vektor nama negara untuk setiap gerombol
negarag1 <- gerombol %>%
filter(Gerombol == 1) %>%
pull(Negara) # 16 negara
negarag2 <- gerombol %>%
filter(Gerombol == 2) %>%
pull(Negara) # 75 negara
negarag3 <- gerombol %>%
filter(Gerombol == 3) %>%
pull(Negara) # 58 negara
# Cari panjang maksimum (yaitu 75)
max_len <- max(length(negarag1), length(negarag2), length(negarag3))
# "Pad" (isi) vektor yang lebih pendek dengan NA agar panjangnya sama
length(negarag1) <- max_len
length(negarag2) <- max_len
length(negarag3) <- max_len
# Buat data frame (tabel) akhir
# check.names = FALSE agar nama kolom tidak diubah jadi "Gerombol.1"
tabel_hasil_hierarki <- data.frame(
"Gerombol 1" = negarag1,
"Gerombol 2" = negarag2,
"Gerombol 3" = negarag3,
check.names = FALSE
)
# Tabel daftar negara per gerombol
print("--- Tabel Anggota Gerombol (Metode Hierarki) ---")## [1] "--- Tabel Anggota Gerombol (Metode Hierarki) ---"print(tabel_hasil_hierarki)## Gerombol 1 Gerombol 2 Gerombol 3
## 1 Finland Iceland Guatemala
## 2 Denmark Israel Kosovo
## 3 Switzerland Costa Rica Uzbekistan
## 4 Netherlands Czech Republic El Salvador
## 5 Norway United States Thailand
## 6 Sweden Belgium Nicaragua
## 7 Luxembourg France Honduras
## 8 New Zealand Bahrain Philippines
## 9 Austria Malta Kyrgyzstan
## 10 Australia Taiwan Province of China Bolivia
## 11 Germany United Arab Emirates Paraguay
## 12 Canada Saudi Arabia Tajikistan
## 13 Ireland Spain Vietnam
## 14 United Kingdom Italy Malaysia
## 15 Singapore Slovenia Indonesia
## 16 Hong Kong S.A.R. of China Uruguay Congo (Brazzaville)
## 17 <NA> Slovakia Ivory Coast
## 18 <NA> Brazil Nepal
## 19 <NA> Mexico Maldives
## 20 <NA> Jamaica Cameroon
## 21 <NA> Lithuania Senegal
## 22 <NA> Cyprus Albania
## 23 <NA> Estonia Ghana
## 24 <NA> Panama Niger
## 25 <NA> Chile Turkmenistan
## 26 <NA> Poland Gambia
## 27 <NA> Kazakhstan Benin
## 28 <NA> Romania Laos
## 29 <NA> Kuwait Bangladesh
## 30 <NA> Serbia Guinea
## 31 <NA> Mauritius Pakistan
## 32 <NA> Latvia Burkina Faso
## 33 <NA> Colombia Cambodia
## 34 <NA> Hungary Mozambique
## 35 <NA> Japan Nigeria
## 36 <NA> Argentina Mali
## 37 <NA> Portugal Iran
## 38 <NA> Croatia Uganda
## 39 <NA> South Korea Liberia
## 40 <NA> Peru Kenya
## 41 <NA> Bosnia and Herzegovina Myanmar
## 42 <NA> Moldova Chad
## 43 <NA> Ecuador Sri Lanka
## 44 <NA> Greece Comoros
## 45 <NA> Mongolia Ethiopia
## 46 <NA> Montenegro Madagascar
## 47 <NA> Dominican Republic Togo
## 48 <NA> North Cyprus Zambia
## 49 <NA> Belarus Sierra Leone
## 50 <NA> Russia India
## 51 <NA> Libya Burundi
## 52 <NA> China Tanzania
## 53 <NA> Armenia Haiti
## 54 <NA> Bulgaria Malawi
## 55 <NA> Azerbaijan Lesotho
## 56 <NA> North Macedonia Rwanda
## 57 <NA> South Africa Zimbabwe
## 58 <NA> Turkey Afghanistan
## 59 <NA> Morocco <NA>
## 60 <NA> Venezuela <NA>
## 61 <NA> Georgia <NA>
## 62 <NA> Algeria <NA>
## 63 <NA> Ukraine <NA>
## 64 <NA> Iraq <NA>
## 65 <NA> Gabon <NA>
## 66 <NA> Tunisia <NA>
## 67 <NA> Lebanon <NA>
## 68 <NA> Namibia <NA>
## 69 <NA> Palestinian Territories <NA>
## 70 <NA> Jordan <NA>
## 71 <NA> Swaziland <NA>
## 72 <NA> Egypt <NA>
## 73 <NA> Mauritania <NA>
## 74 <NA> Yemen <NA>
## 75 <NA> Botswana <NA>Metode Non Hierarki
# K-Medoids (pam)
set.seed(123)
model_kmedoids <- pam(data.final.new,
k = 3,
metric = "euclidean") # Gunakan data standar 'data.final.new' dan K=3
# Label model K-Medoids
label_kmedoids <- model_kmedoids$cluster
# Visualisasi
plot_kmedoids <- fviz_cluster(model_kmedoids,
data = data.final.new,
geom = "point",
ellipse.type = "convex") +
ggtitle("Hasil K-Medoids (K=3)") +
theme_minimal()
print(plot_kmedoids)
# Membandingkan metode
tabel_silang <- table(Hierarki_Ward = label_hierarki,
KMedoids_pam = label_kmedoids)
print("TABEL SILANG PERBANDINGAN METODE")## [1] "TABEL SILANG PERBANDINGAN METODE"print(tabel_silang)## KMedoids_pam
## Hierarki_Ward 1 2 3
## 1 16 0 0
## 2 5 63 7
## 3 1 15 42Pada perbandingan terlihat bahwa ada persamaan jumlah negara pada gerombol 1 dan ada perbedaan pada jumlah gerombol 2 dan 3
Gerombol 1 pada metode ward dan K-Medoids sama sama memiliki 16 negara
Gerombol 2 pada metode ward memiliki 75 negara namun pada K-Medoids memiliki 53 negara
Gerombol 3 pada metode ward memiliki 58 negara, namun K-Medoids memiliki 42 negara
Perbedaan ini mungkin terjadi disebabkan karena outlier yang terdapat dalam data. Metode Ward yang tidak robust terhadap outlier dan berbasis ragam yang mungkin agak terganggu dengan outlier.
Sementara metode K-Medoids yang memang robust terhadap outlier dan mengabaikan outlier tersebut sehingga memiliki batas yang berbeda si daerah yang “abu-abu”
Profiling
Menentukan apa makna dari 3 gerombol yang dihasilkan. Di sini dipilih metode K-Medoids yang memang robust terhadap outlier secara teoritis.
profiling = data.final %>% mutate (Gerombol = label_kmedoids)
# Hitung rataan tiap peubah di tiap gerombol
tabel_profil = profiling %>%
group_by(Gerombol) %>%
summarise_all(mean)
# Tabel Hasil profiling
print(tabel_profil)## # A tibble: 3 × 6
## Gerombol `Logged GDP per capita` `Social support` Freedom to make life choic…¹
## <int> <dbl> <dbl> <dbl>
## 1 1 10.9 0.928 0.909
## 2 2 9.84 0.863 0.802
## 3 3 8.14 0.687 0.723
## # ℹ abbreviated name: ¹`Freedom to make life choices`
## # ℹ 2 more variables: Generosity <dbl>, `Perceptions of corruption` <dbl>View(tabel_profil)Dari hasil profiling Gerombol 1 merupakan gerombol dengan tingkat kebahagiaan yang paling tinggi karena Logged GDP per capita, Social support, Freedom to make life choices, dan Generosity nya memiliki nilai yang paling tinggi serta dengan nilai Perception of corruptionnya yang paling rendah.
Pada hasil profiling Gerombol 2 dan 3 ada beberapa perbedaan.
Gerombol 2 unggul dalam 3 pilar utama yaitu : Logged GDP per capita, Social support, dan Freedom to make life choices
Tetapi gerombol 2 nilai Generosity-nya jauh lebih kecil (-0.08) dari Gerombol 3 (0.05)
Dari hasil pertimbangan perbedaan di antara Gerombol 2 dan 3, diputuskan bahwa Gerombol 2 memiliki tingkat kebahagiaan yang lebih tinggi dari Gerombol 3 karena unggul dalam 3 pilar utama.
Sehingga hasil akhir profilingnya adalah sebagai berikut:
Gerombol 1 (16 Negara): “Negara Sejahtera, Transparan, & Dermawan” (Skor tertinggi di semua metrik positif, skor terendah di metrik negatif (korupsi)).
Gerombol 2 (75 Negara): “Negara Berkembang-Mapan dengan Masalah Korupsi” (GDP, Dukungan Sosial, dan Kebebasan di tingkat “Menengah-Atas”. Namun, tingkat korupsinya tinggi dan kedermawanannya rendah).
Gerombol 3 (58 Negara): “Negara Berkembang-Rendah / Miskin” (Skor terendah di 3 pilar utama: GDP, Dukungan Sosial, dan Kebebasan. Meskipun mereka sedikit lebih dermawan dan korupsinya sedikit lebih baik dari G2, mereka tertinggal jauh di fondasi ekonomi & sosial).