Analisis Biplot dan Korespondensi, Analisis Cluster
Yulia Wida Kharisma
2024-12-17
Menyiapkan library yang digunakan
# Mengecek dan menginstal package jika belum ada
packages <- c("readr", "dplyr", "DT", "psych", "GPArotation", "magrittr")
invisible(lapply(packages, function(pkg) {
if (!requireNamespace(pkg, quietly = TRUE)) {
install.packages(pkg, quietly = TRUE)
}
}))
# Memuat library
library(readr) # Membaca data
library(dplyr) # Data processing## Warning: package 'dplyr' was built under R version 4.3.3##
## 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(DT) # Menampilkan tabel agar mudah dilihat di browser## Warning: package 'DT' was built under R version 4.3.3library(psych)## Warning: package 'psych' was built under R version 4.3.3library(GPArotation)## Warning: package 'GPArotation' was built under R version 4.3.3##
## Attaching package: 'GPArotation'## The following objects are masked from 'package:psych':
##
## equamax, variminlibrary(magrittr)Membaca Data
library(haven)
datasim<-read_sav("D:/3SD2/APG/Praktikum/praktikum/P11/datasim2.sav")
data<-data.frame(datasim)
dataA. Analisis Biplot dan Korespondensi
Menggunakan kolom kab_kot sebagai row names
row.names(data)<-data%>%select(kab_kot)%>%t()
data <- data%>%select(-kab_kot)Menghapus kolom kab_kot dan menghitung pca
pca<-data%>%prcomp(scale = TRUE)Menampilkan summary
Memahami kontribusi tiap principal component dalam menjelaskan variabilitas data, sehingga dapat memutuskan jumlah principal component yang relevan untuk digunakan.
summary(pca)## Importance of components:
## PC1 PC2 PC3 PC4
## Standard deviation 1.8901 0.51940 0.3286 0.22334
## Proportion of Variance 0.8931 0.06744 0.0270 0.01247
## Cumulative Proportion 0.8931 0.96053 0.9875 1.00000Menampilkan biplot
library(factoextra)## Warning: package 'factoextra' was built under R version 4.3.3## Loading required package: ggplot2## Warning: package 'ggplot2' was built under R version 4.3.3##
## 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/ve3WBafviz_pca_biplot(
pca,
repel = TRUE,
geom.ind = c("point", "text"),
col.ind = "black",
col.var = "blue",
title = "Biplot PCA"
) +
theme(text = element_text(size = 12))
Dim1 (89.3%):
Menjelaskan sebagian besar variansi (89.3%) dalam data. Sumbu ini merupakan komponen utama yang menggambarkan perbedaan signifikan antar individu (kabupaten/kota) dalam dataset.Dim2 (6.7%):
Menjelaskan sejumlah kecil variansi (6.7%). Walaupun kontribusinya kecil, Dim2 masih menambahkan informasi tambahan terkait variasi data.
Dengan total 96% variansi yang dijelaskan oleh dua dimensi pertama, biplot ini efektif menggambarkan pola dan hubungan dalam data.
Vektor variabel menunjukkan arah dan kontribusi setiap variabel dalam membentuk sumbu Dim1 dan Dim2.
tingkat_pengangguranVektor ini memiliki kontribusi besar ke arah kanan (positif pada Dim1).
Kabupaten/kota yang terletak di sisi kanan memiliki nilai tingkat pengangguran yang tinggi.
ipm(Indeks Pembangunan Manusia)Vektor ini mengarah ke kiri bawah (negatif pada Dim1 dan Dim2).
Kabupaten/kota di sisi kiri bawah memiliki nilai IPM yang tinggi.
pdrb,per_kapita, danakses_internetVektor-variabel ini memiliki arah yang hampir sama (negatif di Dim1 dan sedikit negatif di Dim2).
Kabupaten/kota di sisi kiri (negatif Dim1) cenderung memiliki PDRB per kapita yang tinggi serta akses internet yang baik.
Dimensi 1 (Dim1) membedakan daerah berdasarkan tingkat pengangguran vs variabel ekonomi dan akses seperti PDRB, IPM, dan akses internet. Variabel-variabel ini memiliki hubungan negatif satu sama lain (tingkat pengangguran vs indikator ekonomi).
Kabupaten/Kota di Sisi Kanan (Z, AA, AC, dll.)
Letaknya dekat vektor
tingkat_pengangguran.Kabupaten/kota ini memiliki tingkat pengangguran tinggi tetapi nilai variabel ekonomi lainnya cenderung rendah.
Kabupaten/Kota di Sisi Kiri (A, B, H, dll.)
Dekat vektor
pdrb,akses_internet, danipm.Kabupaten/kota ini memiliki PDRB per kapita tinggi, IPM tinggi, dan akses internet baik.
Misalnya, titik A dan B mencerminkan wilayah dengan kondisi ekonomi yang lebih baik.
Kabupaten/Kota di Kuadran Atas (P, M, O, dll.)
Berada di area positif Dim2 dan bervariasi di Dim1.
Kabupaten/kota ini menunjukkan karakteristik yang tidak terlalu dipengaruhi oleh pengangguran maupun variabel ekonomi utama.
Kabupaten/Kota di Kuadran Bawah (F, D, H, dll.)
- Cenderung memiliki nilai variabel seperti IPM yang lebih tinggi dan pengangguran lebih rendah.
Membuat biplot dengan label hanya untuk individu terpilih
Pada biplot ini, hanya individu tertentu (A, F, K, P, Z) yang ditampilkan dengan label berwarna merah, sehingga analisis lebih fokus pada posisi individu-individu tersebut terhadap variabel-variabel yang ada.
individu_terpilih <- c("A", "F", "K", "P", "Z")
fviz_pca_biplot(pca, label = c("var","ind"),
repel = TRUE,
geom.ind=c("point","text"), # Menampilkan titik individu
col.ind = "red", # Warna titik individu menjadi merah
col.var = "black",# warna vector vriabel
select.ind = list(name = individu_terpilih), # Memilihindividu
title = "Biplot PCA dengan Label Individu Terpilih") +
theme(text = element_text(size = 14)) # Memperbesar ukuran teks
Dim1 (89.3%): Menjelaskan sebagian besar variasi dalam data, yang menggambarkan perbedaan signifikan antara individu berdasarkan variabel-variabel utama seperti tingkat pengangguran dan PDRB/akses internet.
Dim2 (6.7%): Menambahkan sedikit variasi tambahan yang membantu membedakan individu berdasarkan kontribusi minor dari beberapa variabel.
Total kontribusi dari kedua sumbu adalah 96%, sehingga plot ini sangat representatif untuk menggambarkan hubungan antar individu dan variabel.
Biplot ini menyoroti 5 individu terpilih dan memberikan gambaran:
A dan F cenderung memiliki kondisi ekonomi yang lebih baik (PDRB, IPM, akses internet).
Z memiliki tingkat pengangguran yang tinggi.
K dan P berada dalam posisi yang lebih rata-rata atau tidak ekstrem.
B. Analisis Cluster
Memeriksa Struktur Data
Kita akan memeriksa ringkasan statistik dasar seperti mean, median, dan rentang untuk setiap variabel
datasim%>%summary()## kab_kot pdrb_per_kapita ipm akses_internet
## Length:30 Min. : 8.836 Min. :54.98 Min. :40.92
## Class :character 1st Qu.:11.852 1st Qu.:59.25 1st Qu.:48.81
## Mode :character Median :20.576 Median :62.52 Median :64.48
## Mean :19.576 Mean :66.42 Mean :65.43
## 3rd Qu.:26.893 3rd Qu.:76.70 3rd Qu.:82.32
## Max. :29.702 Max. :79.00 Max. :90.00
## tingkat_pengangguran
## Min. : 2.007
## 1st Qu.: 3.845
## Median : 5.134
## Mean : 5.438
## 3rd Qu.: 7.017
## Max. :10.955Variabel-variabel bertipe numerik kecuali variabel kab_kot.
Standardisasi Variabel
Standarisasi diperlukan karena variabel-variabel dalam dataset memiliki skala pengukuran yang berbeda. Dengan standarisasi, nilai tiap variabel diubah menjadi skala yang sama (rata-rata = 0, standar deviasi = 1), sehingga semua variabel memiliki bobot yang setara dalam analisis klaster. Data yang sudah distandarisasi ditampilkan dalam tabel interaktif untuk memastikan prosesnya berhasil.
datatable(data, caption = "Variabel")data_standardized<-round(scale(data[,1:4]),4)
#Hanya memilih kolom/variabel berisi indikator yang akan digunakan
datatable(data_standardized, caption = "Data Hasil Standardisasi")data_standardized## pdrb_per_kapita ipm akses_internet tingkat_pengangguran
## A 0.9277 1.3845 1.3160 -1.2521
## B 1.2662 1.3845 1.2984 -1.3863
## C 1.0098 0.8693 1.0882 -1.3030
## D 1.3302 1.1384 1.0656 -0.3383
## E 1.3691 1.2275 1.0256 -1.0708
## F 0.7641 1.3845 1.2550 -0.4093
## G 1.0903 1.3845 1.0190 -0.9429
## H 1.3366 1.3845 1.1559 -0.5181
## I 1.1061 1.3470 1.1932 -1.2692
## J 1.0420 1.1113 1.5351 -1.4739
## K 0.5590 0.3853 0.2525 0.8247
## L -0.6102 -0.3246 0.1375 -0.3778
## M -0.5213 -0.7064 -0.0180 -0.4990
## N -0.3967 -0.7064 -0.3390 0.1398
## O 0.4228 -0.6619 -0.1001 -0.7402
## P 0.3753 -0.2022 -0.1648 -0.4349
## Q 0.6953 -0.5338 0.1809 0.0772
## R 0.0120 0.2456 -0.2329 0.2885
## S -0.5181 0.3941 0.2239 0.3373
## T 0.2585 -0.5636 -0.2109 -0.3446
## U -1.1726 -1.2586 -1.2014 1.5558
## V -1.4521 -0.9525 -0.8189 1.2274
## W -1.0673 -0.7685 -1.1036 0.3628
## X -1.3521 -0.7964 -0.9208 1.0510
## Y -1.1047 -1.0315 -1.2895 0.2346
## Z -1.2147 -1.2581 -1.0767 2.3701
## AA -0.6344 -0.7064 -1.1915 1.4913
## AB -1.1976 -1.0183 -1.1125 0.7631
## AC -1.3481 -1.2253 -1.4357 1.2128
## AD -0.9752 -0.9265 -1.5310 0.4241
## attr(,"scaled:center")
## pdrb_per_kapita ipm akses_internet
## 19.576059 66.419282 65.425972
## tingkat_pengangguran
## 5.438348
## attr(,"scaled:scale")
## pdrb_per_kapita ipm akses_internet
## 7.396425 9.086783 16.007880
## tingkat_pengangguran
## 2.327686Eksplorasi Data
library(corrplot)## corrplot 0.92 loadedM<-cor(datasim[,-1])
corrplot(M,method="ellipse")
cor(datasim[,-1])## pdrb_per_kapita ipm akses_internet
## pdrb_per_kapita 1.0000000 0.8900345 0.9185912
## ipm 0.8900345 1.0000000 0.9402733
## akses_internet 0.9185912 0.9402733 1.0000000
## tingkat_pengangguran -0.8058655 -0.7575838 -0.8251535
## tingkat_pengangguran
## pdrb_per_kapita -0.8058655
## ipm -0.7575838
## akses_internet -0.8251535
## tingkat_pengangguran 1.0000000Interpretasi: Terlihat bahwa ada korelasi yang tinggi Oleh karena itu dilakukan PCA sebelum cluster karena ada korelasi cukup tinggi , terutama jika menggunakan jarak Euclidean)
Transformasi data
Memeriksa apakah ada korelasi antar variabel daj apakah ada kecenderungan data berkelompok.
pca<-datasim[,-1]%>%prcomp(scale=TRUE)
summary(pca)## Importance of components:
## PC1 PC2 PC3 PC4
## Standard deviation 1.8901 0.51940 0.3286 0.22334
## Proportion of Variance 0.8931 0.06744 0.0270 0.01247
## Cumulative Proportion 0.8931 0.96053 0.9875 1.00000 data_pc<-pca$x[,1:2]Catatan: Terlihat hanya standar deviasi dari komponen 1 lebih dari satu dan proporsi variannya lebih dari 80 persen sehingga bisa dipilih 1 komponen. Namun untuk pemeriksaan kecenderungan pengelompokan, diperlukan dua komponen sehingga dipilih PC1 dan PC2
Pemeriksaan kecenderungan pengelompokan
Pengecekan kecenderungan pengelompokan dengan Visual Assessment of cluster Tendency:
dist.cor<-get_dist(data_pc,method="pearson")
fviz_dist(dist.cor,lab_size=8)
Memeriksa kecenderungan berkelompok dengan Hopkin Statistics :
library(factoextra)
res<-get_clust_tendency(data_pc,n=nrow(data_pc)-1, graph=TRUE)
res## $hopkins_stat
## [1] 0.6635534
##
## $plot
Interpretasi: Plot nilai statistik Hopkins menunjukkan ada kecenderungan
terbentuk klaster
Menentukan Jumlah Klaster
Metode clustering yang akan digunakan saat ini adalah K-Means Clustering. Sebelum melakukan clustering, kita perlu menentukan berapa banyak cluster yang optimal. Metode Elbow, Gap Statistics, Silhouette adalah beberapa metode yang paling populer. Silhouette : Memaksimumkan rata – rata indeks Silhouette Elbow : Meminimumkan total varians di dalam cluster Gap Statistics : Memaksimumkan perbedaan antara struktur kelompok yang terbentuk dengan struktur pengelompokan acak.
k_optim<-function(df_fix,metode){
library(factoextra)
wss<-fviz_nbclust(df_fix, metode, method = "wss")
gap<-fviz_nbclust(df_fix, metode, method = "gap_stat")
sil<-fviz_nbclust(df_fix, metode, method = "silhouette")
return(list(wss,gap,sil))}
k_optim(data_pc,kmeans)## [[1]]
##
## [[2]]
##
## [[3]]
Interpretasi: Pada wss, titik mulai landai dari titik ketiga, sehingga
jumlah klaster yang akan dibentuk sejumlah tiga. Begitu pula pada gap
statistics, titik tertinggi pertama yaitu pada titik ketiga. Dan pada
siloutte, titik tertinggi pertama pada titik ketiga.
Analisis Cluster
Analisis klaster menggunakan algoritma K-Means. Algoritma ini membagi data ke dalam tiga klaster berdasarkan centroid yang diinisialisasi secara acak. Posisi centroid diperbarui hingga jarak antara anggota klaster dan centroidnya minimal.
set.seed(123)
kmeans_clustering<-kmeans(x = data_standardized, centers = 3, nstart = 10) #parameter nstart digunakan untuk memberitahu fungsi berapa kali inisiasi centroid awal (secara acak) akan dibentuk
kmeans_clustering## K-means clustering with 3 clusters of sizes 10, 10, 10
##
## Cluster means:
## pdrb_per_kapita ipm akses_internet tingkat_pengangguran
## 1 1.12421 1.26160 1.19520 -0.99639
## 2 0.02766 -0.26739 -0.02709 -0.07290
## 3 -1.15188 -0.99421 -1.16816 1.06930
##
## Clustering vector:
## A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
## 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3
## AA AB AC AD
## 3 3 3 3
##
## Within cluster sum of squares by cluster:
## [1] 2.495681 6.585147 5.134797
## (between_SS / total_SS = 87.7 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"Dari output di atas diperoleh:
Ketiga klaster beranggotakan 10 observasi
Clustering vector menunjukkan nomor klaster untuk setiap observasi.
Centroid atau pusat dari setiapklaster dapat dilihat pada Cluster means.
Nilai Centroid data aslinya
Setelah cluster terbentuk, selanjutnya mengembalikan nilai centroid ke satuan pengukuran awal masing masing variabel untuk melihat rata-rata asli dari variabel tersebut.
data%>%
mutate(Klaster = kmeans_clustering$cluster)%>%
group_by(Klaster)%>%
summarise(Mean_pdrb_per_kapita = mean(pdrb_per_kapita),
Mean_ipm = mean(ipm),
Mean_akses_internet = mean(akses_internet),
Mean_tingkat_pengangguran = mean(tingkat_pengangguran))Pengelompokan Objek ke Dalam Cluster
# Load paket tibble terlebih dahulu
library(tibble)
# Menambahkan kolom Klaster dari hasil kmeans_clustering
cluster_data <- data %>%
mutate(Klaster = kmeans_clustering$cluster) %>% # Menambahkan kolom Klaster
rownames_to_column(var = "kab_kot") %>% # Mengembalikan row names ke kolom kab_kot
select(kab_kot, Klaster) %>% # Memilih kolom kab_kot dan Klaster
arrange(Klaster) # Mengurutkan berdasarkan Klaster
# Menampilkan hasil
cluster_dataMenambahkan Label Cluster ke Dataset
data$cluster = kmeans_clustering$cluster
dataVisualisasi Hasil Clustering
library(factoextra)
library(dplyr)
# Menambahkan label cluster ke data asli
data <- data %>%
mutate(Cluster = as.factor(kmeans_clustering$cluster))
# Menjalankan PCA pada data standar
pca <- prcomp(data[, 1:2], scale. = TRUE) # Gunakan kolom gre dan gpa
# Visualisasi PCA biplot dengan cluster
fviz_pca_biplot(
pca,
geom.ind = "point", # Tampilkan individu sebagai titik
col.ind = data$Cluster, # Warna berdasarkan klaster
palette = "jco", # Palet warna
addEllipses = TRUE, # Tambahkan ellipses per klaster
label = "var", # Tampilkan nama variabel
col.var = "blue", # Warna variabel
repel = TRUE, # Hindari tumpang tindih teks
ggtheme = theme_minimal()
) +
labs(
title = "PCA Biplot dengan Data Asli",
x = "Dimensi 1 (PCA)",
y = "Dimensi 2 (PCA)",
color = "Klaster"
)
Nilai Centroid data aslinya
Setelah cluster terbentuk, selanjutnya mengembalikan nilai centroid ke satuan pengukuran awal masing masing variabel untuk melihat rata-rata asli dari variabel tersebut.
data%>%
mutate(Klaster = kmeans_clustering$cluster)%>%
group_by(Klaster)%>%
summarise(Mean_pdrb_per_kapita = mean(pdrb_per_kapita),
Mean_ipm = mean(ipm),
Mean_akses_internet = mean(akses_internet),
Mean_tingkat_pengangguran = mean(tingkat_pengangguran))Interpretasi: Terlihat bahwa kabupaten/kota yang dikelompokkan pada cluster 1, memiliki rata - rata PDRB per kapita, IPM, Akses intrenet yang lebih tinggi, dan tingkat pengangguran terendah dibandingkan kabupaten-kota di cluster lainnya.