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
library(FactoMineR)
## Warning: package 'FactoMineR' was built under R version 4.4.3
library(gplots)
## Warning: package 'gplots' was built under R version 4.4.3
## 
## Attaching package: 'gplots'
## The following object is masked from 'package:stats':
## 
##     lowess
library(ca)
## Warning: package 'ca' was built under R version 4.4.3

Data

dt <- read.csv("C:/Users/Ainul Hayati/Documents/kuliah/Departemen/Semester 5/Teknik Peubah Ganda/UAS/archive/halloween_raw.csv")
halloween <- dt[, c("Have.you.ever.celebrated.Halloween.","Each.year..do.you.usually.attend.a.Halloween.party.","What.is.your.age.group.")]
halloween <- subset(
  halloween,
  Have.you.ever.celebrated.Halloween. == "Yes"
)
head(halloween)
##   Have.you.ever.celebrated.Halloween.
## 1                                 Yes
## 2                                 Yes
## 3                                 Yes
## 4                                 Yes
## 5                                 Yes
## 6                                 Yes
##   Each.year..do.you.usually.attend.a.Halloween.party. What.is.your.age.group.
## 1                                              Rarely                   45-54
## 2                                           Sometimes                   25-34
## 3                                              Rarely                   45-54
## 4                                               Never                   25-34
## 5                                              Rarely                   45-54
## 6                                               Never                     55+
tab_halloween <- table(
  halloween$What.is.your.age.group.,
  halloween$Each.year..do.you.usually.attend.a.Halloween.party.
)
tab_halloween <- tab_halloween[
  !rownames(tab_halloween) %in% c("Under 18", "55+", "45-54"),
]
tab_halloween
##        
##         Always/almost always Never Rarely Sometimes
##   18-24                   17    17     22        31
##   25-34                   27    13     24        20
##   35-44                    9     6      3        14

Eksplorasi (Khi Kuadrat)

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

chisq.test(tab_halloween)
## 
##  Pearson's Chi-squared test
## 
## data:  tab_halloween
## X-squared = 10.198, df = 6, p-value = 0.1166

\(p-value\) > 0.05, maka tidak terdapat hubungan yang signifikan antara kelompok umur dan frekuensi menghadiri pesta Halloween. Meskipun uji \(\chi^2\) tidak menunjukkan hubungan yang signifikan, Analisis Korespondensi tetap dilakukan untuk mengeksplorasi pola dan kecenderungan hubungan antar kategori.

Analisis Korespondensi

fit <- ca(tab_halloween)
summary(fit)
## 
## Principal inertias (eigenvalues):
## 
##  dim    value      %   cum%   scree plot               
##  1      0.036234  72.1  72.1  ******************       
##  2      0.014003  27.9 100.0  *******                  
##         -------- -----                                 
##  Total: 0.050237 100.0                                 
## 
## 
## Rows:
##     name   mass  qlt  inr    k=1 cor ctr    k=2 cor ctr  
## 1 | 1824 |  429 1000  196 |   84 306  83 | -126 694 488 |
## 2 | 2534 |  414 1000  379 | -207 927 487 |   58  73  99 |
## 3 | 3544 |  158 1000  425 |  314 729 430 |  192 271 413 |
## 
## Columns:
##     name   mass  qlt  inr    k=1 cor ctr    k=2 cor ctr  
## 1 | Alwy |  261 1000  261 | -131 343 124 |  182 657 615 |
## 2 | Nevr |  177 1000   41 |   91 714  41 |  -58 286  42 |
## 3 | Rrly |  241 1000  355 | -233 732 361 | -141 268 341 |
## 4 | Smtm |  320 1000  343 |  232 998 475 |  -10   2   2 |

Diperoleh total keragaman yang dapat dijelaskan dalam 2 dimensi adalah sebesar 100%.

Analisis Profil Baris dan Kolom

n <- sum(tab_halloween)
sum_row <- apply(tab_halloween, 1, sum)
sum_row/n
##     18-24     25-34     35-44 
## 0.4285714 0.4137931 0.1576355
rows <- tab_halloween/sum_row
rows
##        
##         Always/almost always     Never    Rarely Sometimes
##   18-24            0.1954023 0.1954023 0.2528736 0.3563218
##   25-34            0.3214286 0.1547619 0.2857143 0.2380952
##   35-44            0.2812500 0.1875000 0.0937500 0.4375000
sum_col <- apply(tab_halloween, 2, sum)
sum_col/n
## Always/almost always                Never               Rarely 
##            0.2610837            0.1773399            0.2413793 
##            Sometimes 
##            0.3201970
cols <- tab_halloween/sum_col
cols
##        
##         Always/almost always      Never     Rarely  Sometimes
##   18-24           0.32075472 0.26153846 0.44897959 0.86111111
##   25-34           0.75000000 0.24528302 0.36923077 0.40816327
##   35-44           0.18367347 0.16666667 0.05660377 0.21538462

Pembentukkan Plot Korespondensi

fit
## 
##  Principal inertias (eigenvalues):
##            1        2       
## Value      0.036234 0.014003
## Percentage 72.13%   27.87%  
## 
## 
##  Rows:
##             18-24     25-34    35-44
## Mass     0.428571  0.413793 0.157635
## ChiDist  0.151612  0.214516 0.367973
## Inertia  0.009851  0.019042 0.021345
## Dim. 1   0.440597 -1.085169 1.650695
## Dim. 2  -1.067337  0.488954 1.618318
## 
## 
##  Columns:
##         Always/almost always     Never    Rarely Sometimes
## Mass                0.261084  0.177340  0.241379  0.320197
## ChiDist             0.223986  0.108030  0.271840  0.231984
## Inertia             0.013099  0.002070  0.017837  0.017232
## Dim. 1             -0.689200  0.479682 -1.222092  1.217563
## Dim. 2              1.534175 -0.487888 -1.188535 -0.084755
plot(fit)

  • Kelompok usia 18-24 tahun cenderung tidak pernah menghadiri pesta halloween.
  • Kelompok dengan usia 25-34 dan 35-44 cenderung tidak memiliki pola yang konsisten.

Hasil ini selaras dengan nilai khi kuadrat yang menyatakan bahwa tidak hubungan yang signifikan antara kelompok umur dan frekuensi menghadiri pesta Halloween.