Responsi 2 STA543 Analisis Data Kategorik
Asosiasi Antara Dua Peubah Kategori
Pendahuluan
setwd("D:\\Kuliah S2 IPB\\Bahan Kuliah\\Semester 2 SSD 2020\\STA543 ADK\\Responsi\\R\\UTS\\")
Struktur peluang tabel kontingensi
Contoh 1
Misal terdapat data jenis kelamin dan pilihan kandidat presiden sebagai berikut:
Tentukan peluang bagi:
Yang memilih Clinton
Yang memilih Obama
Yang memilih Clinton jika ybs laki-laki
Yang memilih Clinton jika ybs perempuan
Yang memilih Obama jika ybs laki-laki
Yang memilih Obama jika ybs perempuan
Jawab :
#----INPUT DATA----#
<-matrix(c(200,406,418,418), nrow=2,byrow=TRUE)
pilprescolnames(pilpres)<-c("clinton","obama")
rownames(pilpres)<-c("M","F")
<-as.table(pilpres)
tabelpilpres tabelpilpres
## clinton obama
## M 200 406
## F 418 418
<-as.data.frame(pilpres)
datapilpres datapilpres
## clinton obama
## M 200 406
## F 418 418
#----jawab contoh 1---#
addmargins(tabelpilpres)
## clinton obama Sum
## M 200 406 606
## F 418 418 836
## Sum 618 824 1442
- Peluang Yang memilih Clinton
#a
<-618/1442
a a
## [1] 0.4285714
- Peluang Yang memilih Obama
#b
<-824/1442
b b
## [1] 0.5714286
#c-f
prop.table(tabelpilpres,margin=1) #margin=1 terhadap total baris, margin=2 terhadap total kolom
## clinton obama
## M 0.330033 0.669967
## F 0.500000 0.500000
- Peluang Yang memilih Clinton jika ybs laki-laki = 0.330033
#hitung manual
= 200/606
c c
## [1] 0.330033
- Yang memilih Clinton jika ybs perempuan = 0.5
#hitung manual
= 418/836
d d
## [1] 0.5
- Yang memilih Obama jika ybs laki-laki = 0.669967
#hitung manual
= 406/606
e e
## [1] 0.669967
- Yang memilih Obama jika ybs perempuan = 0.5
#hitung manual
= 418/836
f f
## [1] 0.5
Sensitifitas dan spesifisitas
Sensitivitas dan spesifisitas merupakan salah satu alat dalam diagnosa. Awalnya, kedua statistik ini digunakan untuk melakukan diagnosa kesehatan, namun pada perkembangannya juga digunakan dalam diagnosa model-model statistika. Perhatikan tabel berikut :
• Sensitivitas : peluang bahwa hasil pengujian menunjukkan bahwa seseorang positif terjangkit penyakit apabila faktanya orang tersebut memang terjangkit penyakit.
• Spesifisitas : peluang bahwa hasil pengujian menunjukkan bahwa seseorang tidak terjangkit penyakit apabila faktanya orang tersebut memang tidak terjangkit penyakit
Contoh 2
Berapa nilai sensitifitas dan spesifisitas dari kasus di atas?
Jawab :
#----INPUT DATA SAKIT----#
<-matrix(c(1,12,0,87), nrow=2,byrow=TRUE)
sakit<-rownames(sakit)<-c("pos","neg")
predicted<-colnames(sakit)<-c("sakit","sehat")
actual<-as.table(sakit)
tabelsakit tabelsakit
## sakit sehat
## pos 1 12
## neg 0 87
library("epiR")
epi.tests(tabelsakit,conf.level=0.95)
## Outcome + Outcome - Total
## Test + 1 12 13
## Test - 0 87 87
## Total 1 99 100
##
## Point estimates and 95% CIs:
## ---------------------------------------------------------
## Apparent prevalence 0.13 (0.07, 0.21)
## True prevalence 0.01 (0.00, 0.05)
## Sensitivity 1.00 (0.02, 1.00)
## Specificity 0.88 (0.80, 0.94)
## Positive predictive value 0.08 (0.00, 0.36)
## Negative predictive value 1.00 (0.96, 1.00)
## Positive likelihood ratio 8.25 (4.85, 14.02)
## Negative likelihood ratio 0.00 (0.00, NaN)
## ---------------------------------------------------------
Kebebasan Pada Tabel Kontingensi
Dua peubah (X,Y), dalam tabel kontingensi dikatakan saling bebas secara statistika apabila distribusi peluang bersyarat dari Y adalah identic untuk setiap level X. Jika kedua peubah merupakan peubah respon, maka dua peubah dinyatakan saling bebas apabila semua peluang bersama sama dengan perkalian dari peluang-peluang marginalnya. Ditulis:
Relative Risk
• Resiko relatif adalah nisbah peluang sukses baris pertama pada peluang sukses baris kedua:
• Resiko relatif bernilai satu, r=1 menunjukkan kebebasan antara peubah baris dengan peubah kolom.
• Pada keadaan tertentu resiko relatif lebih bermakna untuk pembandingan peluang sukses. Selisih peluang 0.610−0.601 dan selisih peluang 0.010−0.001 sebesar 0.009 (meskipun dengan menunjukkan hasil uji yang berbeda), tetapi nisbah peluang 0.610/0.601 dan 0.010/0.001 adalah sangat berbeda, masing-masing adalah 1.01 dan 10.
• Inferensia untuk resiko relatif tidak sederhana sehingga jarang digunakan pada prakteknya.
Contoh 3
Misal terdapat data jenis kelamin dan pilihan kandidat presiden sebagai berikut:
Tentukan nilai resiko relative antara pria dan wanita dari kasus tersebut. Berdasarkan hasil tersebut apakah terdapat hubungan antara jenis kelamin dan pilihan kandidat presiden?
Jawab :
Cara Manual:
P(Clinton|Male)=200/606= 0.330033
P(Clinton|female)=418/836= 0.5
RR=0.330033/0.5=0.660066
Artinya apabila diketahui seseorang adalah laki-laki, maka kecenderungan untuk memilih Clinton adalah 0.66 kali dari kecenderungan wanita memilih Clinton, dengan kata lain wanita lebih cenderung memilih Clinton dibandingkan laki-laki. Berdasarkan nilai resiko relative yang diperoleh terdapat hubungan antara jenis kelamin dengan pilihan kandidat presiden, hal ini karena nilai dari resiko relatif tidak sama dengan satu.
Sintaks R:
<- prop.table(tabelpilpres, margin = 1) #Tabelnya sama dengan contoh 1 sehingga langsung kita gunakan data yang sudah di input sebelumnya yaitu tabelpilpres
prop.out
# relative risk of male vs. female
prop.out
## clinton obama
## M 0.330033 0.669967
## F 0.500000 0.500000
1,1]/prop.out[2,1] prop.out[
## [1] 0.660066
Rasio odds
Odds adalah rasio peluang sukses dan gagal sedangkan rasio odds adalah rasio dari nilai odd.
• Sifat-sifat rasio odds
Pada tabel kontingensi 2×2 dengan π1 dan π2 masing-masing adalah peluang sukses pada baris-1 dan baris-2,
Keadaan π1=π2 menyebabkan odds1=odds2 sehingga θ=1, menunjukkan kebebasan antara peubah baris dan peubah kolom. θ>1 menunjukkan π1>π2, dan . θ<1 menunjukkan π1<π2.
Nilai θ sekecil-kecilnya adalah 0 dan sebesar-besarnya adalah infinite, semakin jauh θ dari 1 semakin kuat keterkaitan antara peubah kolom pada peubah baris. Dua nilai rasio odds θ1 dan θ2 menunjukkan kekuatan keterikatan yang sama besar apabila θ1=1/θ2.
Pertukaran posisi baris atau kolom tidak menyebabkan gambaran kekuatan keterikatan baris dan kolom berubah; dengan pertukaran ini akan diperoleh θ baru yang nilainya sebesar 1/θ .
Nilai nisbah odds tidak perubah apabila tabel ditranspose sehingga posisi baris dan kolomnya dipertukarkan.
• Inferensi rasio odds
Transformasi logaritma (logaritma berbasis e) atas nisbah odds, dapat diperoleh sebaran yang simetris mendekati sebaran Normal; Nilai θ=1 bersesuaian dengan lnθ=0, menunjukkan kebebasan; Jika θ1=1θ2 maka lnθ1=−lnθ2 menunjukkan kekuatan keterikatan yang sama tetapi berbeda arah.
Simpangan baku bagi statistik logaritma nisbah odds adalah:
- Batas bawah dan batas atas selang kepercayaan bagi θ masing-masing diperoleh sebagai eksponen batas bawah dan eksponen batas atas selang kepercayaan bagi lnθ.
Contoh 4
Misal terdapat data jenis kelamin dan pilihan kandidat presiden sebagai berikut:
Tentukan odds laki-laki
Tentukan odds perempuan
Hitung rasio odds berdasarkan poin a dan b, interpretasikan nilai rasio odds tersebut
Tentukan selang kepercayaan dari rasio odds yang telah Anda peroleh pada butir a
Berdasarkan nilai rasio odds tersebut apakah terdapat hubungan antara jenis kelamin dengan pilihan presiden?
Jawab
Cara Manual:
- P(C|M)=200/606=0.330033; P(O|M)=406/606=0.669967; odds(M)=0.330033/0.669967=0.492611
nilai odds ini berarti peluang laki-laki memilih Clinton 0.499 kali dari peluang laki-laki memilih Obama.
- P(C|F)=418/836=0.5; P(O|F)=418/836=0.5; odds(F)=0.5/0.5=1
nilai odds ini berarti, peluangg wanita untuk memilih Clinton sama dengan peluang wanita untuk memilih Obama.
- OR=odds(M)/odds(F)=0.492611/1=0.492611
artinya odds laki-laki 0.49 kali dari odds wanita.
4.selang kepercayaan dari rasio odds
s^2=(1/200+1/406+1/418+1/418)=0.012248
Selang Kepercayaan = \((ln(θ)±Z_(0.05/2)*s )\)
\(=ln(0.492611)±1.96√((0.012248\))
Selang Kepercayaan 95%:
-0.92495<ln(θ)<-0.49112
0.396552<θ<0.611938
- Berdasarkan nilai dari rasio odds terdapat hubungan antara jenis kelamin dengan pilihan presiden, karena nilai 1 (satu) tidak masuk pada selang kepercayaan θ.
Dengan R:
#---jawab contoh 4---#
# odds of Male
1,1]/prop.out[1,2] prop.out[
## [1] 0.4926108
# odds of Female
2,1]/prop.out[2,2] prop.out[
## [1] 1
library("epitools") #Jangan lupa install package epitools dulu jika belum ada
tabelpilpres
## clinton obama
## M 200 406
## F 418 418
<- oddsratio(tabelpilpres, rev="b") #rev : reverse order of "rows", "colums","both", or "neither" (default)
or.out
$measure or.out
## NA
## odds ratio with 95% C.I. estimate lower upper
## F 1.0000000 NA NA
## M 0.4929825 0.3963827 0.6119071
HUBUNGAN ANTARA RASIO ODDS DAN RESIKO RELATIF
Uji khi kuadrat untuk kebebasan antar peubah
Contoh 5
dengan data contoh 1 ujilah hipotesis:
H0: Antar peubah saling bebas
H1: Antar peubah ada asosiasi
#----jawab contoh 5----#
tabelpilpres
## clinton obama
## M 200 406
## F 418 418
chisq.test(tabelpilpres,correct=FALSE)
##
## Pearson's Chi-squared test
##
## data: tabelpilpres
## X-squared = 41.444, df = 1, p-value = 1.213e-10
Karena p_value < 0.05 maka TOLAK H0 berarti pada taraf nyata 5% dapat cukup bukti untuk menyatakan ada asosiasi antar peubah jenis kelamin dan pilihan kandidat presiden.
Fisher Exact Test
Selang kepercayaan dan pengujian asosiasi antara dua peubah yang dilakukan dengan distribusi Chi-Square digunakan untuk contoh berukuran besar. Akan tetapi, jika ukuran contoh kecil, inferensia menggunakan Fisher Exact Test lebih tepat. Pada tabel 2x2, kebebasan dua peubah ditandai dengan nilai rasio odds sama dengan satu (𝜃 = 1). Pada tabel 2x2 untuk jumlah baris dan kolom marginal tertentu, frekuensi pada sel pertama (𝑛11) menentukan frekuensi pada ketiga sel lainnya. Ketika nilai rasio odds sama dengan satu (𝜃 = 1),peluang untuk nilai 𝑛11 dinyatakan oleh:
Contoh 6
Jawab:
Hipotesis:
H0: Jenis kelamin dan pilihan presiden saling bebas
H1: Jenis kelamin dan pilihan presiden tidak saling bebas
Statistik Uji:
P_Value = P(X>=n11) = P(X>=3) = P(X=3)+ P(X=4) + P(X=5)
Dengan R:
Menggunakan Sebaran Hipergeometrik
## Hipergeometrik
#x=n11, m=n1+, n=n2+, k=n+1
# dhyper(x, m, n, k) #untuk nilai pdf (fungsi massa peluang) P(X=x)
#phyper(x, m, n, k, TRUE) #untuk nilai CDF (cumulatif) P(X<=x)
<-dhyper(3, 5, 5, 5)
p3<-dhyper(4, 5, 5, 5)
p4<-dhyper(5, 5, 5, 5)
p5<-p3+p4+p5
p_value p_value
## [1] 0.5
#atau
1-phyper(2, 5, 5, 5,TRUE)
## [1] 0.5
Menggunakan fisher.test
library("DescTools") #jangan lupa install package DescTools dulu jika belum ada
#input data
<-matrix(c(3,2,2,3), nrow=2,byrow=TRUE)
pilpres2colnames(pilpres2)<-c("clinton","obama")
rownames(pilpres2)<-c("M","F")
<-as.table(pilpres2)
tabelpilpres2 tabelpilpres2
## clinton obama
## M 3 2
## F 2 3
fisher.test(tabelpilpres2,alternative='g') #g menandakan H1 teta >1 atau uji 1 arah
##
## Fisher's Exact Test for Count Data
##
## data: tabelpilpres2
## p-value = 0.5
## alternative hypothesis: true odds ratio is greater than 1
## 95 percent confidence interval:
## 0.1541449 Inf
## sample estimates:
## odds ratio
## 2.069959
Contoh 7
Jawab:
Hitung Manual:
Statistik Uji:
P_Value = P(X>=n11)= P(X>=7)
Dengan R:
Menggunakan Sebaran Hipergeometrik
## Hipergeometrik
#x=n11, m=n1+, n=n2+, k=n+1
# dhyper(x, m, n, k) #untuk nilai pdf (fungsi massa peluang) P(X=x)
#phyper(x, m, n, k, TRUE) #untuk nilai CDF (cumulatif) P(X<=x)
<-dhyper(7, 9, 5, 7)
p_value1 p_value1
## [1] 0.01048951
#atau
1-phyper(7-1, 9, 5, 7,TRUE)
## [1] 0.01048951
Menggunakan fisher.test
#input data
<-matrix(c(7,0,2,5), nrow=2,byrow=F)
dataatletcolnames(dataatlet)<-c("bukan perokok","perokok")
rownames(dataatlet)<-c("atlet","bukan atlet")
<-as.table(dataatlet)
tabeldataatlet tabeldataatlet
## bukan perokok perokok
## atlet 7 2
## bukan atlet 0 5
fisher.test(tabeldataatlet,alternative='g') #g menandakan H1 teta >1 atau uji 1 arah
##
## Fisher's Exact Test for Count Data
##
## data: tabeldataatlet
## p-value = 0.01049
## alternative hypothesis: true odds ratio is greater than 1
## 95 percent confidence interval:
## 2.037464 Inf
## sample estimates:
## odds ratio
## Inf
Referensi
Rizki, A. 3/4/2021.Praktikum ADK III-IV Association Between Two Categorical Variables. Retrieved From https://rpubs.com/Akbar_rizki/ADK-0304
Mahasiswa Pascasarjana Statistika dan Sains Data, IPB University, reniamelia@apps.ipb.ac.id↩︎