Pengantar

Analisis korespondensi merupakan metode analisis multivariat yang digunakan untuk mengeksplorasi serta mengkaji keterkaitan antar peubah kualitatif melalui proses reduksi dimensi dan pemetaan ke dalam ruang dua dimensi. Metode ini memiliki prinsip yang serupa dengan analisis komponen utama, namun penerapannya ditujukan untuk data kategorik yang disajikan dalam bentuk tabel kontingensi. Analisis korespondensi bertujuan untuk mengidentifikasi dan menjelaskan pola hubungan antara dua variabel pada data berdimensi besar, sekaligus membantu dalam menemukan pengelompokan individu yang memiliki karakteristik yang relatif homogen.

Data yang saya gunakan merupakan data dari data bangkitan, yang di mana data ini menggunakan empat digit angkat terakhir dari NIM saya sendiri, yaitu 1012

Library

library(FactoMineR)
library(factoextra)
library(gplots)
library(ggplot2)

Import Data

Data ini terdiri dari - Ada 3 Tingkat Pendapatan (<3 Juta, 3-5 Juta, dan >5 Juta) - Ada 4 Tingkat Kepuasan (Sangat Tidak Puas, Tidak Puas, Puas, dan Sangat Puas)

set.seed(1012)

pendapatan <- factor(rep(c("<3 Juta", "3–5 Juta", ">5 Juta"), each = 80))
kepuasan <- factor(sample(
  c("Sangat Tidak Puas", "Tidak Puas", "Puas", "Sangat Puas"),
  size = 240,
  replace = TRUE,
  prob = c(0.15, 0.25, 0.35, 0.25)
))

data_bangkitan <- data.frame(pendapatan, kepuasan)
head(data_bangkitan)
##   pendapatan    kepuasan
## 1    <3 Juta        Puas
## 2    <3 Juta  Tidak Puas
## 3    <3 Juta  Tidak Puas
## 4    <3 Juta Sangat Puas
## 5    <3 Juta        Puas
## 6    <3 Juta  Tidak Puas

Tabel Kontingensi

table_count <- table(data_bangkitan$pendapatan,
                     data_bangkitan$kepuasan)
table_count
##           
##            Puas Sangat Puas Sangat Tidak Puas Tidak Puas
##   <3 Juta    26          23                13         18
##   >5 Juta    32          21                 8         19
##   3–5 Juta   32          13                16         19

Tabel Korespondensi

n <- sum(table_count)
table_coresp <- table_count/n
table_coresp
##           
##                  Puas Sangat Puas Sangat Tidak Puas Tidak Puas
##   <3 Juta  0.10833333  0.09583333        0.05416667 0.07500000
##   >5 Juta  0.13333333  0.08750000        0.03333333 0.07916667
##   3–5 Juta 0.13333333  0.05416667        0.06666667 0.07916667

Vektor Kolom dan Baris

Vektor Kolom

c <- colSums(table_coresp)
c
##              Puas       Sangat Puas Sangat Tidak Puas        Tidak Puas 
##         0.3750000         0.2375000         0.1541667         0.2333333

Vektor Baris

r <- rowSums(table_coresp)
r
##   <3 Juta   >5 Juta  3–5 Juta 
## 0.3333333 0.3333333 0.3333333

Matriks Kolom dan Matriks Baris

Matriks Kolom

Dc <- diag(c)
Dc
##       [,1]   [,2]      [,3]      [,4]
## [1,] 0.375 0.0000 0.0000000 0.0000000
## [2,] 0.000 0.2375 0.0000000 0.0000000
## [3,] 0.000 0.0000 0.1541667 0.0000000
## [4,] 0.000 0.0000 0.0000000 0.2333333

Matriks Baris

Dr <- diag(r)
Dr
##           [,1]      [,2]      [,3]
## [1,] 0.3333333 0.0000000 0.0000000
## [2,] 0.0000000 0.3333333 0.0000000
## [3,] 0.0000000 0.0000000 0.3333333

Analisis Profil Baris

Profil baris dapat diperoleh menggunakan rumus: \[ R = D_r^{-1} P \]

R <- solve(Dr)%*%table_coresp
rownames(R) <- rownames(table_coresp)
R
##           
##             Puas Sangat Puas Sangat Tidak Puas Tidak Puas
##   <3 Juta  0.325      0.2875            0.1625     0.2250
##   >5 Juta  0.400      0.2625            0.1000     0.2375
##   3–5 Juta 0.400      0.1625            0.2000     0.2375
  • Pada kolom Puas, dapat dilihat pada pendapatan 3-5 Juta dan >5 Juta mempunyai nilai tertinggi, yaitu 0.400. Hal ini menunjukkan bahwa kebanyakan orang sudah merasa puas pada pendapatan 3-5 Juta dan >5 Juta.
  • Pada kolom Sangat Puas, dapat dilihat pada pendapatan <3 Juta mempunyai nilai tertinggi, yaitu 0.2875. Yang menunjukkan bahwa kebanyakan orang merasa sangat puas terhadap pendapatan yang mereka miliki
  • Pada kolom Sangat Tidak Puas, dapat dilihat pada pendapatan 3-5 Juta mempunyai nilai tertinggi, yaitu 0.2000. Yang menunjukkan bahwa kebanyakan orang merasa sangat tidak puas jika memiliki pendapatan 3-5 Juta
  • Pada kolom Tidak Puas, dapat dilihat pada pendapatan 3-5 Juta dan >5 Juta mempunyai nilai tertinggi, yaitu 0.2375. Yang berarti menunjukkan bahwa kebanyakan orang merasa tidak puas dengan pendapatan yagn mereka miliki
mass_c <- colSums(R)
mass_c
##              Puas       Sangat Puas Sangat Tidak Puas        Tidak Puas 
##            1.1250            0.7125            0.4625            0.7000

Nilai massa terbesar adalah 1.1250 terdapat pada kolom Puas

Analisis Profil Kolom

Profil kolom dapat diperoleh dengan rumus: \[ C = P D_c^{-1} \]

C <- table_coresp %*% solve(Dc)
colnames(C) <- colnames(table_coresp)
C
##           
##                 Puas Sangat Puas Sangat Tidak Puas Tidak Puas
##   <3 Juta  0.2888889   0.4035088         0.3513514  0.3214286
##   >5 Juta  0.3555556   0.3684211         0.2162162  0.3392857
##   3–5 Juta 0.3555556   0.2280702         0.4324324  0.3392857
  • Pada kolom Puas, dapat dilihat pada pendapatan 3-5 Juta dan >5 Juta mempunyai nilai tertinggi, yaitu 0.3555556. Hal ini menunjukkan bahwa kebanyakan orang sudah merasa puas pada pendapatan 3-5 Juta dan >5 Juta.
  • Pada kolom Sangat Puas, dapat dilihat pada pendapatan <3 Juta mempunyai nilai tertinggi, yaitu 0.4035088. Yang menunjukkan bahwa kebanyakan orang merasa sangat puas terhadap pendapatan yang mereka miliki
  • Pada kolom Sangat Tidak Puas, dapat dilihat pada pendapatan 3-5 Juta mempunyai nilai tertinggi, yaitu 0.4324324. Yang menunjukkan bahwa kebanyakan orang merasa sangat tidak puas jika memiliki pendapatan 3-5 Juta
  • Pada kolom Tidak Puas, dapat dilihat pada pendapatan 3-5 Juta dan >5 Juta mempunyai nilai tertinggi, yaitu 0.3392857. Yang berarti menunjukkan bahwa kebanyakan orang merasa tidak puas dengan pendapatan yagn mereka miliki
mass_r <- rowSums(C)
mass_r
##  <3 Juta  >5 Juta 3–5 Juta 
## 1.365178 1.279479 1.355344

Nilai massa terbesar adalah 1.365178 terdapat pada pendapatan <3 Juta

Menentukan Koordinat Profil Baris dan Kolom

Koordinat baris dan kolom yang ditentukan menggunakan GSVD melalui matriks: \[ P - r c' \]

Prc <- table_coresp - r%*%t(c)
Prc
##           
##                    Puas  Sangat Puas Sangat Tidak Puas   Tidak Puas
##   <3 Juta  -0.016666667  0.016666667       0.002777778 -0.002777778
##   >5 Juta   0.008333333  0.008333333      -0.018055556  0.001388889
##   3–5 Juta  0.008333333 -0.025000000       0.015277778  0.001388889

Matriks Z dapat diperoleh melalui:

Z <- diag(1/sqrt(diag(Dr)))%*%Prc%*%diag(1/sqrt(diag(Dc)))
Z
##             [,1]        [,2]        [,3]         [,4]
## [1,] -0.04714045  0.05923489  0.01225358 -0.009960238
## [2,]  0.02357023  0.02961744 -0.07964825  0.004980119
## [3,]  0.02357023 -0.08885233  0.06739467  0.004980119
Du <- diag(sqrt(eigen(Z %*% t(Z))$values))[1:2,1:2]
Du
##           [,1]       [,2]
## [1,] 0.1404473 0.00000000
## [2,] 0.0000000 0.08410376

Dari matriks Z, dicari matriks U (vektor ciri dari matriks ZZ’) dan matriks V (vektor ciri dari matriks Z’Z)

U <- eigen(Z %*% t(Z))$vectors
U
##            [,1]       [,2]       [,3]
## [1,]  0.3161682  0.7527977 -0.5773503
## [2,]  0.4938578 -0.6502085 -0.5773503
## [3,] -0.8100260 -0.1025892 -0.5773503
A <- (sqrt(Dr) %*% U)[,1:2]
A
##            [,1]       [,2]
## [1,]  0.1825398  0.4346280
## [2,]  0.2851290 -0.3753981
## [3,] -0.4676687 -0.0592299
V <- eigen(t(Z) %*% Z)$vectors
V
##             [,1]       [,2]       [,3]      [,4]
## [1,] -0.15918047  0.6329186  0.7576777 0.0000000
## [2,]  0.74994468 -0.4096091  0.4997187 0.1417200
## [3,] -0.64118123 -0.6432349  0.4026142 0.1141812
## [4,] -0.03363301  0.1337285 -0.1187747 0.9832996
B <- (sqrt(Dc) %*% V)[,1:2]
B
##             [,1]        [,2]
## [1,] -0.09747773  0.38758193
## [2,]  0.36547783 -0.19961877
## [3,] -0.25175381 -0.25256015
## [4,] -0.01624629  0.06459699

Koordinat Baris

rows <- solve(Dr)%*%A%*%Du
rows
##             [,1]        [,2]
## [1,]  0.07691164  0.10966153
## [2,]  0.12013676 -0.09471716
## [3,] -0.19704840 -0.01494437

Koordinat Kolom

cols <- solve(Dc)%*%B%*%Du
cols
##              [,1]        [,2]
## [1,] -0.036507954  0.08692559
## [2,]  0.216127862 -0.07068922
## [3,] -0.229350081 -0.13778113
## [4,] -0.009778916  0.02328364

Visualisasi Berdasarkan Koordinat Profil Baris dan Kolom

row_df <- data.frame(rows)
col_df <- data.frame(cols)
colnames(row_df) <- c("Dim.1", "Dim.2")
rownames(row_df) <- rownames(table_count)
colnames(col_df) <- c("Dim.1", "Dim.2")
rownames(col_df) <- colnames(table_count)
row_df["Var"] <- "Pendapatan"
row_df["Size"] <- 2
col_df["Var"] <- "Tingkat Kepuasan"
col_df["Size"] <- 2
ca.plot.df <- rbind(col_df, row_df)
ca.plot.df["Label"] <- rownames(ca.plot.df)
ca.plot.df
##                          Dim.1       Dim.2              Var Size
## Puas              -0.036507954  0.08692559 Tingkat Kepuasan    2
## Sangat Puas        0.216127862 -0.07068922 Tingkat Kepuasan    2
## Sangat Tidak Puas -0.229350081 -0.13778113 Tingkat Kepuasan    2
## Tidak Puas        -0.009778916  0.02328364 Tingkat Kepuasan    2
## <3 Juta            0.076911643  0.10966153       Pendapatan    2
## >5 Juta            0.120136762 -0.09471716       Pendapatan    2
## 3–5 Juta          -0.197048405 -0.01494437       Pendapatan    2
##                               Label
## Puas                           Puas
## Sangat Puas             Sangat Puas
## Sangat Tidak Puas Sangat Tidak Puas
## Tidak Puas               Tidak Puas
## <3 Juta                     <3 Juta
## >5 Juta                     >5 Juta
## 3–5 Juta                   3–5 Juta
library(ggplot2)
p <- ggplot(ca.plot.df, aes(x = Dim.1, y = Dim.2,
                       col = Var, shape = Var,
                       label = Label, size = Size)) +
  geom_vline(xintercept = 0, lty = "dashed", alpha = .5) +
  geom_hline(yintercept = 0, lty = "dashed", alpha = .5) +
  geom_point() + geom_text(check_overlap = T, hjust=-0.15)

plot(p)

Penyelesaian dengan R

Untuk menyelesaikan analisis korespondensi dengan R, data yang digunakan adalah data yang telah direpresentasikan pada tabel kontingensi, sebagaimana yang tersimpan pada objek table_count. Package yang digunakan adalah FactoMineR dengan fungsi CA(), serta visualisasi menggunakan factoextra.

table_count
##           
##            Puas Sangat Puas Sangat Tidak Puas Tidak Puas
##   <3 Juta    26          23                13         18
##   >5 Juta    32          21                 8         19
##   3–5 Juta   32          13                16         19

Eksplorasi Data

balloonplot(table_count, main ="Tabel Kontingensi Pendapatan x Tingkat Kepuasan", xlab ="", ylab="", label = FALSE, show.margins = FALSE)

Semakin besar lingakran, menunjukkan semakin besar pula nilai yang direpresentasikan

chisq <- chisq.test(table_count)
chisq
## 
##  Pearson's Chi-squared test
## 
## data:  table_count
## X-squared = 6.4317, df = 6, p-value = 0.3766

Dari hasil uji Khi-Kuadrat, bahwa kedua peubah tidak terkait secara signifikan

kepuasan <- CA(table_count, graph = F)
print(kepuasan)
## **Results of the Correspondence Analysis (CA)**
## The row variable has  3  categories; the column variable has 4 categories
## The chi square of independence between the two variables is equal to 6.431731 (p-value =  0.3766024 ).
## *The results are available in the following objects:
## 
##    name              description                   
## 1  "$eig"            "eigenvalues"                 
## 2  "$col"            "results for the columns"     
## 3  "$col$coord"      "coord. for the columns"      
## 4  "$col$cos2"       "cos2 for the columns"        
## 5  "$col$contrib"    "contributions of the columns"
## 6  "$row"            "results for the rows"        
## 7  "$row$coord"      "coord. for the rows"         
## 8  "$row$cos2"       "cos2 for the rows"           
## 9  "$row$contrib"    "contributions of the rows"   
## 10 "$call"           "summary called parameters"   
## 11 "$call$marge.col" "weights of the columns"      
## 12 "$call$marge.row" "weights of the rows"

Akar/Vektor Ciri

eig.val <- get_eigenvalue(kepuasan)
eig.val
##        eigenvalue variance.percent cumulative.variance.percent
## Dim.1 0.019725439         73.60546                    73.60546
## Dim.2 0.007073442         26.39454                   100.00000

Presentase Keragaman

fviz_screeplot(kepuasan, addlabels = TRUE)

Analisis dan Visualisasi Profil Baris

row <- get_ca_row(kepuasan)
row
## Correspondence Analysis - Results for rows
##  ===================================================
##   Name       Description                
## 1 "$coord"   "Coordinates for the rows" 
## 2 "$cos2"    "Cos2 for the rows"        
## 3 "$contrib" "contributions of the rows"
## 4 "$inertia" "Inertia of the rows"
row$coord
##                Dim 1       Dim 2
## <3 Juta  -0.07691164  0.10966153
## >5 Juta  -0.12013676 -0.09471716
## 3–5 Juta  0.19704840 -0.01494437
row$contrib
##             Dim 1     Dim 2
## <3 Juta   9.99623 56.670437
## >5 Juta  24.38956 42.277109
## 3–5 Juta 65.61421  1.052454

Profil baris yang berkontribusi paling banyak kepada Dim 1 dan Dim 2 adalah baris yang paling penting dalam menjelaskan keragaman data. Dalam hal ini, responden berpendapatan 3-5 Juta dan <3 Juta dianggap sebagai responden yang menyumbang keragaman paling besar.

fviz_ca_row(kepuasan, col.row="steelblue", shape.row = 15)

Analisis dan Visualisasi Profil Kolom

col <- get_ca_col(kepuasan)
col
## Correspondence Analysis - Results for columns
##  ===================================================
##   Name       Description                   
## 1 "$coord"   "Coordinates for the columns" 
## 2 "$cos2"    "Cos2 for the columns"        
## 3 "$contrib" "contributions of the columns"
## 4 "$inertia" "Inertia of the columns"
col$coord
##                          Dim 1       Dim 2
## Puas               0.036507954 -0.08692559
## Sangat Puas       -0.216127862  0.07068922
## Sangat Tidak Puas  0.229350081  0.13778113
## Tidak Puas         0.009778916 -0.02328364

Profil kolom yang berkontribusi paling banyak kepada Dim 1 dan Dim 2 adalah baris yang paling penting dalam menjelaskan keragaman data. Dalam hal ini, Tingkat Kepuasan Sangat Tidak Puas dianggap sebagai stasiun TV yang menyumbang keragaman paling besar.

col$contrib
##                       Dim 1    Dim 2
## Puas               2.533842 40.05860
## Sangat Puas       56.241702 16.77796
## Sangat Tidak Puas 41.111337 41.37511
## Tidak Puas         0.113118  1.78833
fviz_ca_col(kepuasan, col.col="steelblue", shape.col = 15)

Pembentukan Plot Korespondensi

fviz_ca_biplot(kepuasan, repel = TRUE)

  • Plot gambar di atas, menunjukkan bagaimana korelasi antara pendapatan dengan tikat kepuasan pendapatan
  • terlihat bahwa pendapatan dan tingkat kepuasan pendapatan tidak saling berdekatan, yang menunjukkan bahwasanya tingkat kepuasan pendapatan dan pendapatan tidak memiliki hubungan