Analisis Korespondensi

Data

data("HairEyeColor")

Analisis dilakukan untuk mengkaji hubungan antara warna rambut dan warna mata menggunakan data HairEyeColor dari library R. Data disajikan dalam bentuk tabel kontingensi Hair × Eye yang berisi frekuensi kemunculan masing-masing kategori.

Tabel Kontingensi

X <- margin.table(HairEyeColor, margin = c(1, 2))
X
##        Eye
## Hair    Brown Blue Hazel Green
##   Black    68   20    15     5
##   Brown   119   84    54    29
##   Red      26   17    14    14
##   Blond     7   94    10    16

Tabel kontingensi menunjukkan distribusi frekuensi kombinasi warna rambut dan warna mata. Terlihat bahwa beberapa kombinasi memiliki frekuensi tinggi, seperti rambut coklat–mata coklat, sementara kombinasi lain relatif jarang.

Tabel Korespondensi

# Total pengamatan
n <- sum(X)

# Tabel korespondensi
P <- X / n
P
##        Eye
## Hair          Brown        Blue       Hazel       Green
##   Black 0.114864865 0.033783784 0.025337838 0.008445946
##   Brown 0.201013514 0.141891892 0.091216216 0.048986486
##   Red   0.043918919 0.028716216 0.023648649 0.023648649
##   Blond 0.011824324 0.158783784 0.016891892 0.027027027

Tabel korespondensi merupakan normalisasi tabel kontingensi terhadap total observasi. Nilai pada tabel ini merepresentasikan proporsi relatif, sehingga memungkinkan perbandingan antar kategori tanpa dipengaruhi oleh ukuran sampel.

Vektor Kolom dan Baris

# Vektor baris
r <- rowSums(P)
r
##     Black     Brown       Red     Blond 
## 0.1824324 0.4831081 0.1199324 0.2145270
# Vektor kolom
c <- colSums(P)
c
##     Brown      Blue     Hazel     Green 
## 0.3716216 0.3631757 0.1570946 0.1081081

Vektor baris menunjukkan proporsi total masing-masing warna rambut, sedangkan vektor kolom menunjukkan proporsi total masing-masing warna mata. Nilai ini merepresentasikan massa setiap kategori dalam Analisis Korespondensi.

Matriks Baris dan Kolom

# Matriks diagonal baris
Dr <- diag(r)
Dr
##           [,1]      [,2]      [,3]     [,4]
## [1,] 0.1824324 0.0000000 0.0000000 0.000000
## [2,] 0.0000000 0.4831081 0.0000000 0.000000
## [3,] 0.0000000 0.0000000 0.1199324 0.000000
## [4,] 0.0000000 0.0000000 0.0000000 0.214527
# Matriks diagonal kolom
Dc <- diag(c)
Dc
##           [,1]      [,2]      [,3]      [,4]
## [1,] 0.3716216 0.0000000 0.0000000 0.0000000
## [2,] 0.0000000 0.3631757 0.0000000 0.0000000
## [3,] 0.0000000 0.0000000 0.1570946 0.0000000
## [4,] 0.0000000 0.0000000 0.0000000 0.1081081

Matriks diagonal baris dan kolom digunakan sebagai pembobot dalam analisis. Matriks ini berperan penting dalam proses standardisasi dan penentuan jarak chi-square antar profil.

Analisis Profil Baris

# Profil baris
row_profiles <- sweep(P, 1, r, FUN = "/")
row_profiles
##        Eye
## Hair         Brown       Blue      Hazel      Green
##   Black 0.62962963 0.18518519 0.13888889 0.04629630
##   Brown 0.41608392 0.29370629 0.18881119 0.10139860
##   Red   0.36619718 0.23943662 0.19718310 0.19718310
##   Blond 0.05511811 0.74015748 0.07874016 0.12598425

Profil baris menggambarkan distribusi warna mata bersyarat pada warna rambut tertentu. Perbedaan antar profil baris menunjukkan bahwa setiap warna rambut memiliki pola distribusi warna mata yang berbeda, mengindikasikan adanya ketergantungan antar variabel.

Analisis Profil Kolom

# Profil kolom
col_profiles <- sweep(P, 2, c, FUN = "/")
col_profiles
##        Eye
## Hair         Brown       Blue      Hazel      Green
##   Black 0.30909091 0.09302326 0.16129032 0.07812500
##   Brown 0.54090909 0.39069767 0.58064516 0.45312500
##   Red   0.11818182 0.07906977 0.15053763 0.21875000
##   Blond 0.03181818 0.43720930 0.10752688 0.25000000

Profil kolom menunjukkan distribusi warna rambut bersyarat pada warna mata tertentu. Pola yang tidak seragam antar kolom memperkuat indikasi bahwa hubungan antara warna rambut dan warna mata tidak bersifat independen.

Menentukan Koordinat Profil Baris dan Kolom

Koordinat diperoleh melalui dekomposisi singular terhadap matriks standar. Dimensi utama menangkap variasi terbesar dari asosiasi antar kategori. Kategori dengan koordinat ekstrem berkontribusi besar terhadap pembentukan dimensi tersebut.

Matriks deviasi standar

# Matriks deviasi
S <- P - r %*% t(c)

# Matriks standar
Z <- solve(sqrt(Dr)) %*% S %*% solve(sqrt(Dc))
Z
##              [,1]        [,2]        [,3]        [,4]
## [1,]  0.180773066 -0.12615064 -0.01961905 -0.08029590
## [2,]  0.050694815 -0.08012300  0.05561963 -0.01418351
## [3,] -0.003081574 -0.07110772  0.03502737  0.09381990
## [4,] -0.240474512  0.28973637 -0.09156384  0.02518174

Singular Value Decomposition (SVD)

svd_res <- svd(Z)

U <- svd_res$u
V <- svd_res$v
D <- diag(svd_res$d)

Koordinat Profil Baris & Kolom

# Koordinat baris
F <- solve(sqrt(Dr)) %*% U %*% D
rownames(F) <- rownames(X)

# Koordinat kolom
G <- solve(sqrt(Dc)) %*% V %*% D
rownames(G) <- colnames(X)

F
##             [,1]        [,2]        [,3]         [,4]
## Black -0.5045624  0.21482046 -0.05550909 5.663736e-17
## Brown -0.1482527 -0.03266635  0.04880414 5.663736e-17
## Red   -0.1295233 -0.31964240 -0.08315117 5.663736e-17
## Blond  0.8353478  0.06957934 -0.01621471 5.663736e-17
G
##             [,1]        [,2]         [,3]          [,4]
## Brown -0.4921577  0.08832151 -0.021611305 -5.663736e-17
## Blue   0.5474139  0.08295428  0.004709408 -5.663736e-17
## Hazel -0.2125969 -0.16739109  0.100518284 -5.663736e-17
## Green  0.1617534 -0.33903957 -0.087597437 -5.663736e-17

Visualisasi Berdasarkan Koordinat Profil

plot(
  F[,1], F[,2],
  xlab = "Dimensi 1",
  ylab = "Dimensi 2",
  pch = 19,
  xlim = range(c(F[,1], G[,1])),
  ylim = range(c(F[,2], G[,2]))
)

text(F[,1], F[,2], labels = rownames(F), pos = 3)

points(G[,1], G[,2], pch = 17)
text(G[,1], G[,2], labels = rownames(G), pos = 3)

abline(h = 0, v = 0, lty = 2)

Plot dua dimensi memperlihatkan kedekatan antara kategori baris dan kolom. Kategori yang posisinya berdekatan memiliki pola kemunculan yang serupa, sedangkan kategori yang berjauhan menunjukkan hubungan yang lemah atau berlawanan.

Penyelesaian dengan R

tbl <- margin.table(HairEyeColor, c(1,2))
tbl
##        Eye
## Hair    Brown Blue Hazel Green
##   Black    68   20    15     5
##   Brown   119   84    54    29
##   Red      26   17    14    14
##   Blond     7   94    10    16
chisq.test(tbl)
## 
##  Pearson's Chi-squared test
## 
## data:  tbl
## X-squared = 138.29, df = 9, p-value < 2.2e-16

Hasil uji chi-square menghasilkan p-value < 0.05, sehingga hipotesis independensi ditolak. Artinya, terdapat hubungan signifikan antara warna rambut dan warna mata.

library(FactoMineR)
## Warning: package 'FactoMineR' was built under R version 4.4.3
ca_res <- CA(tbl, graph = FALSE)

Analisis Korespondensi mereduksi data kategorik menjadi beberapa dimensi. Dua dimensi pertama menjelaskan proporsi variasi terbesar dari hubungan antara warna rambut dan warna mata.

library(factoextra)
## Warning: package 'factoextra' was built under R version 4.4.3
## Loading required package: ggplot2
## Warning: package 'ggplot2' was built under R version 4.4.3
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
fviz_ca_biplot(ca_res, repel = TRUE)

Biplot memperlihatkan posisi kategori warna rambut dan warna mata dalam ruang dua dimensi. Kategori yang posisinya berdekatan menunjukkan asosiasi yang kuat, sedangkan kategori yang berjauhan menunjukkan hubungan yang lemah.