P12 TPG

Denanda Aufadlan & Annisa Permata

2025-04-19

Analisis Korespondensi / Correspondence Analysis

Pengantar

Analisis korespondensi diawali dengan tulisan Hartley pada tahun 1935. Selanjutnya pengembangan analisis ini dilakukan oleh beberapa pakar, baik secara bersama-sama maupun secara terpisah dengan pendekatan dan bidang-bidang terapan yang berlainan. Pendekatan secara geometrik mula-mula dilakukan di Prancis dengan tokohnya antara lain Benzecri (Greenacre, 1984 dalam Damayanti, 1992). Sejalan dengan ini Johnson (2007) mengatakan analisis korespondensi dikembangkan oleh tokoh-tokoh Perancis yang merupakan prosedur grafis untuk mewakili asosiasi dalam tabel frekuensi atau jumlah. Tabel frekuensi yang akan dibahas adalah tabel frekuensi dua arah atau yang disebut tabel kontingensi.

Analisis korespondensi merupakan sebuah teknik multivariat yang digunakan untuk mengeksplorasi dan mempelajari hubungan peubah-peubah kualitatif dengan cara mereduksi dimensi dan memetakannya ke dalam grafik dua dimensi. Konsepnya mirip dengan analisis komponen utama, namun digunakan pada peubah kategorik yang direpresentasikan pada tabel kontingensi. Analisis korespondensi digunakan untuk mendeteksi dan memberikan penjelasan tentang hubungan antara dua variabel di dalam data yang berbentuk matriks berdimensi besar dan dapat digunakan untuk mencari pengelompokan yang homogen dari individu.

Beberapa unsur-unsur yang ada dalam analisis korespondensi antara lain:

  1. Tabel kontingensi, yaitu data dasar tabel yang menggambarkan frekuensi pengamatan untuk kombinasi dua atau lebih peubah kategorik.
  2. Koordinat korespondensi, di mana setiap peubah kategorik memiliki nilai koordinat dalam ruang dimensi rendah yang direpresentasikan oleh analisis korespondensi. Koordinat ini mencerminkan hubungan antar peubah.
  3. Singular value. Analisis korespondensi melibatkan dekomposisi nilai tunggal dari matriks frekuensi dalam tabel kontingensi. Nilai-nilai tunggal ini membantu mengidentifikasi dimensi utama yang mencakup variasi dalam data.
  4. Skor korespondensi, yaitu nilai proyeksi dari data asli ke ruang dimensi rendah yang dihasilkan oleh analisis korespondensi yang digunakan untuk memahami posisi relatif dari kategori dalam dimensi yang lebih rendah.
  5. Inersia adalah ukuran variasi dalam data yang dijelaskan oleh dimensi-dimensi yang dihasilkan oleh analisis korespondensi. Inersia membantu mengevaluasi seberapa baik dimensi tersebut menjelaskan pola dalam data.

Kelebihan dan Kekurangan

Analisis korespondensi juga memiliki kelebihan bila dibandingkan dengan analisis lainya, yaitu:

  1. Sangat tepat untuk menganalisis data variabel kategori ganda yang dapat digambarkan secara sederhana dalam data tabulasi silang.
  2. Tidak hanya menggambarkan hubungan antar baris dengan kolom tetapi juga antar kategori dalam setiap baris dan kolom.
  3. Memberikan tampilan grafik gabungan dari kategori baris dan kolom dalam satu gambar yang berdimensi dua.
  4. Cukup fleksibel untuk digunakan dalam data matrik berukuran besar.

Selain itu, analisis korespondensi memiliki beberapa kekurangan antara lain:

  1. Analisis ini tidak cocok untuk pengujian hipotesis tetapi sangat tepat untuk eksplorasi data.
  2. Tidak mempunyai suatu metode khusus untuk menentukan atau memutuskan jumlah dimensi yang tepat.

Asumsi

Beberapa asumsi yang mendasari analisis korespondensi:

  1. Ukuran jarak Khi-kuadrat (\({\chi}^2\)) antar titik-titik (nilai kategori) analogi dengan konsep korelasi antar variabel.
  2. Variabel kolom yang tepat di variabel kategori baris diasumsikan homogen.
  3. Analisis korespondensi adalah sebuah teknik nonparametrik yang tidak memerlukan pengujian asumsi seperti kenormalan, autokorelasi, multikolinieritas, heteroskedastisitas, linieritas sebelum melakukan analisis selanjutnya.
  4. Dimensi yang terbentuk dalam analisis korespondensi disebabkan dari kontribusi titik-titik dari dimensi yang terbentuk dan penamaan dari dimensinya subjektif dari kebijakan, pendapat, dan error.
  5. Dalam analisis korespondensi variabel yang digunakan yaitu variabel diskrit (nominal/ordinal) yang mempunyai banyak kategori.

Langkah-Langkah

Beberapa langkah yang dilakukan untuk membentuk plot korespondensi antara lain:

  1. Siapkan data, kemudian bentuk tabel kontingensi.
  2. Berdasarkan tabel kontingensi, bentuk tabel korespondensi dengan cara membagi masing-masing nilai dalam tabel kontingensi dengan n (banyak amatan).
  3. Bentuk vektor baris, vektor kolom, matriks baris, dan matriks kolom berdasarkan tabel korespondensi yang telah dibuat.
  4. Lakukan analisis profil baris dengan membagi proporsi/frekuensi masing-masing elemen dengan total proporsi/frekuensi masing-masing baris.
  5. Lakukan analisis profil kolom dengan membagi proporsi/frekuensi masing-masing elemen dengan total proporsi/frekuensi masing-masing kolom.
  6. Tentukan koordinat profil baris dan kolom dengan menggunakan Generalized SVD.
  7. Bentuk plot korespondensi berdasarkan koordinat yang diperoleh.

Studi Kasus 1 - Data Stasiun TV

  • Suatu survei dilakukan untuk mengetahui stasiun TV favorit menurut pemirsa dengan kelompok usia tertentu.
  • Ada 5 stasiun TV yang menjadi pilihan di dalam survei, yaitu MetroTV, Indosiar, NETTV, TransTV, dan RCTI.
  • Sementara respondennya, dikelompokkan dalam 4 kelompok umur, yaitu > 50 th, 40-50 th, 20-39 th, dan 10-19 th.

Import Data

stasiun_tv <- read.csv("Data Analisis Korespondensi.csv", sep = ";")
stasiun_tv
##        Usia Stasiun.TV Jumlah
## 1   > 50 th    MetroTV    326
## 2  40-50 th    MetroTV    688
## 3  20-39 th    MetroTV    343
## 4  10-19 th    MetroTV     98
## 5   > 50 th   Indosiar     38
## 6  40-50 th   Indosiar    116
## 7  20-39 th   Indosiar     84
## 8  10-19 th   Indosiar     48
## 9   > 50 th      NETTV    241
## 10 40-50 th      NETTV    584
## 11 20-39 th      NETTV    909
## 12 10-19 th      NETTV    403
## 13  > 50 th    TransTV    110
## 14 40-50 th    TransTV    188
## 15 20-39 th    TransTV    412
## 16 10-19 th    TransTV    681
## 17  > 50 th       RCTI      3
## 18 40-50 th       RCTI      4
## 19 20-39 th       RCTI     26
## 20 10-19 th       RCTI     85

Penyelesaian Manual

  1. Tabel Kontingensi

    Dari data yang terbentuk, dapat kita bentuk tabel kontingensi sebagai berikut:

    stasiun_tv$Usia <- factor(stasiun_tv$Usia, levels=c("> 50 th", "40-50 th",
                                                    "20-39 th", "10-19 th"))
stasiun_tv$Stasiun.TV <- factor(stasiun_tv$Stasiun.TV,
                                levels=c("MetroTV", "Indosiar",
                                         "NETTV","TransTV","RCTI"))
table_count <- xtabs(Jumlah ~ Usia + Stasiun.TV, data = stasiun_tv)
table_count
    ##           Stasiun.TV
## Usia       MetroTV Indosiar NETTV TransTV RCTI
##   > 50 th      326       38   241     110    3
##   40-50 th     688      116   584     188    4
##   20-39 th     343       84   909     412   26
##   10-19 th      98       48   403     681   85

  2. Tabel Korespondensi

    n <- sum(table_count)
table_coresp <- table_count/n
table_coresp
    ##           Stasiun.TV
## Usia            MetroTV     Indosiar        NETTV      TransTV         RCTI
##   > 50 th  0.0605160572 0.0070540189 0.0447373306 0.0204195285 0.0005568962
##   40-50 th 0.1277148691 0.0215333210 0.1084091331 0.0348988305 0.0007425283
##   20-39 th 0.0636718025 0.0155930945 0.1687395582 0.0764804158 0.0048264340
##   10-19 th 0.0181919436 0.0089103397 0.0748097271 0.1264154446 0.0157787266

  3. Vektor kolom dan vektor baris

    Berdasarkan matriks korespondensi yang terbentuk, diperoleh vektor kolom dan vektor baris berikut:

    c <- colSums(table_coresp)
c
    ##    MetroTV   Indosiar      NETTV    TransTV       RCTI 
## 0.27009467 0.05309077 0.39669575 0.25821422 0.02190459
    r <- rowSums(table_coresp)
r
    ##   > 50 th  40-50 th  20-39 th  10-19 th 
## 0.1332838 0.2932987 0.3293113 0.2441062

  4. Matriks kolom dan matriks baris

    Dc <- diag(c)
Dc
    ##           [,1]       [,2]      [,3]      [,4]       [,5]
## [1,] 0.2700947 0.00000000 0.0000000 0.0000000 0.00000000
## [2,] 0.0000000 0.05309077 0.0000000 0.0000000 0.00000000
## [3,] 0.0000000 0.00000000 0.3966957 0.0000000 0.00000000
## [4,] 0.0000000 0.00000000 0.0000000 0.2582142 0.00000000
## [5,] 0.0000000 0.00000000 0.0000000 0.0000000 0.02190459
    Dr <- diag(r)
Dr
    ##           [,1]      [,2]      [,3]      [,4]
## [1,] 0.1332838 0.0000000 0.0000000 0.0000000
## [2,] 0.0000000 0.2932987 0.0000000 0.0000000
## [3,] 0.0000000 0.0000000 0.3293113 0.0000000
## [4,] 0.0000000 0.0000000 0.0000000 0.2441062

  5. Analisis profil baris

    Profil baris diperoleh dengan:

    \[R = Dr^{-1}P\]

    R <- solve(Dr)%*%table_coresp
rownames(R) <- rownames(table_coresp)
R
    ##           Stasiun.TV
##               MetroTV   Indosiar     NETTV   TransTV        RCTI
##   > 50 th  0.45403900 0.05292479 0.3356546 0.1532033 0.004178273
##   40-50 th 0.43544304 0.07341772 0.3696203 0.1189873 0.002531646
##   20-39 th 0.19334837 0.04735062 0.5124014 0.2322435 0.014656144
##   10-19 th 0.07452471 0.03650190 0.3064639 0.5178707 0.064638783
    • Pada kolom MetroTV, dapat dilihat bahwa baris usia >50 tahun mempunyai nilai tertinggi (0.454). Hal ini menunjukkan bahwa stasiun METRO TV menjadi stasiun TV favorit pemirsa yang berusia > 50 tahun.
    • Pada kolom Indosiar, dapat dilihat bahwa pemirsa dengan rentang usia 40-50 tahun memiliki nilai tertinggi (0.0734). Hal ini menunjukkan bahwa stasiun Indosiar menjadi stasiun TV favorit pemirsa yang berusia 40- 50 tahun.
    • Pada kolom NETTV, dapat dilihat bahwa baris usia 20-39 tahun memiliki nilai tertingggi (0.5124). Hal ini menunjukkan bahwa statiun NETTV menjadi stasiun TV favorit untuk pemirsa pada rentang usia 20-39 tahun.
    • Pada kolom TransTV dan RCTI, dapat dilihat bahwa usia 10-19 tahun memiliki nilai tertinggi (0.0646 dan 0.5179). Hal ini menunjukkan bahwa kedua stasiun televisi ini menjadi stasiun TV favorit pemirsa pada rentang usia 10-19 tahun.

    Kemudian diperoleh nilai massa setiap kolom sebagai berikut:

    mass_c <- colSums(R)
mass_c
    ##    MetroTV   Indosiar      NETTV    TransTV       RCTI 
## 1.15735512 0.21019503 1.52414008 1.02230492 0.08600485

    Nilai massa terbesar adalah 1.52414 terdapat pada kolom stasiun televisi NETTV, masih sama dengan modus amatan yang kita peroleh pada data awal.

  6. Analisis profil kolom

    Profil baris diperoleh dengan:

    \[C = P Dc^{-1}\]

    C <- table_coresp %*% solve(Dc)
colnames(C) <- colnames(table_coresp)
C
    ##           
## Usia          MetroTV  Indosiar     NETTV   TransTV       RCTI
##   > 50 th  0.22405498 0.1328671 0.1127749 0.0790798 0.02542373
##   40-50 th 0.47285223 0.4055944 0.2732803 0.1351546 0.03389831
##   20-39 th 0.23573883 0.2937063 0.4253627 0.2961898 0.22033898
##   10-19 th 0.06735395 0.1678322 0.1885821 0.4895758 0.72033898
    • Usia pada kategori > 50 tahun dan 40-50 tahun, mempunyai massa terbesar pada stasiun televisi MetroTV yaitu 0.2240 dan 0.4729. Hal ini menunjukkan bahwa usia terbanyak yang sering menonton METRO TV adalah pemirsa pada usia > 50 tahun dan 40-50 tahun.
    • Usia pada kategori 20-39 tahun, mempunyai massa terbesar pada stasiun televisi NETTV yaitu 0.4254. Hal ini menunjukkan bahwa usia terbanyak yang sering menonton NET TV adalah pemirsa pada usia 20-39 tahun.
    • Usia pada kategori 10-19 tahun, mempunyai massa terbesar pada stasiun televisi RCTI yaitu 0.7203. Hal ini menunjukkan bahwa usia terbanyak yaang sering menonton RCTI adalah pemirsa pada usia 10-19 tahun.

    Kemudian diperoleh nilai massa setiap baris sebagai berikut:

    mass_r <- rowSums(C)
mass_r
    ##   > 50 th  40-50 th  20-39 th  10-19 th 
## 0.5742006 1.3207798 1.4713366 1.6336831

    Nilai massa terbesar adalah 1.633683 terdapat pada usia kategori 10-19 tahun, jadi berbeda dengan modus amatan yang diperoleh pada data awal yaitu pada kategori usia 20-39 tahun.

  7. Menentukan koordinat profil baris dan kolom

    Koordinat baris dan kolom yang ditentukan menggunakan GSVD melalui matriks:

    \[P-rc'\]

    Prc <- table_coresp - r%*%t(c)
Prc
    ##           Stasiun.TV
## Usia             MetroTV      Indosiar         NETTV       TransTV
##   > 50 th   2.451680e-02 -2.212285e-05 -8.135799e-03 -1.399625e-02
##   40-50 th  4.849646e-02  5.961867e-03 -7.941207e-03 -4.083506e-02
##   20-39 th -2.527343e-02 -1.890298e-03  3.810316e-02 -8.552446e-03
##   10-19 th -4.773984e-02 -4.049446e-03 -2.202616e-02  6.338376e-02
##           Stasiun.TV
## Usia                RCTI
##   > 50 th  -2.362631e-03
##   40-50 th -5.682058e-03
##   20-39 th -2.386994e-03
##   10-19 th  1.043168e-02

    Kemudian matriks Z diperoleh melalui:

    Z <- diag(1/sqrt(diag(Dr)))%*%Prc%*%diag(1/sqrt(diag(Dc)))
Z
    ##            [,1]          [,2]        [,3]        [,4]        [,5]
## [1,]  0.1292162 -0.0002629922 -0.03538203 -0.07544543 -0.04372599
## [2,]  0.1723046  0.0477768696 -0.02328106 -0.14838434 -0.07088969
## [3,] -0.0847428 -0.0142960921  0.10542144 -0.02932898 -0.02810479
## [4,] -0.1859232 -0.0355710546 -0.07078163  0.25246345  0.14265843
    Du <- diag(sqrt(eigen(Z %*% t(Z))$values))[1:2,1:2]
Du
    ##           [,1]      [,2]
## [1,] 0.4463684 0.0000000
## [2,] 0.0000000 0.1734554

    Kemudian dari matriks Z yang sudah diperoleh, dicari matriks U (vektor ciri dari ZZ’) dan matriks V (vektor ciri dari matriks Z’Z).

    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
    ## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
    U <- eigen(Z %*% t(Z))$vectors
U
    ##             [,1]       [,2]        [,3]      [,4]
## [1,] -0.32740153  0.3481491  0.79894718 0.3650806
## [2,] -0.53470247  0.2762034 -0.58694655 0.5415706
## [3,]  0.04321499 -0.8105596  0.10869354 0.5738565
## [4,]  0.77783929  0.3814407 -0.07323162 0.4940710
    A <- (sqrt(Dr) %*% U)[,1:2]
A
    ##            [,1]       [,2]
## [1,] -0.1195279  0.1271025
## [2,] -0.2895791  0.1495836
## [3,]  0.0247992 -0.4651449
## [4,]  0.3843079  0.1884588
    V <- eigen(t(Z) %*% Z)$vectors
V
    ##             [,1]       [,2]        [,3]       [,4]        [,5]
## [1,] -0.63337328  0.5208721  0.22198126 -0.5274987  0.00000000
## [2,] -0.12040878  0.0641327 -0.92784507 -0.1825513 -0.29524104
## [3,] -0.05929716 -0.7563782  0.06953154 -0.6464176  0.04105527
## [4,]  0.67018848  0.3045289  0.17534533 -0.4302105 -0.49222197
## [5,]  0.36286535  0.2444040 -0.23291035 -0.2923755  0.81784150
    B <- (sqrt(Dc) %*% V)[,1:2]
B
    ##             [,1]        [,2]
## [1,] -0.32916810  0.27070055
## [2,] -0.02774391  0.01477709
## [3,] -0.03734760 -0.47639565
## [4,]  0.34055482  0.15474573
## [5,]  0.05370479  0.03617228

    Koordinat baris

    rows <- solve(Dr)%*%A%*%Du
rows
    ##             [,1]        [,2]
## [1,] -0.40029985  0.16541100
## [2,] -0.44070764  0.08846303
## [3,]  0.03361434 -0.24500190
## [4,]  0.70273880  0.13391383

    Koordinat kolom

    cols <- solve(Dc)%*%B%*%Du
cols
    ##             [,1]        [,2]
## [1,] -0.54399533  0.17384449
## [2,] -0.23326097  0.04827895
## [3,] -0.04202412 -0.20830421
## [4,]  0.58870853  0.10395044
## [5,]  1.09438828  0.28643670

  8. 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"] <- "Usia"
row_df["Size"] <- 2
col_df["Var"] <- "Stasiun TV"
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    Label
## MetroTV  -0.54399533  0.17384449 Stasiun TV    2  MetroTV
## Indosiar -0.23326097  0.04827895 Stasiun TV    2 Indosiar
## NETTV    -0.04202412 -0.20830421 Stasiun TV    2    NETTV
## TransTV   0.58870853  0.10395044 Stasiun TV    2  TransTV
## RCTI      1.09438828  0.28643670 Stasiun TV    2     RCTI
## > 50 th  -0.40029985  0.16541100       Usia    2  > 50 th
## 40-50 th -0.44070764  0.08846303       Usia    2 40-50 th
## 20-39 th  0.03361434 -0.24500190       Usia    2 20-39 th
## 10-19 th  0.70273880  0.13391383       Usia    2 10-19 th
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) +
  scale_x_continuous(limits = c(-1, 1.5))

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.

library(factoextra)
library(FactoMineR)
## Warning: package 'FactoMineR' was built under R version 4.3.3
table_count
##           Stasiun.TV
## Usia       MetroTV Indosiar NETTV TransTV RCTI
##   > 50 th      326       38   241     110    3
##   40-50 th     688      116   584     188    4
##   20-39 th     343       84   909     412   26
##   10-19 th      98       48   403     681   85
Eksplorasi Data

Coba kita lakukan visualisasi dari tabel kontingensi yang terbentuk.

# install.packages("gplots") # run ini jika package belum terinstall
library(gplots)
## Warning: package 'gplots' was built under R version 4.3.3
## 
## Attaching package: 'gplots'
## The following object is masked from 'package:stats':
## 
##     lowess
balloonplot(table_count, main ="Tabel Kontingensi Stasiun TV x Usia", xlab ="", ylab="", label = FALSE, show.margins = FALSE)

Di mana semakin besar lingkaran menunjukkan semakin besar pula nilai yang direpresentasikan.

chisq <- chisq.test(table_count)
chisq
## 
##  Pearson's Chi-squared test
## 
## data:  table_count
## X-squared = 1240, df = 12, p-value < 2.2e-16

Diperoleh dari hasil uji Khi-kuadrat, bahwa kedua peubah (stasiun TV dan rentang usia) secara signifikan saling terkait.

Membentuk model Correspondence Analysis
model_tv <- CA(table_count, graph = F)

Untuk melihat objek/informasi apa saja yang terdapat dalam model, lakukan:

print(model_tv)
## **Results of the Correspondence Analysis (CA)**
## The row variable has  4  categories; the column variable has 5 categories
## The chi square of independence between the two variables is equal to 1240.039 (p-value =  4.123993e-258 ).
## *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"

Dengan menggunakan package factoextra, kita dapat memperoleh banyak informasi melalui fungsi-fungsi berikut:

  • get_eigenvalue(model), mengekstraksi nilai akar ciri.
  • fviz_screeplot(model), melakukan visualisasi presentase keragaman yang diperoleh.
  • get_ca_row(model), get_ca_col(model), melakukan analisis profil baris dan kolom.
  • fviz_ca_row(model) fviz_ca_col(model), melakukan visualisasi profil baris dan kolom.
  • fviz_ca_biplot(model) untuk melakukan visualisasi keduanya.
  1. Akar/vektor ciri
eig.val <- get_eigenvalue(model_tv)
eig.val
##         eigenvalue variance.percent cumulative.variance.percent
## Dim.1 0.1992447520       86.5562709                    86.55627
## Dim.2 0.0300867741       13.0703516                    99.62662
## Dim.3 0.0008594814        0.3733775                   100.00000
  1. Presentase keragaman
fviz_screeplot(model_tv, addlabels = TRUE)

Dapat dilihat bahwa untuk mereduksi menjadi 2 dimensi saja, kita sudah mendapatkan 99.63% keragaman dalam data.

  1. Analisis dan visualisasi profil baris
row <- get_ca_row(model_tv)
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"
  • Koordinat dari profil baris
row$coord
##                Dim 1       Dim 2        Dim 3
## > 50 th  -0.40029985  0.16541100 -0.064157519
## 40-50 th -0.44070764  0.08846303  0.031773257
## 20-39 th  0.03361434 -0.24500190 -0.005552885
## 10-19 th  0.70273880  0.13391383  0.004345377

Untuk memetakan menjadi dua dimensi, maka hanya perlu melihat Dim 1 dan Dim 2 nya saja.

  • Kontribusi keragaman profil baris
row$contrib
##               Dim 1     Dim 2     Dim 3
## > 50 th  10.7191765 12.120781 63.831659
## 40-50 th 28.5906733  7.628833 34.450625
## 20-39 th  0.1867536 65.700687  1.181429
## 10-19 th 60.5033967 14.549698  0.536287

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 berusia 10-19 tahun dan 20-39 tahun dianggap sebagai responden yang menyumbang keragaman paling besar.

  • Plot profil baris
fviz_ca_row(model_tv, col.row="steelblue", shape.row = 15)

– Baris dengan profil serupa dikelompokkan bersama.
– Baris yang berkorelasi negatif diposisikan pada sisi yang saling berlawanan (kuadran berlawanan).

  1. Analisis dan visualisasi profil kolom
col <- get_ca_col(model_tv)
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"
  • Koordinat dari profil kolom
col$coord
##                Dim 1       Dim 2        Dim 3
## MetroTV  -0.54399533  0.17384449 -0.012522082
## Indosiar -0.23326097  0.04827895  0.118054940
## NETTV    -0.04202412 -0.20830421 -0.003236468
## TransTV   0.58870853  0.10395044 -0.010116315
## RCTI      1.09438828  0.28643670  0.046135954

Untuk memetakan menjadi dua dimensi, maka hanya perlu melihat Dim 1 dan Dim 2 nya saja.

  • Kontribusi keragaman profil kolom
col$contrib
##               Dim 1      Dim 2      Dim 3
## MetroTV  40.1161707 27.1307783  4.9275678
## Indosiar  1.4498275  0.4113003 86.0896470
## NETTV     0.3516154 57.2108003  0.4834635
## TransTV  44.9152601  9.2737881  3.0745985
## RCTI     13.1671264  5.9733330  5.4247232

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

  • Plot profil kolom
fviz_ca_col(model_tv, col.col="steelblue", shape.col = 15)

  1. Pembentukan plot korespondensi
fviz_ca_biplot(model_tv, repel = TRUE)

  • Plot dalam gambar diatas, menunjukkan bagaimana korelasi antara stasiun TV favorit dengan berbagai kategori usia.
  • Terlihat bahwa usia kategori 10-19 tahun berdekatan dengan stasiun televisi RCTI dan TransTV, artinya jelas bahwa pemirsa dengan rentang usia 10-19 tahun lebih sering menonton stasiun RCTI dan TransTV dibanding stasiun televisi lainnya.
  • Kemudian pemirsa dengan kategori usia 20-39 tahun lebih sering menonton stasiun televisi NETTV.
  • Terakhir, pemirsa dengan kategori usia 40-50 tahun dan > 50 tahun lebih sering menonton stasiun televisi Indosiar dan MetroTV dibanding stasiun televisi lainnya.

Studi Kasus 2 - Data Kenyamanan Kerja x Pendapatan

Suatu data frekuensi tentang hubungan antara kenyamanan kerja dengan pendapatan yang disajikan pada tabel berikut :

  1. Import Data
df_kerja <- read.csv("https://raw.githubusercontent.com/nurkhamidah/dat/main/kenyamanan_pendapatan.csv", sep = ";")
rownames(df_kerja) <- df_kerja$X
df_kerja <- df_kerja[,-1]
df_kerja
##                Sangat.Tidak.Nyaman Kurang.Nyaman Biasa.Saja Nyaman
## < 25 jt/bln                     15            98         21     14
## 25 - 50 jt/bln                   4            49        125    250
## > 50 jt/bln                      1            13         81    300
  1. Eksplorasi dengan uji Khi-kuadrat

H0 : variabel baris dan kolom dari tabel kontingensi adalah independen. H1 : variabel baris dan kolom dependen.

chisq.test(df_kerja)
## Warning in chisq.test(df_kerja): Chi-squared approximation may be incorrect
## 
##  Pearson's Chi-squared test
## 
## data:  df_kerja
## X-squared = 421.11, df = 6, p-value < 2.2e-16

Karena diperoleh p-value < 2.2e-16 maka H0 ditolak artinya terdapat hubungan yang erat antara pendapatan dan kenyamanan pekerjaan.

  1. Analisis korespondensi

library(ca) adalah package R untuk mengaktifkan fungsi analisis korespondensi, jika belum tersedia install.packages(ca)

# install.packages("ca")
library(ca)
## Warning: package 'ca' was built under R version 4.3.3
fit <- ca(df_kerja)
summary(fit)
## 
## Principal inertias (eigenvalues):
## 
##  dim    value      %   cum%   scree plot               
##  1      0.420978  97.1  97.1  ************************ 
##  2      0.012713   2.9 100.0  *                        
##         -------- -----                                 
##  Total: 0.433691 100.0                                 
## 
## 
## Rows:
##     name   mass  qlt  inr    k=1 cor ctr    k=2 cor ctr  
## 1 | 25jt |  152 1000  795 | 1503 999 818 |  -50   1  30 |
## 2 | 2550 |  441 1000   37 | -143 570  21 |  125 430 538 |
## 3 | 50jt |  407 1000  169 | -408 925 161 | -116  75 432 |
## 
## Columns:
##     name   mass  qlt  inr    k=1  cor ctr    k=2 cor ctr  
## 1 | SnTN |   21 1000  132 | 1662  991 135 | -162   9  43 |
## 2 | KrnN |  165 1000  642 | 1300 1000 662 |  -16   0   3 |
## 3 | BsSj |  234 1000   31 | -132  304  10 |  199 696 731 |
## 4 | Nymn |  581 1000  195 | -375  966 194 |  -70  34 223 |

fit=ca(data) digunakan untuk melakukan analisis korespondensi. Diperoleh total keragaman yang dapat dijelaskan adalah sebesar 100%.

  1. Analisis profil baris dan kolom
n <- sum(df_kerja)
sum_row <- apply(df_kerja, 1, sum)
sum_row/n
##    < 25 jt/bln 25 - 50 jt/bln    > 50 jt/bln 
##      0.1524202      0.4407827      0.4067971
rows <- df_kerja/sum_row
rows
##                Sangat.Tidak.Nyaman Kurang.Nyaman Biasa.Saja     Nyaman
## < 25 jt/bln            0.101351351    0.66216216  0.1418919 0.09459459
## 25 - 50 jt/bln         0.009345794    0.11448598  0.2920561 0.58411215
## > 50 jt/bln            0.002531646    0.03291139  0.2050633 0.75949367
sum_col <- apply(df_kerja, 2, sum)
sum_col/n
## Sangat.Tidak.Nyaman       Kurang.Nyaman          Biasa.Saja              Nyaman 
##          0.02059732          0.16477858          0.23377961          0.58084449
cols <- df_kerja/sum_col
cols
##                Sangat.Tidak.Nyaman Kurang.Nyaman Biasa.Saja    Nyaman
## < 25 jt/bln            0.750000000     0.1737589 0.09251101 0.0875000
## 25 - 50 jt/bln         0.025000000     2.4500000 0.22163121 1.1013216
## > 50 jt/bln            0.004405286     0.0812500 4.05000000 0.5319149
  1. Pembentukan plot korespondensi
fit
## 
##  Principal inertias (eigenvalues):
##            1        2       
## Value      0.420978 0.012713
## Percentage 97.07%   2.93%   
## 
## 
##  Rows:
##         < 25 jt/bln 25 - 50 jt/bln > 50 jt/bln
## Mass       0.152420       0.440783    0.406797
## ChiDist    1.503706       0.189847    0.424086
## Inertia    0.344642       0.015887    0.073162
## Dim. 1     2.316299      -0.220849   -0.628579
## Dim. 2    -0.442234       1.104499   -1.031075
## 
## 
##  Columns:
##         Sangat.Tidak.Nyaman Kurang.Nyaman Biasa.Saja    Nyaman
## Mass               0.020597      0.164779   0.233780  0.580844
## ChiDist            1.669536      1.300129   0.238905  0.381200
## Inertia            0.057412      0.278531   0.013343  0.084405
## Dim. 1             2.560964      2.003652  -0.202865 -0.577577
## Dim. 2            -1.439706     -0.145368   1.768270 -0.619405
plot(fit)

  • Pekerja yang merasa Sangat tidak nyaman dan kurang nyaman dengan pekerjaannya cenderung yang memiliki pendapatan < 25juta.
  • Pendapatan diantara 25 juta hingga 50 juta cenderung merasa biasa saja terhadap pekerjaannya.
  • Pendapatan yang lebih dari 50 juta merasa Nyaman dengan pekerjaannya.