Pertama, kita memuat pustaka yang dibutuhkan untuk pengambilan data, manipulasi, serta analisis PCA dan Factor Analysis.
Kita menggunakan data dari World Bank untuk periode 2014 hingga 2024 yang mencakup berbagai indikator kesehatan global.
indikator <- c(
"Life_Expectancy" = "SP.DYN.LE00.IN",
"Adult_Mortality" = "SP.DYN.AMRT.MA",
"Infant_Mortality" = "SP.DYN.IMRT.IN",
"Health_Expenditure" = "SH.XPD.CHEX.GD.ZS",
"School_Enrollment" = "SE.PRM.ENRR",
"HepB3_Immunization" = "SH.IMM.HEPB",
"Measles_Immunization" = "SH.IMM.MEAS",
"Polio_Immunization" = "SH.IMM.POL3",
"DPT_Immunization" = "SH.IMM.IDPT",
"TB_Incidence" = "SH.TBS.INCD",
"GDP_per_Capita" = "NY.GDP.PCAP.CD",
"Undernourishment" = "SN.ITK.DEFC.ZS"
)
# Mengambil data menggunakan API WDI
data_wb <- WDI(indicator = indikator, start = 2014, end = 2024, extra = FALSE)Data numerik diseleksi dan baris yang memiliki nilai kosong (NA) dihapus agar analisis dapat berjalan dengan baik. Data kemudian distandardisasi.
data_numerik <- data_wb %>%
select(all_of(names(indikator)))
data_bersih <- drop_na(data_numerik)
data_standard <- scale(data_bersih)
# Menampilkan cuplikan data yang sudah bersih (Interaktif)
datatable(head(data_bersih, 50), options = list(scrollX = TRUE, pageLength = 5))Sebelum masuk ke PCA, mari kita lihat hubungan antar variabel menggunakan visualisasi matriks korelasi.
matriks_korelasi <- cor(data_standard)
corrplot(matriks_korelasi, method = "color", type = "upper",
tl.col = "black", tl.srt = 45,
addCoef.col = "black", number.cex = 0.7,
diag = FALSE, title = "Korelasi Indikator Kesehatan",
mar = c(0,0,1,0))Untuk memastikan data layak digunakan dalam Factor Analysis, kita melakukan uji Kaiser-Meyer-Olkin (KMO) dan Bartlett’s Test of Sphericity.
kmo_result <- KMO(matriks_korelasi)
bartlett_result <- cortest.bartlett(matriks_korelasi, n = nrow(data_standard))
# Menampilkan hasil
kmo_result## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = matriks_korelasi)
## Overall MSA = 0.82
## MSA for each item =
## Life_Expectancy Adult_Mortality Infant_Mortality
## 0.72 0.72 0.75
## Health_Expenditure School_Enrollment HepB3_Immunization
## 0.81 0.48 0.87
## Measles_Immunization Polio_Immunization DPT_Immunization
## 0.93 0.88 0.82
## TB_Incidence GDP_per_Capita Undernourishment
## 0.90 0.89 0.96
## $chisq
## [1] 18655.08
##
## $p.value
## [1] 0
##
## $df
## [1] 66
Analisis Komponen Utama digunakan untuk mereduksi dimensi data sambil mempertahankan sebanyak mungkin varians asli.
pca_result <- prcomp(data_standard, center = TRUE, scale. = TRUE)
# Visualisasi Scree Plot menggunakan factoextra
fviz_eig(pca_result, addlabels = TRUE, ylim = c(0, 50),
main = "Scree Plot: Persentase Varians PCA",
barfill = "#2C3E50", barcolor = "#2C3E50",
linecolor = "#E74C3C")Kita akan mengekstraksi 3 faktor berdasarkan data korelasi. Berikut adalah perbandingan sebelum dan sesudah dilakukan rotasi Varimax.
fa_unrotated <- fa(r = matriks_korelasi, nfactors = 3, rotate = "none", fm = "ml")
print(fa_unrotated$loadings, cutoff = 0.4, sort = TRUE)##
## Loadings:
## ML1 ML2 ML3
## Life_Expectancy 0.975
## Adult_Mortality -0.843 -0.410
## Infant_Mortality -0.971
## TB_Incidence -0.595
## GDP_per_Capita 0.593
## Undernourishment -0.735
## HepB3_Immunization 0.506 0.800
## Measles_Immunization 0.617 0.631
## Polio_Immunization 0.627 0.735
## DPT_Immunization 0.600 0.788
## Health_Expenditure 0.437
## School_Enrollment
##
## ML1 ML2 ML3
## SS loadings 5.430 2.256 0.363
## Proportion Var 0.452 0.188 0.030
## Cumulative Var 0.452 0.640 0.671
Rotasi Varimax membantu memperjelas struktur faktor agar lebih mudah diinterpretasi.
fa_rotated <- fa(r = matriks_korelasi, nfactors = 3, rotate = "varimax", fm = "ml")
print(fa_rotated$loadings, cutoff = 0.4, sort = TRUE)##
## Loadings:
## ML1 ML2 ML3
## Life_Expectancy 0.973
## Adult_Mortality -0.901
## Infant_Mortality -0.890
## TB_Incidence -0.581
## GDP_per_Capita 0.628
## Undernourishment -0.680
## HepB3_Immunization 0.921
## Measles_Immunization 0.798
## Polio_Immunization 0.897
## DPT_Immunization 0.936
## Health_Expenditure 0.454
## School_Enrollment
##
## ML1 ML2 ML3
## SS loadings 4.371 3.416 0.261
## Proportion Var 0.364 0.285 0.022
## Cumulative Var 0.364 0.649 0.671