Puji syukur saya panjatkan atas terselesaikannya eBook yang berjudul “Analisis Data Kategorik” ini. Buku ini saya susun sebagai panduan praktis dan komprehensif untuk membantu pembaca memahami serta menguasai teknik-teknik analisis data kategorik, sebuah jenis data kualitatif yang sangat umum dijumpai dalam berbagai bidang ilmu dan penelitian.
Data kategorik, yang merepresentasikan kelompok atau kategori seperti jenis kelamin, pekerjaan, atau preferensi, memiliki karakteristik yang berbeda dengan data numerik. Oleh karena itu, analisisnya memerlukan pendekatan khusus agar dapat mengungkap pola distribusi, hubungan antar variabel, serta membangun model prediksi yang akurat. Dalam buku ini, saya memaparkan berbagai metode analisis data kategorik seperti tabel kontingensi, uji chi-square, regresi logistik, dan model log-linear, yang telah banyak digunakan dan dikembangkan dalam literatur statistik.
Saya berharap buku ini dapat menjadi sumber belajar yang bermanfaat bagi mahasiswa, peneliti, dan praktisi yang ingin memperdalam kemampuan analisis data non-numerik. Semoga materi yang disajikan dapat membantu meningkatkan kualitas penelitian dan pengambilan keputusan berbasis data.
Akhir kata, saya mengucapkan terima kasih kepada semua pihak yang telah mendukung tersusunnya buku ini. Kritik dan saran yang membangun sangat saya harapkan demi kesempurnaan buku ini di masa mendatang.
Selamat membaca
Jatinangor, 17 Juni 2025
Hadeelina Shakira Zalianty
Data kategorik adalah jenis data kualitatif yang merepresentasikan kelompok atau kategori, seperti jenis kelamin, pekerjaan, atau preferensi. Berbeda dari data numerik, data ini tidak memiliki nilai angka yang dapat diolah secara langsung dengan metode statistik biasa. Oleh karena itu, diperlukan pendekatan khusus dalam analisisnya. Analisis data kategorik berguna untuk memahami pola distribusi kategori, mengevaluasi hubungan antar variabel, serta membuat model prediksi berbasis klasifikasi. Beberapa metode umum yang digunakan adalah tabel kontingensi, uji chi-square, regresi logistik, dan model log-linear. Seperti dijelaskan oleh Agresti (2013), analisis data kategorik memerlukan teknik tersendiri karena karakteristiknya yang tidak memenuhi asumsi data numerik. Oleh sebab itu, penguasaan metode ini penting bagi peneliti yang bekerja dengan data non-numerik.
Analisis data kategorik bertujuan untuk mengidentifikasi danmemahami bagaimana data tersebar di antara berbagai kategori. Hal ini membantu peneliti mengetahui proporsi atau frekuensi masing-masing kategori dalam dataset.
Tujuan lainnya adalah mengevaluasi apakah terdapat hubungan atau asosiasi antara dua atau lebih variabel kategorik. Misalnya, menentukan apakah terdapat keterkaitan antara tingkat pendidikan dan status pekerjaan.
Analisis data kategorik digunakan untuk membangun model yang dapat memprediksi kategori suatu variabel berdasarkan variabel lain. Contohnya, menggunakan regresi logistik untuk memprediksi apakah seorang pelanggan akan membeli produk berdasarkan karakteristik demografisnya.
menganalisis data kategorik, peneliti dapat mengungkap pola atau tren tertentu yang mungkin tidak terlihat secara langsung, seperti preferensi konsumen terhadap produk tertentu berdasarkan kelompok usia.
Analisis data kategorik memungkinkan peneliti untuk menguji hipotesis statistik mengenai distribusi atau hubungan antar kategori, seperti menggunakan uji chi-square untuk menguji independensi antara dua variabel kategorik.
kategorik adalah cabang statistik yang memfokuskan pada teknik untuk menganalisis data yang diklasifikasikan ke dalam kategori diskrit, baik dalam bentuk label tanpa urutan maupun label dengan urutan tertentu.
• Nominal
Data nominal terdiri atas kategori yang tidak memiliki urutan logis. Masing-masing kategori berdiri sendiri dan tidak menunjukkan tingkatan. Contoh: Warna mobil (merah, putih, hitam) Jenis kelamin (pria, wanita) Agama (Islam, Kristen, Hindu, Buddha)
• Ordinal
Data ordinal memiliki urutan atau tingkatan, namun perbedaan antara satu kategori dengan lainnya tidak dapat diukur secara kuantitatif. Contoh: Tingkat pendidikan (SD, SMP, SMA, Perguruan Tinggi) Skor kepuasan (sangat tidak puas, tidak puas, netral, puas, sangat puas)
• Data Biner
Data biner merupakan data kategorik dengan dua kemungkinan kategori. Data ini sangat umum dalam penelitian, terutama ketika hasil yang diukur bersifat ya/tidak, benar/salah, atau hadir/tidak hadir. Contoh: Apakah seseorang membeli produk? (ya/tidak) Status merokok (perokok/bukan perokok) Hasil tes (positif/negatif)
• Data Multikategori
Data multikategori memiliki lebih dari dua kategori. Data ini bisa bersifat nominal maupun ordinal, tergantung pada apakah kategorinya memiliki urutan atau tidak. Contoh: Jenis pekerjaan (guru, dokter, pengacara, pengusaha) Tingkat stres (rendah, sedang, tinggi) Preferensi makanan (nasi, roti, mie, pasta)
o Data Kategorik: Data yang dikelompokkan ke dalam kategori atau label tanpa nilai numerik intrinsik.
Contohnya termasuk jenis kelamin (pria/wanita), status pernikahan (lajang/menikah), atau warna mata (biru/coklat). Data ini bersifat kualitatif dan tidak dapat diukur secara numerik.
o Data Kuantitatif: Data yang berupa angka dan mencerminkan besaran atau jumlah tertentu.
Contohnya termasuk tinggi badan (170 cm), berat badan (65 kg), atau jumlah anak (2). Data ini bersifat numerik dan dapat diukur serta dianalisis secara matematis.
o Data Kategorik: Biasanya diukur pada skala nominal atau ordinal. Skala nominal digunakan untuk kategori tanpa urutan, seperti jenis kelamin atau warna favorit. Skala ordinal digunakan untuk kategori dengan urutan tertentu, seperti tingkat pendidikan (SD, SMP, SMA) atau tingkat kepuasan (puas, netral, tidak puas).
o Data Kuantitatif: Diukur pada skala interval atau rasio. Skala interval memiliki jarak yang sama antara nilai, tetapi tanpa nol absolut, seperti suhu dalam Celsius. Skala rasio memiliki nol absolut, memungkinkan perbandingan rasio, seperti berat badan atau pendapatan.
o Data Kategorik: Analisis data ini melibatkan teknik seperti tabel kontingensi, uji chi-square, regresi logistik, dan model log-linear. Metode ini dirancang untuk menangani data yang tidak memenuhi asumsi distribusi normal dan varians homogen.
o Data Kuantitatif: Dianalisis menggunakan teknik seperti analisis regresi linier, uji t, ANOVA, dan korelasi Pearson. Metode ini mengasumsikan data berdistribusi normal dengan varians homogen.
o Data Kategorik: Sering disajikan dalam bentuk tabel frekuensi, diagram batang, atau diagram lingkaran untuk menunjukkan distribusi kategori.
oData Kuantitatif: Dapat disajikan menggunakan histogram, diagram garis, atau scatter plot untuk menggambarkan distribusi dan hubungan antar variabel numerik.
o Data Kategorik: Bertujuan untuk mengklasifikasikan individu atau objek ke dalam kelompok atau kategori tertentu berdasarkan atribut atau karakteristik.
o Data Kuantitatif: Bertujuan untuk mengukur besaran atau jumlah suatu atribut, memungkinkan perhitungan statistik seperti rata-rata, median, dan standar deviasi.
Dalam bidang kesehatan, analisis data kategorik digunakan untuk memahami hubungan antara faktor risiko dan status kesehatan. Misalnya, menganalisis hubungan antara jenis kelamin dan prevalensi penyakit tertentu, atau antara status perokok dan kejadian penyakit jantung.
Di sektor pendidikan, analisis ini membantu mengevaluasi faktor-faktor yang mempengaruhi prestasi siswa, seperti hubungan antara tingkat pendidikan orang tua dan prestasi akademik anak, atau antara metode pengajaran dan tingkat kelulusan siswa.
Perusahaan menggunakan analisis data kategorik untuk memahami preferensi konsumen, segmentasi pasar, dan efektivitas kampanye pemasaran. Misalnya, menganalisis hubungan antara jenis kelamin dan preferensi produk tertentu, atau antara usia dan loyalitas merek.
Dalam penelitian sosial dan ekonomi, analisis data kategorik membantu mengidentifikasi pola dalam distribusi pendapatan, status pekerjaan, atau akses terhadap layanan publik. Misalnya, mengevaluasi hubungan antara status pekerjaan dan tingkat kepuasan hidup, atau antara lokasi geografis dan akses terhadap pendidikan.
Dalam psikologi, analisis ini digunakan untuk mempelajari hubungan antara variabel psikologis, seperti antara jenis kelamin dan preferensi terhadap jenis terapi tertentu, atau antara usia dan kecenderungan terhadap perilaku tertentu.
Menghitung dan menganalisis distribusi frekuensi atau proporsi dari kategori dalam satu variabel untuk memahami pola dasar data.
Menyusun tabel yang menunjukkan distribusi frekuensi dari dua atau lebih variabel kategorik untuk mengeksplorasi hubungan antar variabel tersebut.
Menggunakan uji statistik untuk menguji independensi atau kesesuaian antara variabel kategorik, seperti uji chi-square untuk tabel kontingensi.
Variabel respons bersifat biner atau multinomial, memungkinkan analisis pengaruh variabel prediktor terhadap probabilitas kategori tertentu.
Arah hubungan antara dua variabel kategorik. Ukuran seperti Odds Ratio, Risk Ratio, dan Koefisien Kontingensi digunakan untuk menilai derajat asosiasi.
Analisis correspondence adalah teknik multivariat yang digunakan untuk menganalisis hubungan antara dua atau lebih variabel kategorik dengan menampilkan hubungan tersebut dalam bentuk visual.
Decision tree adalah metode yang digunakan untuk memodelkan keputusan dan prediksi dengan cara membagi data ke dalam berbagai kategori berdasarkan serangkaian pertanyaan yang diteruskan secara berurutan. Setiap “cabang” pada pohon keputusan mewakili keputusan berdasarkan suatu atribut, dan “daun” mewakili hasil atau prediksi.
Random forest adalah metode ensemble yang menggabungkan beberapa pohon keputusan untuk meningkatkan akurasi prediksi. Ini dilakukan dengan membuat banyak pohon keputusan dengan menggunakan subset acak dari data dan fitur yang ada, kemudian menggabungkan hasilnya.
Distribusi Bernoulli adalah distribusi probabilitas diskrit untuk percobaan yang hanya memiliki dua hasil, yaitu sukses (1) dan gagal (0). Rumus: \[ P(X = 1) = p,\quad P(X = 0) = 1 - p \] Contoh: Dalam melempar sebuah koin, peluang munculnya sisi “Gambar” (misal sukses) adalah 0,5. Distribusi ini mengikuti distribusi Bernoulli.
Distribusi multinomial adalah generalisasi dari distribusi binomial untuk percobaan yang memiliki lebih dari dua kemungkinan hasil. Rumus: \[ P(X_1 = x_1, X_2 = x_2, ..., X_k = x_k) = \frac{n!}{x_1!x_2!...x_k!} \cdot p_1^{x_1} \cdot p_2^{x_2} \cdot ... \cdot p_k^{x_k} \] Contoh: Dalam survei terhadap 100 orang tentang minuman favorit mereka (kopi, teh, jus), hasilnya: 50 orang memilih kopi, 30 orang memilih teh, 20 orang memilih jus.
Distribusi binomial menggambarkan jumlah keberhasilan dalam sejumlah percobaan Bernoulli. Rumus: \[ P(X = k) = \binom{n}{k} p^k (1 - p)^{n - k}\] Contoh: Sebuah produk elektronik dicek kualitasnya. Peluang sebuah produk cacat adalah 0,1. Dalam sampel 10 produk, peluang terdapat tepat 2 produk cacat dihitung menggunakan distribusi binomial.
Distribusi Poisson digunakan untuk menghitung jumlah kejadian dalam interval waktu atau ruang tertentu. Rumus: \[ P(X = k) = \frac{\lambda^k e^{-\lambda}}{k!}\] Contoh: Jumlah keluhan pelanggan di sebuah toko dalam satu jam rata-rata adalah 3. Probabilitas bahwa dalam satu jam ada 5 keluhan dapat dihitung dengan distribusi Poisson.
Secara umum, desain sampling dibagi menjadi dua kategori utama, yaitu sampling prospektif dan sampling retrospektif. Masing-masing pendekatan memiliki ciri khas tersendiri dalam karakteristik sampel dan metode pengumpulan data, baik dalam studi observasional maupun eksperimental seperti eksperimen, studi kohort, dan studi kasus-kontrol.
Sampling prospektif adalah teknik pengumpulan data di mana subjek diidentifikasi terlebih dahulu, lalu diikuti selama periode waktu tertentu untuk mengamati hasil yang terjadi di masa depan. Pendekatan ini umum digunakan dalam studi kohort dan eksperimental. Beberapa metode sampling dalam kategori ini antara lain:
Pada penelitian eksperimental, subjek dipilih secara acak dan dialokasikan ke dalam kelompok perlakuan maupun kelompok kontrol.
• Simple Random Sampling (SRS):
Setiap individu dalam populasi memiliki kesempatan yang sama untuk dipilih secara acak.
• Stratified Sampling:
Populasi dibagi ke dalam subkelompok (strata) berdasarkan karakteristik tertentu, lalu sampel diambil dari tiap strata.
• Cluster Sampling:
Populasi dikelompokkan menjadi beberapa cluster, kemudian satu atau lebih cluster dipilih secara acak sebagai sampel.
penelitian kohort, kelompok individu diikuti dari waktu ke waktu untuk mengamati hasil yang diukur.
• Sensus Sampling: Seluruh anggota populasiyang memenuhi kriteria diikutsertakan dalam penelitian.
• Systematic Sampling: Subjek dipilih secara sistematis berdasarkan interval tertentu dari daftar populasi. • Matched Sampling: Individu dalam kelompok kohort dicocokkan dengan individu serupa dari kelompok lain berdasarkan karakteristik tertentu.
Sampling retrospektif merupakan metode pengumpulan data dari peristiwa yang telah terjadi dimasa lalu. Teknik ini sering digunakan dalam studi observasional untuk meneliti hubungan antara faktor risiko dan hasil yang sudah terjadi.
Dalam studi ini, individu dengan kondisi tertentu (kasus) dibandingkan dengan individu tanpa kondisi tersebut (kontrol).
• Purposive Sampling:
Subjek dipilih secara sengaja berdasarkan karakteristik tertentu yang relevan dengan penelitian.
• Snowball Sampling:
Responden yang telah direkrut diminta merekomendasikan individu lain yang sesuai kriteria penelitian.
•Incidence Density Sampling:
Kasus dan kontrol dipilih dari populasi yang sama dengan memperhitungkan waktu kejadian kasus.
Dalam studi ini, data historis digunakan untuk mengelompokkan individu berdasarkan paparan sebelumnya, kemudian hasilnya diamati.
• Quota Sampling: Subjek dipilih untuk memenuhi kuota tertentu berdasarkan kategori yang telah ditetapkan.
• Case-Base Sampling: Sampel diambil dari basis data populasi umum yang sudah tersedia.
• Systematic Sampling: Pemilihan subjek dilakukan berdasarkan interval tertentu dalam catatan yang ada.
Tabel kontingensi 2×2 adalah alat statistik yang digunakan untuk menganalisis hubungan antara dua variabel kategorik, masing-masing dengan dua kategori. Tabel ini menyajikan frekuensi pengamatan dalam empat sel yang merepresentasikan kombinasi kategori dari kedua variabel tersebut. Contoh aplikasinya misalkan dalam sebuah studi kesehatan, peneliti ingin mengetahui hubungan antara kebiasaan merokok (Ya/Tidak) dan kejadian penyakit jantung (Ya/Tidak). Data yang diperoleh disusun dalam tabel kontingensi 2×2 untuk dianalisis apakah terdapat asosiasi antara merokok dan penyakit jantung.
Tabel kontingensi 2×2 digunakan untuk:
• Mengidentifikasi hubungan atau asosiasi antara dua variabel kategorik.
• Menghitung ukuran asosiasi seperti Odds Ratio (OR) dan Risk Ratio (RR).
• Melakukan uji independensi seperti uji Chi-Square untuk menentukan apakah terdapat hubungan yang signifikan antara kedua variabel.
Contoh Tabel:
| Merokok (B1) | Tidak Merokok (B2) | Total | |
|---|---|---|---|
| Sakit Jantung (A1) | 30 | 10 | 40 |
| Tidak Sakit (A2) | 20 | 40 | 60 |
| Total | 50 | 50 | 100 |
Definisi: Peluang dua kejadian terjadi secara bersamaan.
Rumus: \[ P(A \cap B) = \frac{n(A \cap B)}{n}\]
Definisi: Peluang terjadinya satu kejadian tanpa memperhatikan kejadian lainnya.
Rumus:
\[ P(A) = \frac{n(A)}{n} \]
Definisi:
Peluang suatu kejadian terjadi dengan syarat kejadian lain telah terjadi.
Rumus:
\[ P(A|B) = \frac{P(A \cap B)}{P(B)} = \frac{n(A \cap B)}{n(B)} \]
Contoh Kasus:
| Merokok (B1) | Tidak Merokok (B2) | Total | |
|---|---|---|---|
| Sakit Jantung (A1) | 30 | 10 | 40 |
| Tidak Sakit (A2) | 20 | 40 | 60 |
| Total | 50 | 50 | 100 |
Peluang Bersama (Joint Probability)
\[ P(\text{Sakit dan Merokok}) = \frac{30}{100} = 0.3\] Peluang Marjinal \[ P(\text{Sakit}) = \frac{40}{100} = 0.40\] \[ P(\text{Merokok}) = \frac{50}{100} = 0.50\]
Peluang Bersyarat \[ P(\text{Sakit} | \text{Merokok}) = \frac{30}{50} = 0.60\]
Ukuran asosiasi dalam tabel kontingensi 2×2 digunakan untuk mengukur kekuatan dan arah hubungan antara dua variabel kategorik. Berikut adalah beberapa ukuran asosiasi yang umum digunakan:
Odds Ratio digunakan untuk membandingkan “peluang” (odds) suatu kejadian antara dua kelompok. Ini bukan probabilitas, tapi rasio antara jumlah sukses dan gagal dalam tiap kelompok. OR banyak dipakai dalam penelitian kasus-kontrol.
🔹 Interpretasi:
OR = 1 → Tidak ada hubungan antara eksposur dan outcome.
OR > 1 → Peluang outcome lebih besar pada kelompok eksposur.
OR < 1 → Peluang outcome lebih kecil pada kelompok eksposur.
odds_ratio <- (30 * 40) / (20 * 10)
odds_ratio
## [1] 6
Interpretasi: Peluang perokok untuk sakit jantung 6 kali lebih besar dibanding yang tidak merokok.
Risk Ratio menghitung perbandingan probabilitas outcome antara dua kelompok. Digunakan dalam penelitian kohort (prospektif).
🔹 Interpretasi:
RR = 1 → Risiko sama pada kedua kelompok.
RR > 1 → Risiko lebih tinggi di kelompok ekspos.
RR < 1 → Risiko lebih rendah di kelompok ekspos.
a <- 30 # Merokok dan Sakit
b <- 20 # Merokok dan Tidak Sakit
c <- 10 # Tidak Merokok dan Sakit
d <- 40 # Tidak Merokok dan Tidak Sakit
risk_merokok <- a / (a + b) # 30 / 50
risk_tidak_merokok <- c / (c + d) # 10 / 50
RR <- risk_merokok / risk_tidak_merokok
RR
## [1] 3
artinya perokok 3 kali lebih berisiko terkena sakit jantung dibanding non-perokok.
Risk Difference (juga dikenal sebagai Absolute Risk Reduction) adalah selisih probabilitas outcome antar dua kelompok.
🔹 Interpretasi:
RD = 0 → Tidak ada perbedaan risiko.
RD > 0 → Risiko lebih tinggi di kelompok eksposur.
RD < 0 → Risiko lebih tinggi di kelompok kontrol.
rd <- (30 / 50) - (10 / 50)
rd
## [1] 0.4
Ada perbedaan risiko sebesar 40% antara kelompok merokok dan tidak merokok.
Uji Chi-Square digunakan untuk menguji apakah ada hubungan signifikan antara dua variabel kategorik.
🔹 Interpretasi:
p-value < 0.05 → Ada asosiasi signifikan.
p-value ≥ 0.05 → Tidak signifikan; tidak ada bukti hubungan.
Alternatif dari Chi-Square Test jika jumlah data kecil, terutama jika frekuensi harapan (expected cell frequency) < 5. Menggunakan distribusi eksak daripada aproksimasi.
🔹 Interpretasi:
p-value < 0.05 → asosiasi signifikan
Sangat cocok untuk data medis atau studi dengan sampel kecil
Contoh: Dalam uji klinis kecil, Fisher Test bisa menunjukkan bahwa obat A lebih efektif dari obat B secara signifikan.
Inferensi pada tabel kontingensi dua arah bertujuan untuk menganalisis hubungan antara dua variabel kategorik. Analisis ini melibatkan estimasi parameter dan pengujian hipotesis untuk menentukan apakah terdapat asosiasi yang signifikan antara variabel-variabel tersebut.
Estimasi bertujuan untuk memperkirakan parameter populasi berdasarkan data sampel.
Estimasi titik digunakan untuk menentukan satu nilai spesifik sebagai perkiraan terbaik dari parameter populasi \[\hat{p} = \frac{x}{n}\] \[\hat{p} = estimasi\quad titik\quad proporsi\] x = adalah jumlah individu dalam kategori tertentu n = adalah total jumlah individu dalam sampel.
Estimasi interval bertujuan untuk memberikan rentang nilai yang diyakini mengandung parameter populasi dengan tingkat kepercayaan tertentu. \[ \hat{p} \pm Z_{\alpha/2} \sqrt{\frac{\hat{p}(1-\hat{p})}{n}}\]
Untuk uji proporsi dalam uji hipotesis tabel kontingensi 2x2, biasanya digunakan uji Chi-Square atau uji proporsi untuk membandingkan dua proporsi yang terpisah, dan untuk menentukan apakah terdapat hubungan yang signifikan antara dua variabel kategori.
Proporsi untuk masing-masing kelompok dihitung sebagai:
Estimasi proporsi gabungan:
Statistik uji untuk proporsi dua sampel
Rumus statistik uji:
\[ Z = \frac{\hat{p}_1 - \hat{p}_2} {\sqrt{\hat{p}(1 - \hat{p}) \left( \frac{1}{n_1} + \frac{1}{n_2} \right)}} \] Hipotesis Nol : Tidak ada perbedaan proporsi antara dua kelompok • Hipotesis Alternatif : Terdapat perbedaan proporsi antara dua kelompok
Sebuah studi dilakukan untuk membandingkan efektivitas dua metode pengajaran. Hasilnya adalah sebagai berikut:
Apakah terdapat perbedaan proporsi kelulusan secara signifikan antara kedua metode pada tingkat signifikansi \(\alpha = 0.05\)?
Tabel Kontingensi
\[ \begin{array}{|c|c|c|c|} \hline & \text{Lulus} & \text{Tidak Lulus} & \text{Total} \\ \hline \text{Metode A} & 60 & 40 & 100 \\ \text{Metode B} & 75 & 45 & 120 \\ \hline \end{array} \]
Estimasi Proporsi Sampel
Proporsi siswa yang lulus:
Proporsi Gabungan
Gabungan kelulusan dari dua kelompok: \[ \hat{p} = \frac{60 + 75}{100 + 120} = \frac{135}{220} \approx 0.6136 \] Statistik Uji Z
Rumus statistik uji: \[ Z = \frac{\hat{p}_1 - \hat{p}_2} {\sqrt{\hat{p}(1 - \hat{p}) \left( \frac{1}{n_1} + \frac{1}{n_2} \right)}} \]
Substitusi nilai: \[ Z = \frac{0.6 - 0.625} {\sqrt{0.6136(1 - 0.6136) \left( \frac{1}{100} + \frac{1}{120} \right)}} \]
Hitung denominator: \[ \sqrt{0.6136 \times 0.3864 \left( \frac{1}{100} + \frac{1}{120} \right)} = \sqrt{0.2371 \times 0.01833} \approx \sqrt{0.00435} \approx 0.0659 \]
Sehingga: \[ Z = \frac{-0.025}{0.0659} \approx -0.3795 \]
Keputusan
Dengan \(\alpha = 0.05\) (dua sisi), nilai kritis \(Z_{0.025} = \pm1.96\).
Karena \(|Z| = 0.3795 < 1.96\), maka:
Gagal menolak H₀. Tidak ada cukup bukti untuk menyatakan bahwa kedua metode menghasilkan proporsi kelulusan yang berbeda secara signifikan.
Uji asosiasi dalam tabel kontingensi \(2 \times 2\) bertujuan untuk mengukur hubungan antara dua variabel kategori. Tiga ukuran utama dalam uji asosiasi adalah:
Risk Difference (RD) – Mengukur selisih risiko absolut antara dua kelompok.
Relative Risk (RR) – Mengukur perbandingan risiko antara dua kelompok.
Odds Ratio (OR) – Mengukur perbandingan odds antara dua kelompok.
Untuk setiap uji asosiasi, hipotesis yang diuji adalah:
Risk Difference mengukur perbedaan absolut dalam probabilitas kejadian antara dua kelompok:
\[ RD = \left( \frac{n_{11}}{n_{1\cdot}} \right) - \left( \frac{n_{21}}{n_{2\cdot}} \right) \]
Standard Error untuk RD:
\[ SE(RD) = \sqrt{ \frac{\hat{p}_1(1-\hat{p}_1)}{n_{1\cdot}} + \frac{\hat{p}_2(1-\hat{p}_2)}{n_{2\cdot}} } \]
Statistik uji Z:
\[ Z_{RD} = \frac{RD}{SE(RD)} \]
Relative Risk membandingkan kemungkinan kejadian antara dua kelompok:
\[ RR = \frac{\hat{p}_1}{\hat{p}_2} \]
Standard Error untuk log(RR):
\[ SE(\ln(RR)) = \sqrt{ \frac{1}{n_{11}} - \frac{1}{n_{1\cdot}} + \frac{1}{n_{21}} - \frac{1}{n_{2\cdot}} } \]
Statistik uji Z:
\[ Z_{RR} = \frac{\ln RR}{SE(\ln RR)} \]
Odds Ratio membandingkan peluang kejadian antara dua kelompok:
\[ OR = \frac{n_{11} \times n_{22}}{n_{12} \times n_{21}} \]
Standard Error untuk log(OR):
\[ SE(\ln(OR)) = \sqrt{ \frac{1}{n_{11}} + \frac{1}{n_{12}} + \frac{1}{n_{21}} + \frac{1}{n_{22}} } \]
Statistik uji Z:
\[ Z_{OR} = \frac{\ln OR}{SE(\ln OR)} \]
Uji independensi digunakan untuk menentukan apakah ada hubungan statistik antara dua variabel kategorikal.
Uji Chi-Square digunakan untuk menguji apakah ada hubungan antara dua variabel kategorikal.
Rumus Chi-Square:
\[ \chi^2 = \sum \frac{(O - E)^2}{E} \]
Dimana:
\[ E_{ij} = \frac{(R_i \times C_j)}{N} \]
dengan: - \(R_i\) = total baris ke-\(i\), - \(C_j\) = total kolom ke-\(j\), - \(N\) = total sampel.
Partisi Chi-Square digunakan untuk mengidentifikasi kategori mana dalam tabel kontingensi yang bertanggung jawab atas hubungan yang signifikan. Jika uji Chi-Square pada tabel kontingensi I × J signifikan, maka partisi Chi-Square memungkinkan kita untuk menguraikan efek hubungan dalam subkelompok yang lebih kecil.
Menurut Lancaster dan Irwin, statistik uji chi-square dapat dipecah menjadi komponen-komponen sebanyak derajat bebas dari tabel kontingensi, memungkinkan identifikasi kategori yang berkontribusi pada hubungan yang signifikan.
Kasus: Peneliti ingin mengetahui apakah penggunaan media sosial berhubungan dengan tingkat stres pada remaja.
Data:
| Stres Tinggi | Stres Rendah | Total | |
|---|---|---|---|
| Pengguna Intensif | 30 | 20 | 50 |
| Pengguna Ringan | 10 | 40 | 50 |
| Total | 40 | 60 | 100 |
Langkah 1: Hitung nilai \(E\) (ekspektasi) untuk masing-masing sel:
\[ E_{11} = \frac{50 \times 40}{100} = 20 \] \[ E_{12} = \frac{50 \times 60}{100} = 30 \] \[ E_{21} = \frac{50 \times 40}{100} = 20 \] \[ E_{22} = \frac{50 \times 60}{100} = 30 \]
Langkah 2: Hitung Chi-Square:
\[ \chi^2 = \frac{(30-20)^2}{20} + \frac{(20-30)^2}{30} + \frac{(10-20)^2}{20} + \frac{(40-30)^2}{30} \] \[ = \frac{100}{20} + \frac{100}{30} + \frac{100}{20} + \frac{100}{30} \] \[ = 5 + 3.33 + 5 + 3.33 \] \[ = 16.66\]
Langkah 3: Derajat bebas (df):
\[df = (2-1)(2-1) = 1\]
Langkah 4: Interpretasi: - Dengan \(\alpha = 0.05\), nilai kritis \(\chi^2\) dari tabel adalah 3.841. - Karena 16.66 > 3.841, maka tolak H₀. - Kesimpulan: Ada hubungan signifikan antara penggunaan media sosial dengan tingkat stres remaja.
Uji Likelihood Ratio (\(G^2\)) adalah alternatif dari uji chi-square yang digunakan untuk menguji hipotesis independensi dalam tabel kontingensi \(I \times J\). Statistik uji ini diberikan oleh:
\[ G^2 = 2 \sum_i \sum_j n_{ij} \ln \left( \frac{n_{ij}}{\hat{\mu}_{ij}} \right) \]
Di mana:
Statistik \(G^2\) mengikuti distribusi chi-square dengan derajat bebas: \[ df = (I - 1)(J - 1) \]
Tolak \(H_0\) jika: \[ G^2 \geq \chi^2_{(1 - \alpha), (I-1)(J-1)} \]
Contoh Kasus
Peneliti ingin mengetahui apakah terdapat hubungan antara jenis kelamin dan preferensi minuman. Data yang diperoleh sebagai berikut:
\[ \begin{array}{|c|c|c|c|} \hline & \text{Kopi} & \text{Teh} & \text{Total} \\ \hline \text{Laki-laki} & 40 & 30 & 70 \\ \text{Perempuan} & 20 & 50 & 70 \\ \hline \text{Total} & 60 & 80 & 140 \\ \hline \end{array} \]
Hitung Frekuensi Ekspektasi
Menggunakan rumus: \[ \hat{\mu}_{ij} = \frac{(\text{total baris } i) \times (\text{total kolom } j)}{n} \]
Ekspektasi masing-masing sel:
Hitung Statistik G² \[ G^2 = 2 \left[ 40 \ln\left(\frac{40}{30}\right) + 30 \ln\left(\frac{30}{40}\right) + 20 \ln\left(\frac{20}{30}\right) + 50 \ln\left(\frac{50}{40}\right) \right] \]
Hitung nilai logaritma:
Sehingga:
\[ G^2 = 2 \times (11.51 - 8.63 - 8.11 + 11.16) = 2 \times 5.93 = 11.86 \]
Keputusan
Derajat bebas: \[ df = (2 - 1)(2 - 1) = 1\]
Dengan \(\alpha = 0.05\), nilai kritis \(\chi^2_{0.95, 1} = 3.841\)
Karena \(G^2 = 11.86 > 3.841\), maka:
Tolak H₀. Terdapat hubungan yang signifikan antara jenis kelamin dan preferensi minuman.
Uji Fisher’s Exact digunakan untuk menguji hubungan antara dua variabel kategorikal dalam tabel kontingensi kecil, dimana asumsi Chi-square tidak berlaku karena ukuran sampel yang kecil.
digunakan untuk menghitung peluang terjadinya sejumlah keberhasilan dalam pengambilan sampel tanpa pengembalian dari populasi terbatas.
Rumus distribusi hipergeometrik:
\[ P(X = x) = \frac{{\binom{K}{x} \binom{N-K}{n-x}}}{\binom{N}{n}} \]
Keterangan: - \(N\) = jumlah total populasi - \(K\) = jumlah item sukses dalam populasi - \(n\) = jumlah item yang diambil - \(x\) = jumlah sukses yang diinginkan
Kasus:
Suatu pabrik memiliki 15 produk, terdiri dari 5 produk cacat dan 10
produk bagus.
Jika 4 produk diambil secara acak tanpa pengembalian, berapa peluang
tepat 2 produk yang diambil adalah produk cacat?
Parameter:
Perhitungan :
\[ P(X = 2) = \frac{{\binom{5}{2} \binom{10}{2}}}{\binom{15}{4}} \]
Hitung kombinasi: - \(\binom{5}{2} = 10\) - \(\binom{10}{2} = 45\) - \(\binom{15}{4} = 1365\)
Sehingga:
\[ P(X = 2) = \frac{10 \times 45}{1365} = \frac{450}{1365} \approx 0.3297 \]
Jadi, peluangnya sekitar 32.97%.
Uji digunakan untuk menguji hubungan antara dua variabel kategorik dalam tabel kontingensi \(2 \times 2\), terutama jika ukuran sampel kecil sehingga asumsi chi-square tidak terpenuhi.
Probabilitas tabel \(2 \times 2\) tertentu dihitung menggunakan rumus:
\[ P = \frac{(a+b)!(c+d)!(a+c)!(b+d)!}{a!b!c!d!n!} \]
dengan:
a,b,c,d = nilai dalam sel tabel
n = total keseluruhan
Sebuah studi ingin mengetahui apakah ada hubungan antara jenis kelamin (laki-laki/perempuan) dan hasil tes (lulus/gagal).
Data yang diperoleh:
\[ \begin{array}{|c|c|c|} \hline \textbf{} & \textbf{Lulus} & \textbf{Gagal} \\ \hline \textbf{Laki-laki} & 8 & 2 \\ \hline \textbf{Perempuan} & 1 & 5 \\ \hline \end{array} \] Sehingga: \[ a = 8, \quad b = 2, \quad c = 1, \quad d = 5, \quad n = 16\]
Gunakan rumus:
\[ P = \frac{(a+b)!(c+d)!(a+c)!(b+d)!}{a!b!c!d!n!} \]
Substitusi:
\[ P = \frac{(8+2)!(1+5)!(8+1)!(2+5)!}{8!2!1!5!16!} \]
Hitung faktorial:
\[ P = \frac{10! \times 6! \times 9! \times 7!}{8! \times 2! \times 1! \times 5! \times 16!} \]
Maka hasil \(P\) diperoleh sekitar \(0.0107\).
Kesimpulan
Karena nilai \(P\) kecil (\(P < 0.05\)), maka terdapat hubungan yang signifikan antara jenis kelamin dan hasil tes.
Residual dalam tabel kontingensi adalah selisih antara frekuensi observasi dengan ekspektasi, biasanya dibagi dengan deviasi standarnya agar bisa dibandingkan antar sel. Residual membantu mengidentifikasi pola atau hubungan spesifik dalam data yang mungkin tidak terlihat dari hasil uji global seperti \(\chi^2\).
\[ r_{ij} = \frac{n_{ij} - \hat{\mu}_{ij}}{\sqrt{\hat{\mu}_{ij}}} \]
Residual ini menunjukkan berapa banyak standar deviasi nilai observasi dari nilai yang diharapkan.
Pearson Residual:
\[ e_{ij} = \frac{O_{ij} - E_{ij}}{\sqrt{E_{ij}}} \]
Jika nilai \(|e_{ij}| > 2\), maka sel tersebut dianggap sebagai indikasi adanya outlier.
\[ r_{ij} = \frac{O_{ij} - E_{ij}}{\sqrt{E_{ij}(1-p_{i+})(1-p_{+j})}} \]
Jika \(|r_{ij}| > 3\), maka sel tersebut dianggap sebagai outlier signifikan.
Tabel kontingensi tiga arah adalah perpanjangan dari tabel kontingensi dua arah yang digunakan untuk menganalisis hubungan antara tiga variabel kategori secara simultan.
Tabel yg meengabaikan nilai Z pada 3 arah X,Y,Z Struktur Tabel Kontingensi Tiga Arah:
\[\begin{array}{|c|c|c|c|c|c|c|} \hline & Y = 1 & Y = 2 & \cdots & Y = J & Y = . \\ \hline Z = 1\quad X=1 & n_{111} & n_{121} & \cdots & n_{1J1} & n_{1+1} \\ X=2 & n_{211} & n_{221} & \cdots & n_{2J1} & n_{2+1} \\ \vdots & \vdots & \vdots & & \vdots & \vdots \\ X=i & n_{i11} & n_{i21} & \cdots & n_{iJ1} & n_{i+1} \\ \vdots & \vdots & \vdots & & \vdots & \vdots \\ X=I & n_{I11} & n_{I21} & \cdots & n_{IJ1} & n_{I+1} \\ \hline & n_{+11} & n_{+21} & \cdots & n_{+J1} & n_{++1} \\ \hline Z=k\quad X=1 & n_{11k} & n_{12k} & \cdots & n_{1Jk} & n_{1+k} \\ X=2 & n_{21k} & n_{22k} & \cdots & n_{2Jk} & n_{2+k} \\ \vdots & \vdots & \vdots & & \vdots & \vdots \\ X=i & n_{i1k} & n_{i2k} & \cdots & n_{iJk} & n_{i+k} \\ \vdots & \vdots & \vdots & & \vdots & \vdots \\ X=I & n_{I1k} & n_{I2k} & \cdots & n_{IJk} & n_{I+k} \\ \hline & n_{+1k} & n_{+2k} & \cdots & n_{+Jk} & n_{++k} \\ \hline Z=K\quad X=1 & n_{11K} & n_{12K} & \cdots & n_{1JK} & n_{1+K} \\ X=2 & n_{21K} & n_{22K} & \cdots & n_{2JK} & n_{2+K} \\ \vdots & \vdots & \vdots & & \vdots & \vdots \\ X=i & n_{i1K} & n_{i2K} & \cdots & n_{iJK} & n_{i+K} \\ \vdots & \vdots & \vdots & & \vdots & \vdots \\ X=I & n_{I1K} & n_{I2K} & \cdots & n_{IJK} & n_{I+K} \\ \hline & n_{+1K} & n_{+2K} & \cdots & n_{+JK} & n_{++K} \\ \hline & n_{1++} & n_{2++} & \cdots & n_{J++} & n_{+++} \\ \hline \end{array}\]
# Membuat tabel kontingensi
data <- matrix(c(45, 15, 60,
35, 10, 45,
25, 50, 75,
30, 40, 70,
15, 85, 100,
10, 90, 100),
nrow=6, byrow=TRUE)
colnames(data) <- c("Baik", "Buruk", "Total")
rownames(data) <- c("Rendah - Instagram", "Rendah - TikTok",
"Sedang - Instagram", "Sedang - TikTok",
"Tinggi - Instagram", "Tinggi - TikTok")
data
## Baik Buruk Total
## Rendah - Instagram 45 15 60
## Rendah - TikTok 35 10 45
## Sedang - Instagram 25 50 75
## Sedang - TikTok 30 40 70
## Tinggi - Instagram 15 85 100
## Tinggi - TikTok 10 90 100
Tabel Parsial
Hubungan antara dua variabel kategori dalam tabel kontingensi tiga arah dengan mempertahankan satu variabel sebagai kontrol
library(gmodels)
## Warning: package 'gmodels' was built under R version 4.3.3
# Membuat data tabel kontingensi 3 arah
data_medsos <- array(c(
45, 15, # Rendah - Instagram
35, 10, # Rendah - TikTok
25, 50, # Sedang - Instagram
30, 40, # Sedang - TikTok
15, 85, # Tinggi - Instagram
10, 90 # Tinggi - TikTok
), dim = c(2,2,3),
dimnames = list(
"Kesehatan Mental" = c("Baik", "Buruk"),
"Jenis Medsos" = c("Instagram", "TikTok"),
"Durasi" = c("Rendah", "Sedang", "Tinggi")
))
# Menampilkan tabel kontingensi parsial untuk masing-masing durasi
for (d in dimnames(data_medsos)$Durasi) {
cat("\nTabel Kontingensi untuk Durasi:", d, "\n")
print(data_medsos[, , d])
}
##
## Tabel Kontingensi untuk Durasi: Rendah
## Jenis Medsos
## Kesehatan Mental Instagram TikTok
## Baik 45 35
## Buruk 15 10
##
## Tabel Kontingensi untuk Durasi: Sedang
## Jenis Medsos
## Kesehatan Mental Instagram TikTok
## Baik 25 30
## Buruk 50 40
##
## Tabel Kontingensi untuk Durasi: Tinggi
## Jenis Medsos
## Kesehatan Mental Instagram TikTok
## Baik 15 10
## Buruk 85 90
Tabel Marginal
Jumlah total observasi untuk setiap variabel dengan mengabaikan variabel lainnya dalam tabel kontingensi tiga arah
# Definisikan data dalam bentuk array (3-way contingency table)
data_medsos <- array(
c(45, 15, 35, 10, # Durasi = Rendah
25, 50, 30, 40, # Durasi = Sedang
15, 85, 10, 90), # Durasi = Tinggi
dim = c(2, 2, 3),
dimnames = list(
"Kesehatan Mental" = c("Baik", "Buruk"),
"Media Sosial" = c("Instagram", "TikTok"),
"Durasi" = c("Rendah", "Sedang", "Tinggi")
)
)
# 1️⃣ Tabel Marginal Kesehatan Mental (Mengabaikan Media Sosial & Durasi)
marginal_kesehatan <- apply(data_medsos, c(1), sum)
print("Tabel Marginal Kesehatan Mental:")
## [1] "Tabel Marginal Kesehatan Mental:"
print(marginal_kesehatan)
## Baik Buruk
## 160 290
# 2️⃣ Tabel Marginal Media Sosial + Kesehatan Mental (Mengabaikan Durasi)
marginal_medsos_kesehatan <- apply(data_medsos, c(1,2), sum)
print("Tabel Marginal Media Sosial + Kesehatan Mental:")
## [1] "Tabel Marginal Media Sosial + Kesehatan Mental:"
print(marginal_medsos_kesehatan)
## Media Sosial
## Kesehatan Mental Instagram TikTok
## Baik 85 75
## Buruk 150 140
# 4️⃣ Tabel Marginal Durasi Penggunaan + Kesehatan Mental (Mengabaikan Media Sosial)
marginal_durasi_kesehatan <- apply(data_medsos, c(1,3), sum)
print("Tabel Marginal Durasi Penggunaan + Kesehatan Mental:")
## [1] "Tabel Marginal Durasi Penggunaan + Kesehatan Mental:"
print(marginal_durasi_kesehatan)
## Durasi
## Kesehatan Mental Rendah Sedang Tinggi
## Baik 80 55 25
## Buruk 25 90 175
# Hitung total responden
total_responden <- sum(data_medsos)
# Hitung Joint Probability dengan membagi setiap sel dengan total responden
joint_prob <- data_medsos / total_responden
# Cetak hasil
print("Joint Probability Table:")
## [1] "Joint Probability Table:"
print(joint_prob)
## , , Durasi = Rendah
##
## Media Sosial
## Kesehatan Mental Instagram TikTok
## Baik 0.10000000 0.07777778
## Buruk 0.03333333 0.02222222
##
## , , Durasi = Sedang
##
## Media Sosial
## Kesehatan Mental Instagram TikTok
## Baik 0.05555556 0.06666667
## Buruk 0.11111111 0.08888889
##
## , , Durasi = Tinggi
##
## Media Sosial
## Kesehatan Mental Instagram TikTok
## Baik 0.03333333 0.02222222
## Buruk 0.18888889 0.20000000
# Hitung total responden
total_responden <- sum(data_medsos)
# 1️⃣ P(Kesehatan Mental | Media Sosial, Durasi)
# Menjumlahkan berdasarkan Media Sosial & Durasi
sum_medsos_durasi <- apply(data_medsos, c(2,3), sum)
# Ubah agar dimensi sesuai untuk pembagian
sum_medsos_durasi <- array(sum_medsos_durasi, dim = c(2,2,3)) # Pastikan dimensi sama
# Hitung peluang bersyarat
cond_prob_kesehatan_given_medsos_durasi <- data_medsos / sum_medsos_durasi
# Cetak hasil
print("P(Kesehatan Mental | Media Sosial, Durasi):")
## [1] "P(Kesehatan Mental | Media Sosial, Durasi):"
print(cond_prob_kesehatan_given_medsos_durasi)
## , , Durasi = Rendah
##
## Media Sosial
## Kesehatan Mental Instagram TikTok
## Baik 0.7500000 0.4666667
## Buruk 0.3333333 0.1428571
##
## , , Durasi = Sedang
##
## Media Sosial
## Kesehatan Mental Instagram TikTok
## Baik 0.25 0.5000000
## Buruk 0.50 0.8888889
##
## , , Durasi = Tinggi
##
## Media Sosial
## Kesehatan Mental Instagram TikTok
## Baik 0.200000 0.1
## Buruk 1.214286 0.9
# 2️⃣ P(Media Sosial | Kesehatan Mental, Durasi)
# Menjumlahkan berdasarkan Kesehatan Mental & Durasi
sum_kesehatan_durasi <- apply(data_medsos, c(1,3), sum)
# Ubah agar dimensi sesuai untuk pembagian
sum_kesehatan_durasi <- array(sum_kesehatan_durasi, dim = c(2,2,3)) # Sesuaikan dimensi
# Hitung peluang bersyarat
cond_prob_medsos_given_kesehatan_durasi <- data_medsos / sum_kesehatan_durasi
# Cetak hasil
print("P(Media Sosial | Kesehatan Mental, Durasi):")
## [1] "P(Media Sosial | Kesehatan Mental, Durasi):"
print(cond_prob_medsos_given_kesehatan_durasi)
## , , Durasi = Rendah
##
## Media Sosial
## Kesehatan Mental Instagram TikTok
## Baik 0.5625 0.6363636
## Buruk 0.6000 0.1111111
##
## , , Durasi = Sedang
##
## Media Sosial
## Kesehatan Mental Instagram TikTok
## Baik 1.0000000 0.375
## Buruk 0.2857143 1.600
##
## , , Durasi = Tinggi
##
## Media Sosial
## Kesehatan Mental Instagram TikTok
## Baik 0.2727273 0.4000000
## Buruk 0.9444444 0.5142857
# 3️⃣ P(Durasi | Kesehatan Mental, Media Sosial)
# Menjumlahkan berdasarkan Kesehatan Mental & Media Sosial
sum_kesehatan_medsos <- apply(data_medsos, c(1,2), sum)
# Ubah agar dimensi sesuai untuk pembagian
sum_kesehatan_medsos <- array(sum_kesehatan_medsos, dim = c(2,2,3)) # Sesuaikan dimensi
# Hitung peluang bersyarat
cond_prob_durasi_given_kesehatan_medsos <- data_medsos / sum_kesehatan_medsos
# Cetak hasil
print("P(Durasi | Kesehatan Mental, Media Sosial):")
## [1] "P(Durasi | Kesehatan Mental, Media Sosial):"
print(cond_prob_durasi_given_kesehatan_medsos)
## , , Durasi = Rendah
##
## Media Sosial
## Kesehatan Mental Instagram TikTok
## Baik 0.5294118 0.46666667
## Buruk 0.1000000 0.07142857
##
## , , Durasi = Sedang
##
## Media Sosial
## Kesehatan Mental Instagram TikTok
## Baik 0.2941176 0.4000000
## Buruk 0.3333333 0.2857143
##
## , , Durasi = Tinggi
##
## Media Sosial
## Kesehatan Mental Instagram TikTok
## Baik 0.1764706 0.1333333
## Buruk 0.5666667 0.6428571
# Membuat tabel kontingensi untuk Instagram vs TikTok
tabel_medsos <- matrix(c(50, 25, 40, 30), nrow=2, byrow=TRUE)
colnames(tabel_medsos) <- c("Buruk", "Baik")
rownames(tabel_medsos) <- c("Instagram", "TikTok")
tabel_medsos
## Buruk Baik
## Instagram 50 25
## TikTok 40 30
# Menentukan probabilitas kejadian
P_instagram <- tabel_medsos[1,1] / sum(tabel_medsos[1,])
P_tiktok <- tabel_medsos[2,1] / sum(tabel_medsos[2,])
# Menghitung Risk Difference
RD <- P_instagram - P_tiktok
RD
## [1] 0.0952381
# Menghitung Risk Ratio
RR <- P_instagram / P_tiktok
RR
## [1] 1.166667
# Odds Ratio
# Menentukan nilai dari tabel kontingensi
# Menentukan nilai dari tabel kontingensi
a <- tabel_medsos[1,1] # Buruk, Instagram
b <- tabel_medsos[1,2] # Baik, Instagram
c <- tabel_medsos[2,1] # Buruk, TikTok
d <- tabel_medsos[2,2] # Baik, TikTok
# Menghitung Odds Ratio secara manual
OR_manual <- (a * d) / (b * c)
# Menampilkan hasil
OR_manual
## [1] 1.5
INTERPRETASI :
Independensi Bersyarat: Dua variabel, X dan Y , dikatakan independen bersyarat terhadap variabel ketiga, Z, jika rasio odds mereka dalam setiap strata Z sama dengan 1.
Metode Cochran-Mantel-Haenszel Tujuan Uji CMH Uji Cochran-Mantel-Haenszel (CMH) digunakan untuk menguji hubungan antara dua variabel kategori dengan mempertimbangkan efek dari variabel perancu.
# Memuat pustaka yang diperlukan
library(vcdExtra)
## Warning: package 'vcdExtra' was built under R version 4.3.3
## Loading required package: vcd
## Warning: package 'vcd' was built under R version 4.3.3
## Loading required package: grid
## Loading required package: gnm
## Warning: package 'gnm' was built under R version 4.3.3
# Membuat array 3 dimensi untuk data kontingensi
data_cmh <- array(c(
45, 15, 35, 10, # Rendah
25, 50, 30, 40, # Sedang
15, 85, 10, 90 # Tinggi
), dim = c(2,2,3),
dimnames = list(
"Kesehatan Mental" = c("Baik", "Buruk"),
"Media Sosial" = c("Instagram", "TikTok"),
"Durasi" = c("Rendah", "Sedang", "Tinggi")
))
# Menampilkan tabel kontingensi
print(data_cmh)
## , , Durasi = Rendah
##
## Media Sosial
## Kesehatan Mental Instagram TikTok
## Baik 45 35
## Buruk 15 10
##
## , , Durasi = Sedang
##
## Media Sosial
## Kesehatan Mental Instagram TikTok
## Baik 25 30
## Buruk 50 40
##
## , , Durasi = Tinggi
##
## Media Sosial
## Kesehatan Mental Instagram TikTok
## Baik 15 10
## Buruk 85 90
# Uji Cochran-Mantel-Haenszel (CMH)
cmh_test <- mantelhaen.test(data_cmh)
# Menampilkan hasil uji
print(cmh_test)
##
## Mantel-Haenszel chi-squared test with continuity correction
##
## data: data_cmh
## Mantel-Haenszel X-squared = 0.071932, df = 1, p-value = 0.7885
## alternative hypothesis: true common odds ratio is not equal to 1
## 95 percent confidence interval:
## 0.5819488 1.4391388
## sample estimates:
## common odds ratio
## 0.915153
INTERPRETASI:
Nilai common OR = 0.915 berarti bahwa peluang memiliki kesehatan mental baik bagi pengguna TikTok dibandingkan Instagram hampir sama, tetapi sedikit lebih rendah untuk TikTok. Penggunaan Instagram memiliki sedikit keunggulan dalam kesehatan mental dibandingkan TikTok, tetapi perbedaannya sangat kecil.
p-value = 0.7885 (> 0.05) → Tidak ada hubungan signifikan antara media sosial yang digunakan (TikTok vs. Instagram) dengan kesehatan mental, setelah mengontrol durasi penggunaan.
-Interval Kepercayaan 95% odds ratio 0.582 ≤ � ≤ 1.439 Karena Confidence Interval mencakup 1, maka kita tidak dapat menyimpulkan adanya pengaruh yang signifikan dari jenis media sosial terhadap kesehatan mental.
Jika nilai-nilai odds ratio bersyarat relatif sama (tidak berbeda secara ekstrem) dan memiliki arah yang sama, maka kita dapat menentukan sebuah nilai tunggal untuk odds ratio yang disebut odds ratio bersama.
• Odds ratio bersama ditaksir oleh statistik Mantel-Haenszel.
Perhitungan Odds Ratio Bersama
# Data dari tabel kontingensi 3 arah
data_medsos <- data.frame(
Media_Sosial = rep(c("TikTok", "Instagram"), each = 2),
Jenis_Kelamin = rep(c("Laki-laki", "Perempuan"), 2),
A = c(40, 30, 50, 45), # Kesehatan Baik
B = c(60, 70, 50, 55), # Kesehatan Buruk
C = c(50, 45, 40, 30), # Kontrol (baik)
D = c(50, 55, 60, 70) # Kontrol (buruk)
)
# Total N per strata
data_medsos$N <- data_medsos$A + data_medsos$B + data_medsos$C + data_medsos$D
# Hitung Common Odds Ratio (OR_MH)
OR_MH <- sum((data_medsos$A * data_medsos$D) / data_medsos$N) /
sum((data_medsos$B * data_medsos$C) / data_medsos$N)
# Log Odds Ratio
log_OR_MH <- log(OR_MH)
# Standard Error (SE) dari log(OR)
SE_log_OR <- sqrt(sum(1 / data_medsos$A + 1 / data_medsos$B +
1 / data_medsos$C + 1 / data_medsos$D))
# Interval Kepercayaan 95%
CI_lower <- exp(log_OR_MH - 1.96 * SE_log_OR)
CI_upper <- exp(log_OR_MH + 1.96 * SE_log_OR)
# Cetak hasil
cat("Common Odds Ratio (OR_MH):", round(OR_MH, 2), "\n")
## Common Odds Ratio (OR_MH): 1
cat("Log(OR_MH):", round(log_OR_MH, 3), "\n")
## Log(OR_MH): 0
cat("Standard Error (SE):", round(SE_log_OR, 3), "\n")
## Standard Error (SE): 0.583
cat("95% Confidence Interval: [", round(CI_lower, 2), ",", round(CI_upper, 2), "]\n")
## 95% Confidence Interval: [ 0.32 , 3.13 ]
INTERPRETASI :
OR_MH = 1 menunjukkan bahwa peluang memiliki kesehatan mental baik antara pengguna TikTok dan Instagram adalah sama.
Log(OR) = 0 karena log dari 1 adalah 0, yang mengonfirmasi bahwa tidak ada hubungan antara variabel.
SE = 0.583 menunjukkan adanya ketidakpastian dalam estimasi, tetapi tidak cukup besar untuk menyimpulkan efek yang kuat.
-Interval Kepercayaan 95% odds ratio 0.32 ≤ � ≤ 3.13 Karena Confidence Interval mencakup 1, maka tidak dapat menyimpulkan adanya pengaruh yang signifikan dari jenis media sosial terhadap kesehatan mental.
Asosiasi homogen terjadi jika odds ratio pada setiap tabel parsial bernilai sama Jika odds ratio konstan di semua strata variabel kontrol (Z), maka tidak ada interaksi antara variabel x dan y dalam pengaruhnya terhadap Z.
perhitungan
# Data: 3-way contingency table (Media Sosial, Kesehatan Mental, Durasi)
data_medsos <- array(
c(45, 15, 35, 10, # Durasi = Rendah
25, 50, 30, 40, # Durasi = Sedang
15, 85, 10, 90), # Durasi = Tinggi
dim = c(2, 2, 3),
dimnames = list(
"Kesehatan Mental" = c("Baik", "Buruk"),
"Media Sosial" = c("Instagram", "TikTok"),
"Durasi" = c("Rendah", "Sedang", "Tinggi")
)
)
data_medsos
## , , Durasi = Rendah
##
## Media Sosial
## Kesehatan Mental Instagram TikTok
## Baik 45 35
## Buruk 15 10
##
## , , Durasi = Sedang
##
## Media Sosial
## Kesehatan Mental Instagram TikTok
## Baik 25 30
## Buruk 50 40
##
## , , Durasi = Tinggi
##
## Media Sosial
## Kesehatan Mental Instagram TikTok
## Baik 15 10
## Buruk 85 90
# Fungsi Manual untuk Breslow-Day Test
breslow_day_test <- function(data) {
K <- dim(data)[3] # Jumlah strata (Durasi)
OR_k <- numeric(K) # Simpan OR per strata
W_k <- numeric(K) # Simpan weighting factor
sum_WOR <- 0 # Numerator dari statistik BD
sum_W <- 0 # Denominator dari statistik BD
for (k in 1:K) {
a <- data[1,1,k]
b <- data[1,2,k]
c <- data[2,1,k]
d <- data[2,2,k]
# Odds Ratio untuk tiap strata
OR_k[k] <- (a * d) / (b * c)
# Weighting Factor (Wald)
W_k[k] <- (1/a + 1/b + 1/c + 1/d)^(-1)
# Hitung numerator dan denominator
sum_WOR <- sum_WOR + W_k[k] * log(OR_k[k])
sum_W <- sum_W + W_k[k]
}
# Perhitungan Statistik Breslow-Day
BD_stat <- sum((W_k * (log(OR_k) - sum_WOR/sum_W))^2) / sum_W
# Approximate p-value (Chi-square dengan df = K - 1)
p_value <- 1 - pchisq(BD_stat, df = K - 1)
return(list("Breslow-Day Statistic" = BD_stat, "p-value" = p_value))
}
# Jalankan uji Breslow-Day
breslow_day_test(data_medsos)
## $`Breslow-Day Statistic`
## [1] 0.8541967
##
## $`p-value`
## [1] 0.6523994
INTERPRETASI : p-value (0.6523994) > 0.05 → Odds Ratio dianggap homogen di seluruh durasi penggunaan media sosial.
Model Linier Umum (GLM) merupakan perluasan dari regresi linier klasik. GLM memungkinkan kita memodelkan data ketika variabel respons tidak mengikuti distribusi normal dan/atau ketika hubungan antara variabel prediktor dengan ekspektasi respons bersifat non-linier.
GLM terdiri atas tiga komponen utama:
Distribusi termasuk dalam keluarga eksponensial jika dapat ditulis dalam bentuk:
\[ f(y; \theta, \phi) = \exp \left\{ \frac{y \theta - b(\theta)}{\phi} + c(y, \phi) \right\} \]
Beberapa contoh distribusi yang termasuk dalam keluarga eksponensial antara lain:
Contoh: Distribusi Binomial
Distribusi Binomial memiliki fungsi probabilitas:
\[ P(Y = y) = \binom{n}{y} \pi^y (1 - \pi)^{n - y} \]
Bentuk ini dapat ditulis ulang sebagai:
\[ P(Y = y) = \exp \left\{ \log \binom{n}{y} + y \log\left(\frac{\pi}{1 - \pi}\right) + n \log(1 - \pi) \right\} \]
Dengan substitusi:
Maka, distribusi binomial merupakan bagian dari keluarga eksponensial.
Model regresi logistik mirip dengan regresi linier, tetapi output dibatasi pada nilai antara 0 dan 1 melalui fungsi aktivasi sigmoid. Model ini sering digunakan dalam klasifikasi biner.
Fungsi Sigmoid
Fungsi sigmoid dinyatakan sebagai:
\[ f(x) = \frac{1}{1 + e^{-x}} \]
Interpretasi hasil prediksi:
Spesifikasi Model
Fungsi link (logit):
\[ g(\mu) = \log\left( \frac{\mu}{1 - \mu} \right) \]
Model regresi logistik:
\[ \log\left( \frac{\mu}{1 - \mu} \right) = X\beta \]
Fungsi inverse link:
\[ \mu = \frac{\exp(X\beta)}{1 + \exp(X\beta)} \]
Estimasi parameter
Estimasi parameter dilakukan dengan pendekatan Maximum Likelihood Estimation (MLE). Fungsi log-likelihood:
\[ l(\beta) = \sum_{i=1}^n \left[ y_i \log(\pi_i) + (1 - y_i) \log(1 - \pi_i) \right] \]
Dengan:
\[ \pi_i = \frac{\exp(x_i^T \beta)}{1 + \exp(x_i^T \beta)} \]
Estimasi dilakukan melalui iterasi Newton-Raphson atau algoritma Fisher Scoring.
Model regresi Poisson digunakan ketika variabel respons adalah count data (bilangan bulat non-negatif). Model ini mengasumsikan bahwa variabel respons mengikuti distribusi Poisson.
Fungsi Probabilitas
\[ P(Y = y) = \frac{e^{-\lambda} \lambda^y}{y!} \]
Bentuk ini dapat ditulis sebagai keluarga eksponensial:
\[ f(y; \theta) = \exp \left\{ y \log(\lambda) - \lambda - \log(y!) \right\} \]
Dengan:
\(\theta = \log(\lambda)\)
\(b(\theta) = e^\theta = \lambda\)
\(\phi = 1\)
\(c(y, \phi) = -\log(y!)\)
Fungsi Link
Fungsi link kanonik:
\[ g(\mu) = \log(\mu) \]
Sehingga model menjadi:
\[ \log(\mu_i) = x_i^T \beta \]
Dan fungsi inverse:
\[ \mu_i = \exp(x_i^T \beta) \]
Estimasi Parameter
Pendekatan MLE digunakan, dengan fungsi log-likelihood sebagai:
\[ l(\beta) = \sum_{i=1}^n \left[ y_i x_i^T \beta - \exp(x_i^T \beta) - \log(y_i!) \right] \]
Parameter \(\beta\) diestimasi menggunakan iterasi numerik seperti Newton-Raphson.
Catatan Overdispersi
Jika nilai dispersi \(> 1\), kemungkinan terjadi overdispersi, sehingga model alternatif seperti Regresi Binomial Negatif dapat dipertimbangkan.
Model Poisson sangat bermanfaat untuk memodelkan data cacah, namun penting untuk mewaspadai potensi overdispersi dalam penerapannya.
Generalized Linear Model (GLM) memerlukan pemahaman tentang ekspektasi dan varians dari estimator model. Hal ini menjadi dasar untuk melakukan inferensi statistik, seperti uji Wald, Likelihood Ratio Test, serta membentuk interval kepercayaan.
Ekspektasi menunjukkan apakah suatu estimator bersifat tidak bias (unbiased), dengan definisi matematis:
\[ \mathbb{E}[\hat{\beta}] = \beta \]
Pada GLM, estimator \(\hat{\beta}\) yang diperoleh dari metode Maximum Likelihood Estimation (MLE) bersifat asymptotically unbiased.
Varians mengindikasikan presisi dari estimasi parameter. Dengan sampel besar, varians dari \(\hat{\beta}\) dapat didekati oleh:
\[ \text{Var}(\hat{\beta}) \approx (\mathbf{X}^\top \mathbf{W} \mathbf{X})^{-1} \]
Dengan \(\mathbf{W}\) merupakan matriks bobot yang tergantung pada distribusi dan fungsi link yang digunakan.
Estimator asimptotik mengikuti distribusi normal:
\[ \hat{\beta} \sim \mathcal{N}(\beta, \text{Var}(\hat{\beta})) \]
Distribusi ini digunakan dalam: - Uji Wald - Confidence Interval - Perhitungan P-value
Berbeda dengan regresi linear biasa (OLS) yang mengasumsikan homoskedastisitas:
\[ \text{Var}(Y_i) = \sigma^2 \]
Dalam GLM, varian respon ditentukan oleh:
\[ \text{Var}(Y_i) = \phi V(\mu_i) \]
dengan \(\phi\) sebagai parameter dispersi dan \(V(\mu)\) sebagai fungsi varians.
Ekspektasi
Berdasarkan definisi fungsi momen:
\[ \mathbb{E}(Y) = \int y f(y; \theta) \, dy = \mu \]
Untuk distribusi dalam keluarga eksponensial:
\[ \log f(y; \theta) = y\theta - b(\theta) + c(y) \]
Maka score function:
\[ U(\theta) = \frac{\partial \ell}{\partial \theta} = y - b'(\theta) \]
Dengan ekspektasi score:
\[ \mathbb{E}[U(\theta)] = \mathbb{E}[y - b'(\theta)] = \mu - b'(\theta) = 0 \]
Sehingga:
\[ \mu = b'(\theta) \]
Turunan kedua log-likelihood:
\[ \frac{\partial^2 \ell}{\partial \theta^2} = -b''(\theta) \]
Sehingga:
\[ \text{Var}(Y) = b''(\theta) = \phi V(\mu) \]
MLE dilakukan dengan mencari nilai parameter yang memaksimalkan fungsi log-likelihood. Secara umum, langkah-langkahnya:
Karena bentuk GLM tidak eksplisit, diperlukan metode numerik seperti:
Iterasi Newton-Raphson:
\[ \beta^{(t+1)} = \beta^{(t)} - H^{-1}(\beta^{(t)}) U(\beta^{(t)}) \]
Mengukur kecocokan model dibanding model saturated:
\[ D = 2 \sum \left[ y_i \log \left( \frac{y_i}{\hat{\mu}_i} \right) - (y_i - \hat{\mu}_i) \right] \]
Mengukur apakah model lebih baik dibandingkan tanpa model:
\[ X^2 = \sum \frac{(y_i - \hat{\mu}_i)^2}{\hat{\mu}_i} \]
\[ \pi(x) = \frac{\exp(\beta_0 + \beta_1 x)}{1 + \exp(\beta_0 + \beta_1 x)} \]
\[ \ell(\beta) = \sum_{i=1}^n \left[ y_i \log(\pi_i) + (1 - y_i) \log(1 - \pi_i) \right] \]
\[ U(\beta) = \frac{\partial \ell}{\partial \beta} = \mathbf{X}^\top (y - \pi) \]
\[ H(\beta) = -\mathbf{X}^\top \mathbf{W} \mathbf{X}, \quad \text{dengan } \mathbf{W} = \text{diag}(\pi_i(1 - \pi_i)) \]
\[ \beta^{(t+1)} = \beta^{(t)} + (\mathbf{X}^\top \mathbf{W}^{(t)} \mathbf{X})^{-1} \mathbf{X}^\top (y - \pi^{(t)}) \]
Menggunakan uji Wald untuk menguji signifikansi parameter \(\beta_j\):
Jika \(\hat{\beta}_j\) mendekati distribusi normal:
\[ \hat{\beta}_j \sim \mathcal{N}(\beta_j, \text{Var}(\hat{\beta}_j)) \]
Maka statistik Z:
\[ Z = \frac{\hat{\beta}_j}{\text{SE}(\hat{\beta}_j)} \sim \mathcal{N}(0, 1) \]
Statistik Wald:
\[ W = Z^2 = \left( \frac{\hat{\beta}_j}{\text{SE}(\hat{\beta}_j)} \right)^2 \sim \chi^2_1 \]
\[ P(Y_i = y_i) = \frac{e^{-\lambda_i} \lambda_i^{y_i}}{y_i!} \]
\[ \log(\lambda_i) = \mathbf{x}_i^\top \beta \]
\[ \ell(\beta) = \sum_{i=1}^n \left[ y_i \log(\lambda_i) - \lambda_i - \log(y_i!) \right] \]
\[ \lambda_i = \exp(\mathbf{x}_i^\top \beta) \]
Log-likelihood: (sama seperti di atas)
Formulasi Iteratif:
\[ \beta^{(t+1)} = (\mathbf{X}^\top \mathbf{W}^{(t)} \mathbf{X})^{-1} \mathbf{X}^\top \mathbf{W}^{(t)} \mathbf{z}^{(t)} \]
Dengan:
Data diambil dari Jurnal Dunia Kesmas tahun 2023
Data Survei Aspek Kehidupan Rumah Tangga Indonesia Tahun 2014-2015 (IFLS 5)
| Ayah Perokok | Merokok (Ya) | Merokok (Tidak) | Total |
|---|---|---|---|
| Ya | 54 | 42 | 96 |
| Tidak | 9 | 26 | 35 |
tabel <- matrix(c(54, 42, 9, 26), nrow = 2, byrow = TRUE)
rownames(tabel) <- c("AyahPerokok_Ya", "AyahPerokok_Tidak")
colnames(tabel) <- c("Merokok_Ya", "Merokok_Tidak")
tabel
## Merokok_Ya Merokok_Tidak
## AyahPerokok_Ya 54 42
## AyahPerokok_Tidak 9 26
total <- sum(tabel)
total
## [1] 131
peluang_bersama <- tabel / total
peluang_bersama
## Merokok_Ya Merokok_Tidak
## AyahPerokok_Ya 0.41221374 0.3206107
## AyahPerokok_Tidak 0.06870229 0.1984733
Peluang bahwa seseorang merokok dan memiliki ayah perokok adalah 0,4
Peluang bahwa seseorang tidak merokok dan memiliki ayah perokok adalah 0,06
Peluang bahwa seseorang merokok dan tidak memiliki ayah perokok adalah 0,32
Peluang bahwa seseorang tidak merokok dan tidak memiliki ayah perokok adalah 0,19
peluang_marjinal_baris <- rowSums(peluang_bersama) # Ayah perokok
peluang_marjinal_kolom <- colSums(peluang_bersama) # Kebiasaan merokok
peluang_marjinal_baris
## AyahPerokok_Ya AyahPerokok_Tidak
## 0.7328244 0.2671756
peluang_marjinal_kolom
## Merokok_Ya Merokok_Tidak
## 0.480916 0.519084
Peluang seseorang memiliki ayah perokok adalah 0,73
Peluang seseorang tidak memiliki ayah perokok adalah 0,26
Peluang seseorang merokok adalah 0,48
Peluang seseorang tidak merokok adalah 0,51
a. Peluang Merokok berdasarkan Status Ayah
peluang_merokok_dengan_ayah <- tabel[ ,1] / rowSums(tabel)
names(peluang_merokok_dengan_ayah) <- c("AyahPerokok_Ya", "AyahPerokok_Tidak")
peluang_merokok_dengan_ayah
## AyahPerokok_Ya AyahPerokok_Tidak
## 0.5625000 0.2571429
Peluang seseorang merokok jika ayahnya perokok adalah 0,56
Peluang seseorang merokok jika ayahnya tidak merokok adalah 0,25
b. Peluang Ayah Perokok berdasarkan Status Merokok
peluang_ayah_dengan_merokok <- tabel[1, ] / colSums(tabel)
names(peluang_ayah_dengan_merokok) <- c("Merokok_Ya", "Merokok_Tidak")
peluang_ayah_dengan_merokok
## Merokok_Ya Merokok_Tidak
## 0.8571429 0.6176471
Peluang seseorang memiliki ayah perokok jika ia merokok adalah 0,85
Peluang seseorang memiliki ayah perokok jika ia tidak merokok adalah 0,61
# Data tabel kontingensi 2x2
tabel <- matrix(c(54, 42, 9, 26), nrow = 2, byrow = TRUE)
rownames(tabel) <- c("AyahPerokok_Ya", "AyahPerokok_Tidak")
colnames(tabel) <- c("Merokok_Ya", "Merokok_Tidak")
tabel
## Merokok_Ya Merokok_Tidak
## AyahPerokok_Ya 54 42
## AyahPerokok_Tidak 9 26
a <- tabel[1, 1] # 54
b <- tabel[1, 2] # 42
c <- tabel[2, 1] # 9
d <- tabel[2, 2] # 26
risk_exposed <- a / (a + b)
risk_unexposed <- c / (c + d)
RD <- risk_exposed - risk_unexposed
RD
## [1] 0.3053571
kemungkinan seseorang menjadi perokok meningkat sebesar 40% jika ayahnya juga seorang perokok, dibandingkan dengan jika ayahnya tidak merokok.
RR <- risk_exposed / risk_unexposed
RR
## [1] 2.1875
risiko merokok bagi seseorang yang ayahnya perokok adalah tiga kali lebih besar dibandingkan dengan mereka yang ayahnya tidak merokok.
OR <- (a * d) / (b * c)
OR
## [1] 3.714286
Nilai Odds Ratio sebesar 6 menunjukkan bahwa peluang (odds) seseorang menjadi perokok adalah enam kali lebih tinggi jika ayahnya adalah perokok dibandingkan dengan jika ayahnya bukan perokok.
# Data
x <- 63 # jumlah individu yang merokok
n <- 131 # total sampel
p_hat <- x / n # estimasi titik proporsi
# Estimasi titik
p_hat
## [1] 0.480916
Artinya, dari total 131 responden, sekitar 48,1% diketahui memiliki kebiasaan merokok.
# Estimasi interval (confidence interval 95%)
z <- 1.96
se <- sqrt(p_hat * (1 - p_hat) / n)
lower <- p_hat - z * se
upper <- p_hat + z * se
# Hasil interval
c(lower, upper)
## [1] 0.3953554 0.5664766
Dengan tingkat kepercayaan 95%, kita dapat menyatakan bahwa proporsi sebenarnya dari populasi yang merokok diperkirakan berada antara 39,5% hingga 56,6%.
Artinya, jika kita mengambil banyak sampel acak yang berukuran sama, sekitar 95% dari interval yang dihitung seperti ini akan mengandung proporsi sebenarnya dari populasi.
# Data dari tabel kontingensi
n11 <- 54 # Merokok, Ayah perokok
n12 <- 42 # Tidak merokok, Ayah perokok
n21 <- 9 # Merokok, Ayah tidak perokok
n22 <- 26 # Tidak merokok, Ayah tidak perokok
# Ukuran sampel tiap kelompok
n1_ <- n11 + n12 # Total dengan ayah perokok
n2_ <- n21 + n22 # Total dengan ayah tidak perokok
p1_hat <- n11 / n1_ # proporsi merokok dengan ayah perokok
p2_hat <- n21 / n2_ # proporsi merokok dengan ayah tidak perokok
p_hat <- (n11 + n21) / (n1_ + n2_)
p_hat
## [1] 0.480916
z <- (p1_hat - p2_hat) / sqrt(p_hat * (1 - p_hat) * (1/n1_ + 1/n2_))
z
## [1] 3.095199
Nilai statistik uji diperoleh sebesar
Z=3,10. Dengan menggunakan tingkat signifikansi α=0,05, nilai kritis dari distribusi normal standar adalah ±1,96. maka hipotesis nol yang menyatakan bahwa tidak ada perbedaan proporsi antara dua kelompok ditolak. Kesimpulan: Terdapat bukti statistik yang signifikan untuk menyatakan bahwa proporsi remaja yang merokok berbeda secara signifikan antara kelompok yang memiliki ayah perokok dan yang tidak.
# Data kontingensi
a <- 54 # Ayah perokok, anak merokok
b <- 42 # Ayah perokok, anak tidak merokok
c <- 9 # Ayah tidak merokok, anak merokok
d <- 26 # Ayah tidak merokok, anak tidak merokok
# Ukuran sampel tiap grup
n1 <- a + b # Total ayah perokok
n2 <- c + d # Total ayah tidak perokok
# Proporsi masing-masing
p1 <- a / n1
p2 <- c / n2
RD <- p1 - p2
SE_RD <- sqrt((p1 * (1 - p1)) / n1 + (p2 * (1 - p2)) / n2)
Z_RD <- RD / SE_RD
RR <- p1 / p2
SE_lnRR <- sqrt((1/a) - (1/n1) + (1/c) - (1/n2))
Z_RR <- log(RR) / SE_lnRR
OR <- (a * d) / (b * c)
SE_lnOR <- sqrt(1/a + 1/b + 1/c + 1/d)
Z_OR <- log(OR) / SE_lnOR
Tampilkan hasil
list(
Risk_Difference = RD,
SE_RD = SE_RD,
Z_RD = Z_RD,
Relative_Risk = RR,
SE_lnRR = SE_lnRR,
Z_RR = Z_RR,
Odds_Ratio = OR,
SE_lnOR = SE_lnOR,
Z_OR = Z_OR
)
## $Risk_Difference
## [1] 0.3053571
##
## $SE_RD
## [1] 0.08956117
##
## $Z_RD
## [1] 3.409482
##
## $Relative_Risk
## [1] 2.1875
##
## $SE_lnRR
## [1] 0.3010673
##
## $Z_RR
## [1] 2.599948
##
## $Odds_Ratio
## [1] 3.714286
##
## $SE_lnOR
## [1] 0.4380647
##
## $Z_OR
## [1] 2.995417
Interpretasi: Terdapat perbedaan absolut sebesar 30.5% dalam kemungkinan merokok antara anak yang memiliki ayah perokok dibandingkan yang tidak. Nilai Z_RD = 3.41 menunjukkan bahwa perbedaan ini signifikan secara statistik pada tingkat kepercayaan 95% (karena |Z| > 1.96), sehingga kita menolak hipotesis nol bahwa tidak ada perbedaan.
Interpretasi: Anak dari ayah perokok memiliki risiko merokok yang 2.19 kali lebih besar dibandingkan anak dari ayah non-perokok. Dengan nilai Z sebesar 2.60, hasil ini juga signifikan secara statistik pada taraf signifikansi 5%, mendukung adanya asosiasi kuat antara kebiasaan merokok ayah dan anak.
Interpretasi: Peluang anak merokok jika ayahnya perokok adalah 3.71 kali lebih besar dibandingkan jika ayahnya tidak merokok. Z_OR = 3.00 > 1.96 menunjukkan bahwa OR juga signifikan secara statistik, yang memperkuat kesimpulan adanya hubungan yang kuat dan signifikan antara variabel.
# Data kontingensi
kontingensi <- matrix(c(54, 42, 9, 26),
nrow = 2,
byrow = TRUE,
dimnames = list("Ayah" = c("Perokok", "Tidak Perokok"),
"Anak" = c("Merokok", "Tidak Merokok")))
# Menampilkan tabel
kontingensi
## Anak
## Ayah Merokok Tidak Merokok
## Perokok 54 42
## Tidak Perokok 9 26
# Uji Chi-Square
uji_chi <- chisq.test(kontingensi, correct = FALSE)
uji_chi
##
## Pearson's Chi-squared test
##
## data: kontingensi
## X-squared = 9.5803, df = 1, p-value = 0.001967
(p-value) = 0.001967 < 0,05 TOLAK H0 Terdapat hubungan yang signifikan secara statistik antara status merokok ayah dan kebiasaan merokok anak. Artinya, kebiasaan merokok seorang ayah mempengaruhi kemungkinan anaknya untuk merokok.
Data Bersumber dari buku “An Introduction To Statistical Modelling”
Data Uji Coba pemberian obat dan plasebo
| Treatment | Improved | No difference | Worse | Total |
|---|---|---|---|---|
| Placebo | 18 | 17 | 15 | 50 |
| Half dose | 20 | 10 | 20 | 50 |
| Full dose | 25 | 13 | 12 | 50 |
# Tabel 1: Randomized controlled trial
trial_data <- matrix(c(18, 17, 15,
20, 10, 20,
25, 13, 12),
nrow = 3,
byrow = TRUE,
dimnames = list(
Treatment = c("Placebo", "Half dose", "Full dose"),
Response = c("Improved", "No difference", "Worse")))
trial_data
## Response
## Treatment Improved No difference Worse
## Placebo 18 17 15
## Half dose 20 10 20
## Full dose 25 13 12
# Chi-Square
chisq.test(trial_data)
##
## Pearson's Chi-squared test
##
## data: trial_data
## X-squared = 5.1732, df = 4, p-value = 0.27
# G-squared
if (!require(DescTools)) install.packages("DescTools")
## Loading required package: DescTools
## Warning: package 'DescTools' was built under R version 4.3.3
## Registered S3 method overwritten by 'DescTools':
## method from
## reorder.factor gdata
library(DescTools)
GTest(trial_data)
##
## Log likelihood ratio (G-test) test of independence without correction
##
## data: trial_data
## G = 5.1291, X-squared df = 4, p-value = 0.2743
# Fisher test (tidak valid karena bukan tabel 2x2, tapi kita coba untuk lihat errornya)
tryCatch({
fisher.test(trial_data)
}, error = function(e) e)
##
## Fisher's Exact Test for Count Data
##
## data: trial_data
## p-value = 0.2885
## alternative hypothesis: two.sided
Artinya: tidak ada cukup bukti untuk menolak hipotesis nol.
Kesimpulan: Tidak ada hubungan yang signifikan antara variabel-variabel dalam tabel
Artinya: hasilnya sama dengan chi-squared test.
Kesimpulan: Tidak ada asosiasi yang signifikan antara variabel-variabel dalam tabel.
Kesimpulan: Fisher’s Exact Test juga menunjukkan tidak ada hubungan signifikan antara variabel.
# Data kontingensi
kontingensi <- matrix(c(54, 42, 9, 26),
nrow = 2,
byrow = TRUE,
dimnames = list(
"Ayah" = c("Perokok", "Tidak Perokok"),
"Anak" = c("Merokok", "Tidak Merokok")
))
# Uji Likelihood Ratio (G-Test) menggunakan package 'DescTools'
# Install jika belum tersedia
# install.packages("DescTools")
library(DescTools)
# Lakukan uji Likelihood Ratio (G-Test)
uji_likelihood <- GTest(kontingensi)
# Tampilkan hasil
uji_likelihood
##
## Log likelihood ratio (G-test) test of independence without correction
##
## data: kontingensi
## G = 9.93, X-squared df = 1, p-value = 0.001626
(p-value) = 0.001626 < 0,05 TOLAK H0 Terdapat hubungan yang signifikan secara statistik antara status merokok ayah dan kebiasaan merokok anak. Artinya, anak dari ayah yang merokok memiliki kecenderungan lebih tinggi untuk merokok, dibandingkan dengan anak dari ayah yang tidak merokok.
uji_fisher <- fisher.test(kontingensi)
# Tampilkan hasil
uji_fisher
##
## Fisher's Exact Test for Count Data
##
## data: kontingensi
## p-value = 0.002776
## alternative hypothesis: true odds ratio is not equal to 1
## 95 percent confidence interval:
## 1.477752 9.917529
## sample estimates:
## odds ratio
## 3.676977
(p-value) = 0.002776 < 0,05 TOLAK H0 maka H₀ ditolak pada tingkat signifikansi 5%. Artinya, terdapat hubungan yang signifikan secara statistik antara status merokok ayah dan kebiasaan merokok anak.
Anak dari ayah yang merokok memiliki peluang merokok sekitar 3,68 kali lebih tinggi dibandingkan dengan anak dari ayah yang tidak merokok.
Interval kepercayaan 95% untuk odds ratio (1.478 hingga 9.918) tidak mencakup angka 1, yang memperkuat bukti adanya asosiasi yang bermakna antara dua variabel tersebut.
# Total
N <- sum(kontingensi)
# Nilai harapan (expected values)
expected <- chisq.test(kontingensi)$expected
# Pearson Residual
pearson_residual <- (kontingensi - expected) / sqrt(expected)
pearson_residual
## Anak
## Ayah Merokok Tidak Merokok
## Perokok 1.152672 -1.109486
## Tidak Perokok -1.909007 1.837483
# Hitung probabilitas marginal
row_prop <- rowSums(kontingensi) / N
col_prop <- colSums(kontingensi) / N
# Buat matriks kosong untuk standardized residual
standardized_residual <- matrix(0, nrow = 2, ncol = 2)
rownames(standardized_residual) <- rownames(kontingensi)
colnames(standardized_residual) <- colnames(kontingensi)
# Hitung Standardized Residual (Adjusted Residual)
for (i in 1:2) {
for (j in 1:2) {
pij_row <- row_prop[i]
pij_col <- col_prop[j]
E_ij <- expected[i, j]
O_ij <- kontingensi[i, j]
standardized_residual[i, j] <- (O_ij - E_ij) / sqrt(E_ij * (1 - pij_row) * (1 - pij_col))
}
}
standardized_residual
## Merokok Tidak Merokok
## Perokok 3.095199 -3.095199
## Tidak Perokok -3.095199 3.095199
Perokok - Merokok (3.095199): Residual positif besar (> 2) → jumlah perokok yang merokok jauh lebih banyak daripada yang diharapkan. Ini signifikan.
Perokok - Tidak Merokok (-3.095199): Residual negatif besar (< -2) → jumlah perokok yang tidak merokok jauh lebih sedikit dari yang diharapkan. Ini signifikan.
Tidak Perokok - Merokok (-3.095199): Residual negatif besar (< -2) → jumlah tidak perokok yang merokok jauh lebih sedikit dari yang diharapkan. Ini signifikan.
Tidak Perokok - Tidak Merokok (3.095199): Residual positif besar (> 2) → jumlah tidak perokok yang tidak merokok jauh lebih banyak dari yang diharapkan. Ini signifikan.
Data diambil dari Jurnal Dunia Kesmas tahun 2023
Data Survei Aspek Kehidupan Rumah Tangga Indonesia Tahun 2014-2015 (IFLS 5)
\[ \begin{array}{|c|c|c|c|} \hline \textbf{Pengetahuan} & \textbf{Uang Saku} & \textbf{Merokok (Ya)} & \textbf{Merokok (Tidak)} \\ \hline \text{Rendah} & \text{Ya} & 15 & 10 \\ \text{Rendah} & \text{Tidak} & 10 & 10 \\ \text{Tinggi} & \text{Ya} & 21 & 15 \\ \text{Tinggi} & \text{Tidak} & 17 & 33 \\ \hline \end{array} \]
# Membuat tabel kontingensi
library(knitr)
## Warning: package 'knitr' was built under R version 4.3.3
data <- matrix(c(15, 10,
10, 10,
21, 15,
17, 33),
nrow = 4, byrow = TRUE)
rownames(data) <- c("Rendah - Ya", "Rendah - Tidak", "Tinggi - Ya", "Tinggi - Tidak")
colnames(data) <- c("Kebiasaan Merokok - Ya", "Kebiasaan Merokok - Tidak")
kable(data, caption = "Tabel Kontingensi Pengetahuan, Uang Saku, dan Kebiasaan Merokok")
| Kebiasaan Merokok - Ya | Kebiasaan Merokok - Tidak | |
|---|---|---|
| Rendah - Ya | 15 | 10 |
| Rendah - Tidak | 10 | 10 |
| Tinggi - Ya | 21 | 15 |
| Tinggi - Tidak | 17 | 33 |
# Menghitung frekuensi parsial (persentase per baris)
parsial <- prop.table(data, margin = 1)
kable(round(parsial, 3), caption = "Tabel Frekuensi Parsial (Per Baris)")
| Kebiasaan Merokok - Ya | Kebiasaan Merokok - Tidak | |
|---|---|---|
| Rendah - Ya | 0.600 | 0.400 |
| Rendah - Tidak | 0.500 | 0.500 |
| Tinggi - Ya | 0.583 | 0.417 |
| Tinggi - Tidak | 0.340 | 0.660 |
# Menghitung frekuensi marginal
marginal_rows <- margin.table(data, margin = 1)
marginal_cols <- margin.table(data, margin = 2)
# Membuat tabel marginal
marginal_table <- addmargins(data)
kable(marginal_table, caption = "Tabel Frekuensi Marginal (Penjumlahan Baris dan Kolom)")
| Kebiasaan Merokok - Ya | Kebiasaan Merokok - Tidak | Sum | |
|---|---|---|---|
| Rendah - Ya | 15 | 10 | 25 |
| Rendah - Tidak | 10 | 10 | 20 |
| Tinggi - Ya | 21 | 15 | 36 |
| Tinggi - Tidak | 17 | 33 | 50 |
| Sum | 63 | 68 | 131 |
# Peluang bersama
joint_prob <- prop.table(data)
kable(round(joint_prob, 3), caption = "Tabel Peluang Bersama")
| Kebiasaan Merokok - Ya | Kebiasaan Merokok - Tidak | |
|---|---|---|
| Rendah - Ya | 0.115 | 0.076 |
| Rendah - Tidak | 0.076 | 0.076 |
| Tinggi - Ya | 0.160 | 0.115 |
| Tinggi - Tidak | 0.130 | 0.252 |
# Peluang marjinal baris
marginal_row <- prop.table(margin.table(data, margin = 1))
# Peluang marjinal kolom
marginal_col <- prop.table(margin.table(data, margin = 2))
# Menampilkan
kable(round(marginal_row, 3), caption = "Peluang Marjinal Baris")
| x | |
|---|---|
| Rendah - Ya | 0.191 |
| Rendah - Tidak | 0.153 |
| Tinggi - Ya | 0.275 |
| Tinggi - Tidak | 0.382 |
kable(round(marginal_col, 3), caption = "Peluang Marjinal Kolom")
| x | |
|---|---|
| Kebiasaan Merokok - Ya | 0.481 |
| Kebiasaan Merokok - Tidak | 0.519 |
# Peluang bersyarat: P(Kebiasaan Merokok | Pengetahuan dan Uang Saku)
conditional_prob_row <- prop.table(data, margin = 1)
# Peluang bersyarat: P(Pengetahuan dan Uang Saku | Kebiasaan Merokok)
conditional_prob_col <- prop.table(data, margin = 2)
kable(round(conditional_prob_row, 3), caption = "Peluang Bersyarat: P(Kebiasaan Merokok | Pengetahuan dan Uang Saku)")
| Kebiasaan Merokok - Ya | Kebiasaan Merokok - Tidak | |
|---|---|---|
| Rendah - Ya | 0.600 | 0.400 |
| Rendah - Tidak | 0.500 | 0.500 |
| Tinggi - Ya | 0.583 | 0.417 |
| Tinggi - Tidak | 0.340 | 0.660 |
kable(round(conditional_prob_col, 3), caption = "Peluang Bersyarat: P(Pengetahuan dan Uang Saku | Kebiasaan Merokok)")
| Kebiasaan Merokok - Ya | Kebiasaan Merokok - Tidak | |
|---|---|---|
| Rendah - Ya | 0.238 | 0.147 |
| Rendah - Tidak | 0.159 | 0.147 |
| Tinggi - Ya | 0.333 | 0.221 |
| Tinggi - Tidak | 0.270 | 0.485 |
# Membuat tabel kontingensi 2x2
library(knitr)
# Misal kita ambil: Tinggi - Tidak vs Rendah - Ya
# Merokok | Tidak Merokok
data2x2 <- matrix(c(17, 33,
15, 10),
nrow = 2, byrow = TRUE)
rownames(data2x2) <- c("Tinggi - Tidak", "Rendah - Ya")
colnames(data2x2) <- c("Kebiasaan Merokok - Ya", "Kebiasaan Merokok - Tidak")
kable(data2x2, caption = "Tabel 2x2 untuk Perhitungan Ukuran Asosiasi")
| Kebiasaan Merokok - Ya | Kebiasaan Merokok - Tidak | |
|---|---|---|
| Tinggi - Tidak | 17 | 33 |
| Rendah - Ya | 15 | 10 |
Perhitungan RD, RR, OR
# Ambil data
a <- data2x2[1,1] # Eksposur & Outcome (+/+)
b <- data2x2[1,2] # Eksposur (+), Outcome (-)
c <- data2x2[2,1] # Non-Eksposur (-), Outcome (+)
d <- data2x2[2,2] # Non-Eksposur (-), Outcome (-)
# Hitung proporsi
risk_exposed <- a / (a + b)
risk_unexposed <- c / (c + d)
# Risk Difference (RD)
RD <- risk_exposed - risk_unexposed
# Relative Risk (RR)
RR <- risk_exposed / risk_unexposed
# Odds Ratio (OR)
OR <- (a*d) / (b*c)
# Hasil
RD
## [1] -0.26
RR
## [1] 0.5666667
OR
## [1] 0.3434343
Interpretasi
Risk Difference (RD) = -0,26
Artinya, risiko merokok pada kelompok ‘Tinggi - Tidak’ lebih rendah 26% dibandingkan kelompok ‘Rendah - Ya’.
Karena RD bernilai negatif, kelompok ‘Tinggi - Tidak’ lebih terlindungi terhadap kebiasaan merokok dibandingkan kelompok ‘Rendah - Ya’.
Relative Risk (RR) = 0,57
Risiko merokok pada kelompok ‘Tinggi - Tidak’ adalah sekitar 56,7% dari risiko merokok pada kelompok ‘Rendah - Ya’.
Karena RR < 1, ini menunjukkan bahwa memiliki pengetahuan tinggi dan tidak memiliki uang saku berkaitan dengan penurunan risiko merokok.
Odds Ratio (OR) = 0,34
Peluang (odds) merokok pada kelompok ‘Tinggi - Tidak’ sekitar 34% dibandingkan dengan peluang merokok pada kelompok ‘Rendah - Ya’.
Karena OR < 1, ini juga menunjukkan bahwa kelompok ‘Tinggi - Tidak’ cenderung lebih kecil kemungkinannya untuk merokok dibandingkan ‘Rendah - Ya’.
# Buat data
data <- data.frame(
Pengetahuan = rep(c("Rendah", "Tinggi"), each = 4),
Uang_Saku = rep(c("Ya", "Tidak"), each = 2, times = 2),
Kebiasaan_Merokok = rep(c("Ya", "Tidak"), times = 4),
Frekuensi = c(15, 10, 10, 10, 21, 15, 17, 33)
)
# Lihat data
print(data)
## Pengetahuan Uang_Saku Kebiasaan_Merokok Frekuensi
## 1 Rendah Ya Ya 15
## 2 Rendah Ya Tidak 10
## 3 Rendah Tidak Ya 10
## 4 Rendah Tidak Tidak 10
## 5 Tinggi Ya Ya 21
## 6 Tinggi Ya Tidak 15
## 7 Tinggi Tidak Ya 17
## 8 Tinggi Tidak Tidak 33
# Bikin tabel kontingensi untuk setiap strata Uang Saku
library(dplyr)
## Warning: package 'dplyr' was built under R version 4.3.3
##
## Attaching package: 'dplyr'
## The following object is masked from 'package:vcdExtra':
##
## summarise
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
# Pisahkan berdasarkan Uang Saku
data_ya <- data %>% filter(Uang_Saku == "Ya")
data_tidak <- data %>% filter(Uang_Saku == "Tidak")
# Bentuk tabel kontingensi untuk 'Ya'
table_ya <- xtabs(Frekuensi ~ Pengetahuan + Kebiasaan_Merokok, data = data_ya)
print(table_ya)
## Kebiasaan_Merokok
## Pengetahuan Tidak Ya
## Rendah 10 15
## Tinggi 15 21
# Bentuk tabel kontingensi untuk 'Tidak'
table_tidak <- xtabs(Frekuensi ~ Pengetahuan + Kebiasaan_Merokok, data = data_tidak)
print(table_tidak)
## Kebiasaan_Merokok
## Pengetahuan Tidak Ya
## Rendah 10 10
## Tinggi 33 17
# Uji chi-square pada masing-masing strata
chi_ya <- chisq.test(table_ya, correct = FALSE)
chi_tidak <- chisq.test(table_tidak, correct = FALSE)
# Tampilkan hasil
chi_ya
##
## Pearson's Chi-squared test
##
## data: table_ya
## X-squared = 0.016944, df = 1, p-value = 0.8964
chi_tidak
##
## Pearson's Chi-squared test
##
## data: table_tidak
## X-squared = 1.5435, df = 1, p-value = 0.2141
Strata Uang Saku = “Ya”:
Nilai p-value = 0,8964 (>> 0,05).
Artinya, Pengetahuan dan Kebiasaan Merokok adalah independen secara kondisional terhadap Uang Saku = Ya.
Kesimpulan: Tidak ada hubungan yang signifikan antara tingkat pengetahuan dan kebiasaan merokok pada siswa yang memiliki uang saku.
Strata Uang Saku = “Tidak”:
Nilai p-value = 0,2141 (> 0,05).
Artinya, Pengetahuan dan Kebiasaan Merokok juga independen secara kondisional terhadap Uang Saku = Tidak.
Kesimpulan: Tidak ada hubungan yang signifikan antara tingkat pengetahuan dan kebiasaan merokok pada siswa yang tidak memiliki uang saku.
# Data awal (berdasarkan tabel sebelumnya)
data <- array(
c(15, 10, # Pengetahuan Rendah, Uang Saku Ya
10, 10, # Pengetahuan Rendah, Uang Saku Tidak
21, 15, # Pengetahuan Tinggi, Uang Saku Ya
17, 33), # Pengetahuan Tinggi, Uang Saku Tidak
dim = c(2, 2, 2),
dimnames = list(
"Pengetahuan" = c("Rendah", "Tinggi"),
"Kebiasaan Merokok" = c("Ya", "Tidak"),
"Uang Saku" = c("Ya", "Tidak")
)
)
# Tampilkan data
data
## , , Uang Saku = Ya
##
## Kebiasaan Merokok
## Pengetahuan Ya Tidak
## Rendah 15 10
## Tinggi 10 10
##
## , , Uang Saku = Tidak
##
## Kebiasaan Merokok
## Pengetahuan Ya Tidak
## Rendah 21 17
## Tinggi 15 33
# Uji Cochran-Mantel-Haenszel
uji_cmh <- mantelhaen.test(data)
# Tampilkan hasil
uji_cmh
##
## Mantel-Haenszel chi-squared test with continuity correction
##
## data: data
## Mantel-Haenszel X-squared = 4.0528, df = 1, p-value = 0.0441
## alternative hypothesis: true common odds ratio is not equal to 1
## 95 percent confidence interval:
## 1.084462 4.446890
## sample estimates:
## common odds ratio
## 2.196015
Karena p-value = 0.0441 < 0.05, maka kita menolak hipotesis nol.
Ini berarti ada asosiasi yang signifikan antara Pengetahuan dan Kebiasaan Merokok, setelah mengontrol variabel Uang Saku.
Common Odds Ratio sebesar 2.196 menunjukkan bahwa individu dengan pengetahuan rendah memiliki kemungkinan sekitar 2,2 kali lebih besar untuk memiliki kebiasaan merokok dibandingkan individu dengan pengetahuan tinggi, setelah mengontrol pengaruh uang saku.
Karena interval kepercayaan (1.084, 4.447) tidak melewati 1, ini memperkuat bukti bahwa asosiasinya signifikan.
# Pastikan package DescTools terpasang
if (!require(DescTools)) install.packages("DescTools")
library(DescTools)
# Buat 2 strata berdasarkan Pengetahuan (Rendah dan Tinggi)
# Strata 1: Pengetahuan Rendah
# Baris: Uang Saku = Ya, Tidak
# Kolom: Merokok = Ya, Tidak
stratum1 <- matrix(c(15, 10, 10, 10), nrow = 2, byrow = TRUE)
# Strata 2: Pengetahuan Tinggi
stratum2 <- matrix(c(21, 15, 17, 33), nrow = 2, byrow = TRUE)
# Gabungkan jadi array 3D: [baris, kolom, strata]
data_array <- array(c(stratum1, stratum2),
dim = c(2, 2, 2),
dimnames = list(
UangSaku = c("Ya", "Tidak"),
Merokok = c("Ya", "Tidak"),
Pengetahuan = c("Rendah", "Tinggi")
)
)
# Lihat datanya
data_array
## , , Pengetahuan = Rendah
##
## Merokok
## UangSaku Ya Tidak
## Ya 15 10
## Tidak 10 10
##
## , , Pengetahuan = Tinggi
##
## Merokok
## UangSaku Ya Tidak
## Ya 21 15
## Tidak 17 33
# Jalankan Uji Breslow-Day
breslow_result <- BreslowDayTest(data_array)
# Tampilkan hasil
print(breslow_result)
##
## Breslow-Day test on Homogeneity of Odds Ratios
##
## data: data_array
## X-squared = 0.62104, df = 1, p-value = 0.4307
Nilai p-value = 0.4307 > 0.05
Artinya, tidak cukup bukti untuk menolak H₀
Kesimpulan: Odds ratio antara kelompok Pengetahuan Rendah dan Tinggi dapat dianggap homogen. Artinya, efek uang saku terhadap kebiasaan merokok konsisten di kedua strata pengetahuan.
# Buat data frame berdasarkan tabel kontingensi
data <- data.frame(
Merokok = c(rep(1,15), rep(0,10), # Rendah, Uang Saku Ya
rep(1,10), rep(0,10), # Rendah, Uang Saku Tidak
rep(1,21), rep(0,15), # Tinggi, Uang Saku Ya
rep(1,17), rep(0,33)), # Tinggi, Uang Saku Tidak
UangSaku = c(rep(1,25), rep(0,20), rep(1,36), rep(0,50)),
Pengetahuan = c(rep(0,45), rep(1,86)) # 0 = Rendah, 1 = Tinggi
)
data
# Fit regresi logistik
model <- glm(Merokok ~ UangSaku + Pengetahuan, data = data, family = binomial(link = "logit"))
# Lihat hasil estimasi beta
summary(model)
##
## Call:
## glm(formula = Merokok ~ UangSaku + Pengetahuan, family = binomial(link = "logit"),
## data = data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.2086 0.3621 -0.576 0.5646
## UangSaku 0.7907 0.3609 2.191 0.0284 *
## Pengetahuan -0.3634 0.3792 -0.958 0.3379
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 181.41 on 130 degrees of freedom
## Residual deviance: 175.00 on 128 degrees of freedom
## AIC: 181
##
## Number of Fisher Scoring iterations: 4
Koefisien logit: 0.7907 → odds ratio = exp(0.7907) ≈ 2.20
Interpretasi: Siswa yang memiliki uang saku memiliki peluang 2,2 kali lebih besar untuk merokok dibanding yang tidak punya uang saku, dengan asumsi tingkat pengetahuan yang sama.
Koefisien negatif → indikasi bahwa siswa dengan pengetahuan tinggi cenderung lebih kecil peluangnya merokok, tapi secara statistik belum cukup kuat (p > 0.05).Odds ratio = exp(-0.3634) ≈ 0.70
Plot Probabilitas
new_data <- data.frame(
UangSaku = seq(min(data$UangSaku), max(data$UangSaku), length.out = 100),
Pengetahuan = mean(data$Pengetahuan, na.rm = TRUE)
)
# Prediksi probabilitas
new_data$prob <- predict(model, newdata = new_data, type = "response")
# Plot
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 4.3.3
ggplot(new_data, aes(x = UangSaku, y = prob)) +
geom_line(color = "blue", size = 1.2) +
labs(
title = "Probabilitas Merokok berdasarkan Uang Saku",
x = "Uang Saku",
y = "Probabilitas Merokok"
) +
theme_minimal()
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
# Model regresi Poisson
model_poisson <- glm(Merokok ~ UangSaku + Pengetahuan,
family = poisson(link = "log"), data = data)
summary(model_poisson)
##
## Call:
## glm(formula = Merokok ~ UangSaku + Pengetahuan, family = poisson(link = "log"),
## data = data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.8314 0.2608 -3.188 0.00143 **
## UangSaku 0.4031 0.2568 1.570 0.11646
## Pengetahuan -0.1742 0.2598 -0.671 0.50247
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 92.240 on 130 degrees of freedom
## Residual deviance: 88.969 on 128 degrees of freedom
## AIC: 220.97
##
## Number of Fisher Scoring iterations: 5
μ=exp(−0.8314)≈0.435 Artinya, rata-rata jumlah yang merokok diperkirakan sekitar 0.435 orang jika uang saku dan pengetahuan = 0.
Signifikansi: Sangat signifikan (p = 0.00143, ditandai dengan **), artinya intercept ini secara statistik bermakna.
Plot Prediksi
# Buat data baru untuk prediksi
new_data <- data.frame(
UangSaku = seq(min(data$UangSaku), max(data$UangSaku), length.out = 100),
Pengetahuan = mean(data$Pengetahuan, na.rm = TRUE)
)
# Prediksi dari model Poisson
new_data$pred <- predict(model_poisson, newdata = new_data, type = "response")
# Visualisasi
library(ggplot2)
ggplot(new_data, aes(x = UangSaku, y = pred)) +
geom_line(color = "darkorange", size = 1.2) +
labs(
title = "Prediksi Jumlah Merokok berdasarkan Uang Saku",
x = "Uang Saku",
y = "Prediksi Jumlah Merokok (μ̂)"
) +
theme_minimal()
model_poisson <- glm(Merokok ~ UangSaku + Pengetahuan,
family = poisson(link = "log"), data = data)
# Hasil ringkasan model
summary(model_poisson)
##
## Call:
## glm(formula = Merokok ~ UangSaku + Pengetahuan, family = poisson(link = "log"),
## data = data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.8314 0.2608 -3.188 0.00143 **
## UangSaku 0.4031 0.2568 1.570 0.11646
## Pengetahuan -0.1742 0.2598 -0.671 0.50247
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 92.240 on 130 degrees of freedom
## Residual deviance: 88.969 on 128 degrees of freedom
## AIC: 220.97
##
## Number of Fisher Scoring iterations: 5
Interpretasi: Setiap kenaikan 1 unit UangSaku → log(μ) naik 0.4031, atau:
μ=exp(−0.4031)≈1.497
Artinya, jumlah merokok diprediksi meningkat sekitar 49.7% untuk setiap tambahan 1 unit UangSaku, dengan asumsi Pengetahuan tetap.
Signifikansi: p-value = 0.11646 → tidak signifikan pada tingkat 5%. Jadi, meskipun ada kecenderungan arah hubungan positif, tidak cukup bukti statistik bahwa UangSaku berpengaruh secara nyata terhadap jumlah merokok.
Interpretasi: Setiap kenaikan 1 unit Pengetahuan → log(μ) turun 0.1742, atau:
μ=exp(0.17421)≈0.840 Artinya, peningkatan Pengetahuan diprediksi menurunkan jumlah merokok sekitar 16%, dengan asumsi variabel lain konstan.
Signifikansi: p-value = 0.50247 → sangat tidak signifikan, menunjukkan bahwa Pengetahuan tidak memiliki pengaruh nyata dalam model ini.
# Ekspektasi (mean prediksi μ̂)
mu_hat <- predict(model_poisson, type = "response")
# Varians (untuk Poisson, varians = mean)
var_hat <- mu_hat
# Tambahkan ke data
data$mu_hat <- mu_hat
data$var_hat <- var_hat
# Lihat beberapa hasil
data[, c("UangSaku", "Pengetahuan", "Merokok", "mu_hat", "var_hat")]
# X: Desain matriks (dengan intercept)
X <- as.matrix(cbind(1, data$UangSaku, data$Pengetahuan))
# y: respon
y <- data$Merokok
# Inisialisasi beta (semua nol)
beta <- matrix(0, nrow = ncol(X), ncol = 1)
# Fungsi iterasi Newton-Raphson
newton_raphson_poisson <- function(X, y, beta_init, tol = 1e-6, max_iter = 100) {
beta <- beta_init
for (i in 1:max_iter) {
eta <- X %*% beta
mu <- exp(eta)
# Gradient (score function)
score <- t(X) %*% (y - mu)
# Hessian (second derivative)
W <- diag(as.vector(mu))
hessian <- - t(X) %*% W %*% X
# Update beta
beta_new <- beta - solve(hessian) %*% score
# Cek konvergensi
if (sum(abs(beta_new - beta)) < tol) {
cat("Konvergen di iterasi ke-", i, "\n")
break
}
beta <- beta_new
}
return(beta)
}
# Jalankan algoritma
beta_init <- matrix(0, nrow = ncol(X), ncol = 1)
beta_est <- newton_raphson_poisson(X, y, beta_init)
## Konvergen di iterasi ke- 6
# Tampilkan hasil
colnames(beta_est) <- "Estimate"
rownames(beta_est) <- c("Intercept", "UangSaku", "Pengetahuan")
beta_est
## Estimate
## Intercept -0.8313990
## UangSaku 0.4031486
## Pengetahuan -0.1742036
Artinya, jika UangSaku = 0 dan Pengetahuan = 0, maka jumlah merokok yang diprediksi adalah sekitar 0.435 orang.
Koefisien ini menunjukkan bahwa semakin besar uang saku, semakin besar kemungkinan orang tersebut merokok.
Dalam skala log: log(μ)↑0.4031⇒μ×exp(0.4031)≈μ×1.497 Artinya, setiap tambahan 1 unit uang saku, prediksi jumlah merokok naik sekitar 49.7% (dengan asumsi pengetahuan tetap).
Penurunan sekitar:
exp(−0.1742)≈0.84⇒turun sekitar 16%
# Desain matriks X (dengan intercept)
X <- as.matrix(cbind(1, data$UangSaku, data$Pengetahuan))
y <- data$Merokok
# Hitung mu dan matriks W
eta <- X %*% beta_est
mu <- exp(eta)
W <- diag(as.vector(mu))
# Fisher Information (negatif Hessian)
fisher_info <- t(X) %*% W %*% X
vcov_matrix <- solve(fisher_info)
# Standard Error
se_beta <- sqrt(diag(vcov_matrix))
# Z-value dan P-value
z_values <- as.vector(beta_est) / se_beta
p_values <- 2 * (1 - pnorm(abs(z_values)))
# Tabel hasil Wald test
wald_results <- data.frame(
Estimate = round(beta_est, 4),
Std_Error = round(se_beta, 4),
Z_value = round(z_values, 4),
P_value = round(p_values, 4),
row.names = c("Intercept", "UangSaku", "Pengetahuan")
)
wald_results
Baik UangSaku maupun Pengetahuan belum menunjukkan pengaruh signifikan terhadap merokok pada tingkat signifikansi 5%.
# Hitung AIC
aic_val <- AIC(model_poisson)
# Hitung BIC
bic_val <- BIC(model_poisson)
# Tampilkan hasil
cat("AIC:", aic_val, "\n")
## AIC: 220.969
cat("BIC:", bic_val, "\n")
## BIC: 229.5946
# Data
y <- data$Merokok
X <- model.matrix(~ UangSaku + Pengetahuan, data = data)
# Inisialisasi beta
beta <- rep(0, ncol(X))
# Fungsi log-link Poisson
g_inv <- function(eta) exp(eta)
# Iterasi IRLS
max_iter <- 100
tol <- 1e-6
for (i in 1:max_iter) {
eta <- X %*% beta
mu <- g_inv(eta)
W <- diag(as.vector(mu)) # Bobot
z <- eta + (y - mu) / mu # Working response
# Update beta dengan solusi weighted least squares
beta_new <- solve(t(X) %*% W %*% X) %*% t(X) %*% W %*% z
# Cek konvergensi
if (sum(abs(beta_new - beta)) < tol) {
cat("Konvergen di iterasi ke-", i, "\n")
break
}
beta <- beta_new
}
## Konvergen di iterasi ke- 6
# Tampilkan hasil
rownames(beta) <- colnames(X)
colnames(beta) <- "Estimate"
beta
## Estimate
## (Intercept) -0.8313990
## UangSaku 0.4031486
## Pengetahuan -0.1742036
Regresi logistik adalah metode statistik yang digunakan untuk memodelkan hubungan antara variabel respons biner dengan satu atau lebih variabel prediktor yang dapat memiliki skala pengukuran berbeda.
Variabel nominal adalah variabel kategori tanpa urutan logis antar kategori (misal: jenis kelamin, status pernikahan, wilayah). Dalam regresi logistik:
Dummy Coding: Setiap kategori (kecuali satu sebagai referensi) diubah menjadi variabel dummy (0/1).
Contoh: Jenis kelamin (Female = 1, Male = 0).
Catatan: Jangan mengasumsikan urutan atau jarak antar kategori.
2. Prediktor Ordinal
Variabel ordinal memiliki kategori berurutan namun jarak antar kategori belum tentu sama (misal: tingkat pendidikan, skala Likert).
Beri skor numerik (misal: SMA = 1, Sarjana = 2, Master = 3, Doktor = 4).
Asumsi: Efek linear pada log-odds
3. Prediktor Rasio
Variabel rasio adalah variabel numerik kontinu dengan nol absolut (misal: pendapatan, usia).
Data diambil dari penelitian:
Rahmadeni & Sarah Puspita (2023). “Aplikasi Regresi Logistik Ordinal dalam Pemodelan Status Gizi Balita” Puskesmas Limapuluh Kota Pekanbaru, 2018. Variabel:
Respon ordinal: Status Gizi Balita (kategori: gizi buruk, gizi kurang, gizi baik, gizi lebih)
Prediktor nominal: Jenis Kelamin (Laki-laki, Perempuan)
Prediktor ordinal: Usia Balita (kelompok umur)
Prediktor rasio: Berat Badan (kg)
library(MASS)
##
## Attaching package: 'MASS'
## The following object is masked from 'package:dplyr':
##
## select
library(ordinal)
## Warning: package 'ordinal' was built under R version 4.3.3
##
## Attaching package: 'ordinal'
## The following object is masked from 'package:dplyr':
##
## slice
# Contoh data simulasi berdasarkan data jurnal
set.seed(123)
data <- data.frame(
StatusGizi = factor(sample(c("Buruk", "Kurang", "Baik", "Lebih"), 190, replace = TRUE), ordered = TRUE),
JenisKelamin = factor(sample(c("Laki-laki", "Perempuan"), 190, replace = TRUE)),
UsiaBalita = ordered(sample(c("0-12", "13-24", "25-36", "37-48", "49-60"), 190, replace = TRUE)),
BeratBadan = runif(190, 5, 20) # berat badan dalam kg, skala rasio
)
# Fit model regresi logistik ordinal
model <- clm(StatusGizi ~ JenisKelamin + UsiaBalita + BeratBadan, data = data, link = "logit")
# Ringkasan hasil model
summary(model)
## formula: StatusGizi ~ JenisKelamin + UsiaBalita + BeratBadan
## data: data
##
## link threshold nobs logLik AIC niter max.grad cond.H
## logit flexible 190 -258.90 535.79 4(0) 3.27e-10 5.7e+03
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## JenisKelaminPerempuan -0.10988 0.26521 -0.414 0.679
## UsiaBalita.L -0.22848 0.32691 -0.699 0.485
## UsiaBalita.Q -0.43909 0.30760 -1.427 0.153
## UsiaBalita.C -0.02148 0.29266 -0.073 0.942
## UsiaBalita^4 0.12511 0.27405 0.457 0.648
## BeratBadan 0.01791 0.03152 0.568 0.570
##
## Threshold coefficients:
## Estimate Std. Error z value
## Baik|Buruk -0.7164 0.4383 -1.635
## Buruk|Kurang 0.2615 0.4358 0.600
## Kurang|Lebih 1.6439 0.4533 3.627
Interpretasi : Dataset berisi 190 observasi dengan variabel Status Gizi (ordinal), Jenis Kelamin (nominal), Usia Balita (ordinal), dan Berat Badan (rasio).
# Muat paket magrittr agar operator %>% tersedia
library(magrittr)
library(dplyr)
# Ringkasan distribusi variabel outcome (Status Gizi)
data %>% count(StatusGizi) %>% mutate(prop = n / sum(n))
# Rata-rata Berat Badan berdasarkan Status Gizi
data %>%
group_by(StatusGizi) %>%
summarise(rata_berat = mean(BeratBadan),
sd_berat = sd(BeratBadan),
n = n())
# Distribusi Status Gizi berdasarkan Jenis Kelamin
data %>%
group_by(JenisKelamin, StatusGizi) %>%
summarise(jumlah = n()) %>%
mutate(prop = jumlah / sum(jumlah))
## `summarise()` has grouped output by 'JenisKelamin'. You can override using the
## `.groups` argument.
# Distribusi Status Gizi berdasarkan Usia Balita
data %>%
group_by(UsiaBalita, StatusGizi) %>%
summarise(jumlah = n()) %>%
mutate(prop = jumlah / sum(jumlah))
## `summarise()` has grouped output by 'UsiaBalita'. You can override using the
## `.groups` argument.
Interpretasi :
Distribusi status gizi relatif merata, dengan proporsi terbesar pada kategori Baik dan Kurang (~29%), diikuti Buruk (~23%) dan Lebih (~19%).
Rata-rata berat badan balita berkisar antara 11.45 kg (kategori Buruk) hingga 12.63 kg (kategori Kurang), dengan variasi (SD) sekitar 4 kg, menunjukkan perbedaan berat badan yang moderat antar kategori status gizi.
Distribusi status gizi menurut jenis kelamin menunjukkan laki-laki sedikit lebih banyak pada kategori Lebih (23%) dibanding perempuan (15%), sedangkan perempuan sedikit lebih banyak pada kategori Kurang (31%) dibanding laki-laki (27%).
Distribusi status gizi menurut kelompok usia balita relatif konsisten, dengan sedikit penurunan proporsi kategori Lebih pada kelompok usia 0-12 bulan (13%) dibanding 13-24 bulan (17%).
# Mengubah StatusGizi menjadi faktor nominal (dummy coding)
data_nominal <- data %>%
mutate(
StatusGizi = factor(StatusGizi, levels = c("Buruk", "Kurang", "Baik", "Lebih")),
JenisKelamin = factor(JenisKelamin),
UsiaBalita = factor(UsiaBalita) # ubah ordinal ke nominal untuk model ini
)
# Membuat model regresi logistik biner contoh: prediksi StatusGizi "Baik" vs lainnya
# (karena regresi logistik biner, kita buat variabel target biner)
data_nominal <- data_nominal %>%
mutate(StatusBaik = ifelse(StatusGizi == "Baik", 1, 0))
model_nominal <- glm(StatusBaik ~ JenisKelamin + UsiaBalita + BeratBadan,
data = data_nominal,
family = binomial)
# Menampilkan ringkasan model
summary(model_nominal)
##
## Call:
## glm(formula = StatusBaik ~ JenisKelamin + UsiaBalita + BeratBadan,
## family = binomial, data = data_nominal)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.698421 0.521764 -1.339 0.181
## JenisKelaminPerempuan -0.202918 0.327576 -0.619 0.536
## UsiaBalita.L 0.266113 0.387296 0.687 0.492
## UsiaBalita.Q 0.281335 0.369226 0.762 0.446
## UsiaBalita.C -0.051911 0.364452 -0.142 0.887
## UsiaBalita^4 0.065676 0.341006 0.193 0.847
## BeratBadan -0.007817 0.038249 -0.204 0.838
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 228.64 on 189 degrees of freedom
## Residual deviance: 227.01 on 183 degrees of freedom
## AIC: 241.01
##
## Number of Fisher Scoring iterations: 4
Interpretasi
JenisKelamin (Perempuan dibanding baseline Laki-laki)
UsiaBalita (variabel ordinal yang dikodekan polinomial: linear (L), kuadratik (Q), kubik (C), orde 4)
BeratBadan (variabel kontinu rasio)
Semua prediktor tidak signifikan pada level 0.05.
Tidak ada variabel prediktor yang berpengaruh signifikan terhadap probabilitas balita memiliki status gizi “Baik” dalam model ini.
Model ini belum mampu menjelaskan variasi status gizi “Baik” secara memadai.
# Mengubah StatusGizi menjadi variabel biner untuk contoh regresi logistik
data <- data %>%
mutate(
StatusBaik = ifelse(StatusGizi == "Baik", 1, 0),
UsiaBalita_num = as.numeric(UsiaBalita), # ordinal diubah ke numeric rank
JenisKelamin = factor(JenisKelamin)
)
# Membuat model regresi logistik dengan UsiaBalita sebagai numeric rank
model_rasio <- glm(StatusBaik ~ JenisKelamin + UsiaBalita_num + BeratBadan,
data = data,
family = binomial)
# Menampilkan ringkasan model
summary(model_rasio)
##
## Call:
## glm(formula = StatusBaik ~ JenisKelamin + UsiaBalita_num + BeratBadan,
## family = binomial, data = data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.93734 0.68549 -1.367 0.171
## JenisKelaminPerempuan -0.20032 0.32569 -0.615 0.539
## UsiaBalita_num 0.08662 0.12441 0.696 0.486
## BeratBadan -0.01109 0.03770 -0.294 0.769
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 228.64 on 189 degrees of freedom
## Residual deviance: 227.61 on 186 degrees of freedom
## AIC: 235.61
##
## Number of Fisher Scoring iterations: 4
Interpretasi :
Semua prediktor tidak signifikan pada level 0.05.
Penurunan deviance sangat kecil, menunjukkan model dengan prediktor hanya sedikit lebih baik dari model intercept saja.
Tidak ada variabel prediktor yang berpengaruh signifikan terhadap probabilitas balita memiliki status gizi “Baik” dalam model ini.
Model ini belum mampu menjelaskan variasi status gizi “Baik” secara memadai.
# Model null (hanya intercept)
nullmod <- glm(StatusBaik ~ 1, data = data, family = binomial)
# Menghitung McFadden R2
r2_nominal <- 1 - (as.numeric(logLik(model_nominal)) / as.numeric(logLik(nullmod)))
r2_numeric <- 1 - (as.numeric(logLik(model_rasio)) / as.numeric(logLik(nullmod)))
# Menampilkan hasil
list(
McFadden_R2_Nominal = r2_nominal,
McFadden_R2_Numeric = r2_numeric
)
## $McFadden_R2_Nominal
## [1] 0.007132963
##
## $McFadden_R2_Numeric
## [1] 0.004488465
Interpretasi:
Nilai McFadden R² yang sangat kecil (mendekati nol) menunjukkan bahwa kedua model hanya sedikit lebih baik dibanding model null (intercept saja) dalam menjelaskan variasi data.
Model dengan prediktor nominal sedikit lebih baik daripada model dengan prediktor numeric rank, tetapi perbedaannya sangat kecil dan keduanya masih sangat rendah.
library(ggplot2)
#Menambahkan prediksi probabilitas pada data nominal
data_nominal <- data %>%
mutate(predicted_nominal = predict(model_nominal, type = "response"))
# Menambahkan prediksi probabilitas pada data numeric rank
data_rasio <- data %>%
mutate(predicted_rasio = predict(model_rasio, type = "response"))
# Visualisasi prediksi probabilitas model nominal berdasarkan BeratBadan dan JenisKelamin
ggplot(data_nominal, aes(x = BeratBadan, y = predicted_nominal, color = JenisKelamin)) +
geom_point(alpha = 0.6) +
labs(
title = "Prediksi Probabilitas Status Gizi 'Baik' (Model Nominal)",
x = "Berat Badan (kg)",
y = "Prediksi Probabilitas"
) +
theme_minimal()
# Menambahkan prediksi probabilitas ke data
class(data)
## [1] "data.frame"
library(tidyverse)
## Warning: package 'tidyverse' was built under R version 4.3.3
## Warning: package 'readr' was built under R version 4.3.3
## Warning: package 'forcats' was built under R version 4.3.3
## Warning: package 'lubridate' was built under R version 4.3.3
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ lubridate 1.9.3 ✔ tibble 3.2.1
## ✔ purrr 1.0.2 ✔ tidyr 1.3.0
## ✔ readr 2.1.5
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ tidyr::extract() masks magrittr::extract()
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ✖ MASS::select() masks dplyr::select()
## ✖ purrr::set_names() masks magrittr::set_names()
## ✖ ordinal::slice() masks dplyr::slice()
## ✖ dplyr::summarise() masks vcdExtra::summarise()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(dplyr)
data <- data %>% mutate(predicted = predict(model_rasio, type = "response"))
# Visualisasi prediksi probabilitas berdasarkan BeratBadan dan JenisKelamin
ggplot(data, aes(x = BeratBadan, y = predicted, color = JenisKelamin)) +
geom_point(alpha = 0.6) +
labs(
title = "Prediksi Probabilitas Status Gizi 'Baik' (Model Rasio)",
x = "Berat Badan (kg)",
y = "Prediksi Probabilitas"
) +
theme_minimal()
Interpretasi:
Model Nominal: Variasi prediksi probabilitas antar individu dan kelompok tampak lebih besar, dengan rentang prediksi yang sedikit lebih lebar (hingga sekitar 0.40).
Model Rasio: Prediksi probabilitas lebih terkonsentrasi dan cenderung lebih rendah secara umum, dengan rentang prediksi maksimal sekitar 0.36.
Model nominal (dummy coding) tampak lebih sensitif terhadap perbedaan kategori prediktor, sedangkan model rasio memberikan pola yang lebih halus namun dengan variasi yang lebih kecil.
library(broom)
library(kableExtra)
## Warning: package 'kableExtra' was built under R version 4.3.3
##
## Attaching package: 'kableExtra'
## The following object is masked from 'package:dplyr':
##
## group_rows
library(dplyr)
#Model Nominal
tidy(model_nominal, conf.int = TRUE) %>%
mutate(across(where(is.numeric), round, 3)) %>%
kable(format = "html",
caption = "Ringkasan Koefisien Model Nominal (tanpa Odds Ratio)",
booktabs = TRUE) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
## Warning: There was 1 warning in `mutate()`.
## ℹ In argument: `across(where(is.numeric), round, 3)`.
## Caused by warning:
## ! The `...` argument of `across()` is deprecated as of dplyr 1.1.0.
## Supply arguments directly to `.fns` through an anonymous function instead.
##
## # Previously
## across(a:b, mean, na.rm = TRUE)
##
## # Now
## across(a:b, \(x) mean(x, na.rm = TRUE))
| term | estimate | std.error | statistic | p.value | conf.low | conf.high |
|---|---|---|---|---|---|---|
| (Intercept) | -0.698 | 0.522 | -1.339 | 0.181 | -1.741 | 0.313 |
| JenisKelaminPerempuan | -0.203 | 0.328 | -0.619 | 0.536 | -0.853 | 0.436 |
| UsiaBalita.L | 0.266 | 0.387 | 0.687 | 0.492 | -0.492 | 1.035 |
| UsiaBalita.Q | 0.281 | 0.369 | 0.762 | 0.446 | -0.452 | 1.002 |
| UsiaBalita.C | -0.052 | 0.364 | -0.142 | 0.887 | -0.774 | 0.663 |
| UsiaBalita^4 | 0.066 | 0.341 | 0.193 | 0.847 | -0.608 | 0.736 |
| BeratBadan | -0.008 | 0.038 | -0.204 | 0.838 | -0.083 | 0.067 |
#Model Numeric
tidy(model_rasio, conf.int = TRUE) %>%
mutate(across(where(is.numeric), round, 3)) %>%
kable(format = "html",
caption = "Ringkasan Koefisien Model Numeric (tanpa Odds Ratio)",
booktabs = TRUE) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
| term | estimate | std.error | statistic | p.value | conf.low | conf.high |
|---|---|---|---|---|---|---|
| (Intercept) | -0.937 | 0.685 | -1.367 | 0.171 | -2.312 | 0.389 |
| JenisKelaminPerempuan | -0.200 | 0.326 | -0.615 | 0.539 | -0.846 | 0.435 |
| UsiaBalita_num | 0.087 | 0.124 | 0.696 | 0.486 | -0.157 | 0.333 |
| BeratBadan | -0.011 | 0.038 | -0.294 | 0.769 | -0.085 | 0.063 |
Analisis pendekatan konfirmatori dan eksploratori dalam penelitian kuantitatif memiliki karakteristik dan tujuan berbeda. Pendekatan konfirmatori digunakan untuk menguji teori yang telah dirumuskan sebelumnya, sementara pendekatan eksploratori bertujuan mengeksplorasi hubungan antar variabel tanpa asumsi awal.
Ciri utama:
Dibangun berdasarkan teori atau temuan penelitian sebelumnya untuk menguji validitas konstruk.
Menggunakan model persamaan struktural (SEM) dengan analisis faktor konfirmatori (CFA) untuk memverifikasi hubungan antara variabel laten dan indikator.
Fokus pada pengujian signifikansi efek melalui perbandingan model dengan uji rasio kemungkinan (Likelihood Ratio Test).
Contoh implementasi: Penelitian validasi skala psikologi menggunakan CFA untuk mengonfirmasi struktur faktor yang telah dihipotesiskan. Model dianggap fit jika memenuhi kriteria RMSEA <0.08 dan CFI >0.90.
Digunakan ketika belum ada teori yang mapan untuk menjelaskan fenomena.
Mengandalkan analisis faktor eksploratori (EFA) untuk mengidentifikasi pola hubungan antar variabel indikator.
Melibatkan teknik seleksi variabel bertahap (forward/backward selection) berdasarkan kriteria statistik seperti AIC.
Data sekunder dari Dinas Pendidikan Provinsi Maluku, meliputi 21 SMA di Kota Ambon dengan variabel:
Respon: Peringkat akreditasi SMA (ordinal: C = cukup, B = baik, A = amat baik)
Prediktor: Status sekolah (negeri/swasta), lama berdiri, jumlah siswa, jumlah guru, status tanah bangunan, nilai rata-rata UN
set.seed(123)
df_maluku <- data.frame(
LamaBerdiri = round(runif(100, 1, 50)),
JumlahSiswa = round(runif(100, 100, 1000)),
JumlahGuru = round(runif(100, 10, 100)),
NilaiUN = runif(100, 50, 100),
StatusTanah = sample(0:1, 100, replace = TRUE), # 0 = sewa, 1 = milik sendiri
StatusSekolah = sample(0:1, 100, replace = TRUE) # 0 = negeri, 1 = swasta
)
library(lavaan)
## Warning: package 'lavaan' was built under R version 4.3.3
## This is lavaan 0.6-19
## lavaan is FREE software! Please report any bugs.
model_cfa_maluku <- '
F1 =~ LamaBerdiri + JumlahSiswa + JumlahGuru
F2 =~ NilaiUN + StatusTanah + StatusSekolah
F1 ~~ F2
'
fit_cfa_maluku <- cfa(model_cfa_maluku, data = df_maluku)
## Warning: lavaan->lav_data_full():
## some observed variances are (at least) a factor 1000 times larger than
## others; use varTable(fit) to investigate
## Warning: lavaan->lav_lavaan_step11_estoptim():
## Model estimation FAILED! Returning starting values.
summary(fit_cfa_maluku, standardized = TRUE, fit.measures = TRUE)
## Warning: lavaan->lav_object_summary():
## fit measures not available if model did not converge
## lavaan 0.6-19 did NOT end normally after 552 iterations
## ** WARNING ** Estimates below are most likely unreliable
##
## Estimator ML
## Optimization method NLMINB
## Number of model parameters 13
##
## Number of observations 100
##
##
## Parameter Estimates:
##
## Standard errors Standard
## Information Expected
## Information saturated (h1) model Structured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## F1 =~
## LamaBerdiri 1.000 0.009 0.001
## JumlahSiswa 28771.581 NA 265.713 1.125
## JumlahGuru -260.807 NA -2.409 -0.091
## F2 =~
## NilaiUN 1.000 0.277 0.019
## StatusTanah -7.443 NA -2.063 -4.125
## StatusSekolah -0.044 NA -0.012 -0.025
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## F1 ~~
## F2 -0.000 NA -0.004 -0.004
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .LamaBerdiri 194.349 NA 194.349 1.000
## .JumlahSiswa -14801.599 NA -14801.599 -0.265
## .JumlahGuru 688.446 NA 688.446 0.992
## .NilaiUN 213.646 NA 213.646 1.000
## .StatusTanah -4.004 NA -4.004 -16.015
## .StatusSekolah 0.245 NA 0.245 0.999
## F1 0.000 NA 1.000 1.000
## F2 0.077 NA 1.000 1.000
Data sekunder dari Dinas Pendidikan Provinsi Maluku, meliputi 21 SMA di Kota Ambon dengan variabel:
Respon: Peringkat akreditasi SMA (ordinal: C = cukup, B = baik, A = amat baik)
Prediktor: Status sekolah (negeri/swasta), lama berdiri, jumlah siswa, jumlah guru, status tanah bangunan, nilai rata-rata UN
library(MASS)
# Misal data simulasi mirip struktur jurnal
set.seed(123)
n <- 100
StatusSekolah <- factor(sample(c("Negeri", "Swasta"), n, replace = TRUE))
LamaBerdiri <- round(runif(n, 1, 50))
JumlahSiswa <- round(runif(n, 100, 1000))
JumlahGuru <- round(runif(n, 10, 100))
StatusTanah <- factor(sample(c("Milik Sendiri", "Sewa"), n, replace = TRUE))
NilaiUN <- runif(n, 50, 100)
Akreditasi <- ordered(sample(c("C", "B", "A"), n, replace = TRUE), levels = c("C", "B", "A"))
data <- data.frame(Akreditasi, StatusSekolah, LamaBerdiri, JumlahSiswa, JumlahGuru, StatusTanah, NilaiUN)
# Model penuh
full_model <- polr(Akreditasi ~ StatusSekolah + LamaBerdiri + JumlahSiswa + JumlahGuru + StatusTanah + NilaiUN, data = data, Hess=TRUE)
# Model kosong (intercept saja)
null_model <- polr(Akreditasi ~ 1, data = data, Hess=TRUE)
# Stepwise forward
step_forward <- step(null_model, scope = formula(full_model), direction = "forward")
## Start: AIC=221.84
## Akreditasi ~ 1
##
## Df AIC
## + JumlahGuru 1 217.41
## + StatusTanah 1 221.39
## <none> 221.84
## + NilaiUN 1 222.00
## + JumlahSiswa 1 223.63
## + StatusSekolah 1 223.68
## + LamaBerdiri 1 223.72
##
## Step: AIC=217.41
## Akreditasi ~ JumlahGuru
##
## Df AIC
## <none> 217.41
## + NilaiUN 1 217.42
## + StatusTanah 1 217.64
## + JumlahSiswa 1 219.13
## + LamaBerdiri 1 219.37
## + StatusSekolah 1 219.40
# Stepwise backward
step_backward <- step(full_model, direction = "backward")
## Start: AIC=223.07
## Akreditasi ~ StatusSekolah + LamaBerdiri + JumlahSiswa + JumlahGuru +
## StatusTanah + NilaiUN
##
## Df AIC
## - LamaBerdiri 1 221.19
## - StatusSekolah 1 221.25
## - JumlahSiswa 1 221.43
## - NilaiUN 1 222.74
## <none> 223.07
## - StatusTanah 1 223.22
## - JumlahGuru 1 226.55
##
## Step: AIC=221.19
## Akreditasi ~ StatusSekolah + JumlahSiswa + JumlahGuru + StatusTanah +
## NilaiUN
##
## Df AIC
## - StatusSekolah 1 219.36
## - JumlahSiswa 1 219.50
## - NilaiUN 1 220.85
## <none> 221.19
## - StatusTanah 1 221.30
## - JumlahGuru 1 224.82
##
## Step: AIC=219.36
## Akreditasi ~ JumlahSiswa + JumlahGuru + StatusTanah + NilaiUN
##
## Df AIC
## - JumlahSiswa 1 217.68
## - NilaiUN 1 218.97
## - StatusTanah 1 219.34
## <none> 219.36
## - JumlahGuru 1 223.30
##
## Step: AIC=217.68
## Akreditasi ~ JumlahGuru + StatusTanah + NilaiUN
##
## Df AIC
## - StatusTanah 1 217.42
## - NilaiUN 1 217.64
## <none> 217.68
## - JumlahGuru 1 221.59
##
## Step: AIC=217.42
## Akreditasi ~ JumlahGuru + NilaiUN
##
## Df AIC
## - NilaiUN 1 217.41
## <none> 217.42
## - JumlahGuru 1 222.00
##
## Step: AIC=217.41
## Akreditasi ~ JumlahGuru
##
## Df AIC
## <none> 217.41
## - JumlahGuru 1 221.84
# Stepwise kedua arah
step_both <- step(null_model, scope = formula(full_model), direction = "both")
## Start: AIC=221.84
## Akreditasi ~ 1
##
## Df AIC
## + JumlahGuru 1 217.41
## + StatusTanah 1 221.39
## <none> 221.84
## + NilaiUN 1 222.00
## + JumlahSiswa 1 223.63
## + StatusSekolah 1 223.68
## + LamaBerdiri 1 223.72
##
## Step: AIC=217.41
## Akreditasi ~ JumlahGuru
##
## Df AIC
## <none> 217.41
## + NilaiUN 1 217.42
## + StatusTanah 1 217.64
## + JumlahSiswa 1 219.13
## + LamaBerdiri 1 219.37
## + StatusSekolah 1 219.40
## - JumlahGuru 1 221.84
summary(step_both)
## Call:
## polr(formula = Akreditasi ~ JumlahGuru, data = data, Hess = TRUE)
##
## Coefficients:
## Value Std. Error t value
## JumlahGuru 0.01825 0.007328 2.49
##
## Intercepts:
## Value Std. Error t value
## C|B -0.0587 0.4330 -0.1356
## B|A 1.5483 0.4626 3.3473
##
## Residual Deviance: 211.4146
## AIC: 217.4146
library(pROC)
## Warning: package 'pROC' was built under R version 4.3.3
## Type 'citation("pROC")' for a citation.
##
## Attaching package: 'pROC'
## The following object is masked from 'package:gmodels':
##
## ci
## The following objects are masked from 'package:stats':
##
## cov, smooth, var
library(pROC)
# Simulasi data biner outcome (misal sukses akreditasi A vs bukan A)
set.seed(123)
n <- 100
StatusSekolah <- factor(sample(c("Negeri", "Swasta"), n, replace = TRUE))
LamaBerdiri <- round(runif(n, 1, 50))
JumlahSiswa <- round(runif(n, 100, 1000))
JumlahGuru <- round(runif(n, 10, 100))
StatusTanah <- factor(sample(c("Milik Sendiri", "Sewa"), n, replace = TRUE))
NilaiUN <- runif(n, 50, 100)
Akreditasi <- factor(sample(c("C", "B", "A"), n, replace = TRUE), ordered = TRUE)
# Membuat variabel biner: 1 jika Akreditasi A, 0 jika bukan
y <- ifelse(Akreditasi == "A", 1, 0)
data <- data.frame(y = factor(y), StatusSekolah, LamaBerdiri, JumlahSiswa, JumlahGuru, StatusTanah, NilaiUN)
# Model regresi logistik biner
model_logistic <- glm(y ~ StatusSekolah + LamaBerdiri + JumlahSiswa + JumlahGuru + StatusTanah + NilaiUN,
data = data, family = binomial)
# Prediksi probabilitas
pred_prob <- predict(model_logistic, type = "response")
# Membuat objek ROC
roc_obj <- roc(data$y, pred_prob)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
# Plot kurva ROC
plot(roc_obj, main = "ROC Curve Model Regresi Logistik Akreditasi SMA Maluku")
# Menghitung AUC
auc_value <- auc(roc_obj)
print(paste("AUC:", round(auc_value, 3)))
## [1] "AUC: 0.683"
set.seed(123)
n <- 100
# Simulasi variabel prediktor sesuai data Maluku
StatusSekolah <- factor(sample(c("Negeri", "Swasta"), n, replace = TRUE))
LamaBerdiri <- round(runif(n, 1, 50))
JumlahSiswa <- round(runif(n, 100, 1000))
JumlahGuru <- round(runif(n, 10, 100))
StatusTanah <- factor(sample(c("Milik Sendiri", "Sewa"), n, replace = TRUE))
NilaiUN <- runif(n, 50, 100)
# Outcome biner: Akreditasi A (1) vs selainnya (0)
Akreditasi <- factor(sample(c("C", "B", "A"), n, replace = TRUE), ordered = TRUE)
y <- ifelse(Akreditasi == "A", 1, 0)
data_maluku <- data.frame(
y = factor(y),
StatusSekolah,
LamaBerdiri,
JumlahSiswa,
JumlahGuru,
StatusTanah,
NilaiUN
)
# Model penuh
model_full <- glm(y ~ StatusSekolah + LamaBerdiri + JumlahSiswa + JumlahGuru + StatusTanah + NilaiUN,
data = data_maluku, family = binomial)
# Model nol (intercept saja)
model_null <- glm(y ~ 1, data = data_maluku, family = binomial)
# Stepwise regression (arah kedua)
model_start <- glm(y ~ 1, data = data_maluku, family = binomial)
model_stepwise <- step(model_start, scope = list(lower = model_start, upper = model_full), direction = "both", trace = 0)
# Fungsi hitung Pseudo R2
logisticPseudoR2s <- function(model) {
dev <- model$deviance
nullDev <- model$null.deviance
n <- length(model$fitted.values)
R_l <- 1 - dev / nullDev # Hosmer and Lemeshow R2 (McFadden)
R_cs <- 1 - exp(-(nullDev - dev) / n) # Cox and Snell R2
R_n <- R_cs / (1 - exp(-nullDev / n)) # Nagelkerke R2
cat("Pseudo R^2 for logistic regression\n")
cat("Hosmer and Lemeshow R^2:", round(R_l, 4), "\n")
cat("Cox and Snell R^2:", round(R_cs, 4), "\n")
cat("Nagelkerke R^2:", round(R_n, 4), "\n")
}
# Hitung Pseudo R2 untuk model stepwise
logisticPseudoR2s(model_stepwise)
## Pseudo R^2 for logistic regression
## Hosmer and Lemeshow R^2: 0.0813
## Cox and Snell R^2: 0.1016
## Nagelkerke R^2: 0.1388
# Lihat ringkasan model stepwise
summary(model_stepwise)
##
## Call:
## glm(formula = y ~ JumlahGuru + StatusTanah + NilaiUN, family = binomial,
## data = data_maluku)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.958783 1.379619 -2.145 0.0320 *
## JumlahGuru 0.020057 0.008598 2.333 0.0197 *
## StatusTanahSewa -0.751322 0.439795 -1.708 0.0876 .
## NilaiUN 0.021682 0.015326 1.415 0.1571
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 131.79 on 99 degrees of freedom
## Residual deviance: 121.07 on 96 degrees of freedom
## AIC: 129.07
##
## Number of Fisher Scoring iterations: 4
# Fit model regresi logistik biner
model <- glm(y ~ StatusSekolah + LamaBerdiri + JumlahSiswa + JumlahGuru + StatusTanah + NilaiUN,
data = data_maluku, family = binomial)
# Prediksi probabilitas
prob <- predict(model, type = "response")
# Tentukan cutoff threshold 0.5 untuk klasifikasi
pred_class <- ifelse(prob >= 0.5, 1, 0)
# Buat tabel klasifikasi (confusion matrix)
table_klasifikasi <- table(Predicted = pred_class, Actual = as.numeric(as.character(data_maluku$y)))
print(table_klasifikasi)
## Actual
## Predicted 0 1
## 0 50 24
## 1 13 13
# Menghitung metrik evaluasi
TP <- table_klasifikasi["1", "1"] # True Positive
TN <- table_klasifikasi["0", "0"] # True Negative
FP <- table_klasifikasi["1", "0"] # False Positive
FN <- table_klasifikasi["0", "1"] # False Negative
accuracy <- (TP + TN) / sum(table_klasifikasi)
sensitivity <- TP / (TP + FN) # Recall
specificity <- TN / (TN + FP)
precision <- TP / (TP + FP)
cat("Evaluasi Model:\n")
## Evaluasi Model:
cat(sprintf("Accuracy : %.3f\n", accuracy))
## Accuracy : 0.630
cat(sprintf("Sensitivity : %.3f\n", sensitivity))
## Sensitivity : 0.351
cat(sprintf("Specificity : %.3f\n", specificity))
## Specificity : 0.794
cat(sprintf("Precision : %.3f\n", precision))
## Precision : 0.500
Kesimpulan:
Accuracy (0.630): Model secara keseluruhan benar mengklasifikasikan 63% dari total data. Ini menunjukkan performa model sedang, tidak sangat baik tapi juga tidak buruk.
Sensitivity (Recall) (0.351): Model hanya mampu mendeteksi 35.1% dari kasus positif sebenarnya (kelas 1). Ini berarti banyak kasus positif yang terlewat (false negative cukup tinggi), sehingga model kurang sensitif dalam mengenali kelas positif.
Specificity (0.794): Model mampu mengenali 79.4% kasus negatif dengan benar (kelas 0). Ini menunjukkan model cukup baik dalam mengidentifikasi kelas negatif.
Precision (0.500): Dari semua prediksi positif yang dibuat model, 50% benar-benar positif. Ini menunjukkan tingkat kesalahan prediksi positif cukup tinggi (false positive juga signifikan).
Tujuannya menyajikan cara membandingkan model regresi logistik menggunakan ukuran: - Deviance - AIC (Akaike Information Criterion) - Likelihood-Ratio serta menjelaskan prinsip Parsimony dalam pemilihan model.
# Model 1: hanya dua prediktor
model1 <- glm(y ~ LamaBerdiri + StatusSekolah, data = data_maluku, family = binomial)
# Model 2: semua prediktor
model2 <- glm(y ~ LamaBerdiri + StatusSekolah + JumlahSiswa + JumlahGuru + StatusTanah + NilaiUN,
data = data_maluku, family = binomial)
# Ringkasan model
summary(model1)
##
## Call:
## glm(formula = y ~ LamaBerdiri + StatusSekolah, family = binomial,
## data = data_maluku)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.310277 0.486539 -0.638 0.524
## LamaBerdiri -0.009189 0.016257 -0.565 0.572
## StatusSekolahSwasta 0.039748 0.421088 0.094 0.925
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 131.79 on 99 degrees of freedom
## Residual deviance: 131.47 on 97 degrees of freedom
## AIC: 137.47
##
## Number of Fisher Scoring iterations: 4
summary(model2)
##
## Call:
## glm(formula = y ~ LamaBerdiri + StatusSekolah + JumlahSiswa +
## JumlahGuru + StatusTanah + NilaiUN, family = binomial, data = data_maluku)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.3400869 1.6145367 -1.449 0.1472
## LamaBerdiri -0.0093758 0.0175548 -0.534 0.5933
## StatusSekolahSwasta 0.0170079 0.4592096 0.037 0.9705
## JumlahSiswa -0.0004745 0.0008714 -0.545 0.5860
## JumlahGuru 0.0202637 0.0087685 2.311 0.0208 *
## StatusTanahSewa -0.7973998 0.4557165 -1.750 0.0802 .
## NilaiUN 0.0201053 0.0155111 1.296 0.1949
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 131.79 on 99 degrees of freedom
## Residual deviance: 120.54 on 93 degrees of freedom
## AIC: 134.54
##
## Number of Fisher Scoring iterations: 4
# Perbandingan AIC
cat("AIC Model 1:", AIC(model1), "\n")
## AIC Model 1: 137.4686
cat("AIC Model 2:", AIC(model2), "\n")
## AIC Model 2: 134.5409
# Perbandingan Deviance
cat("Deviance Model 1:", deviance(model1), "\n")
## Deviance Model 1: 131.4686
cat("Deviance Model 2:", deviance(model2), "\n")
## Deviance Model 2: 120.5409
# Uji Likelihood Ratio Test (LRT) antara model 1 dan model 2
lrt <- anova(model1, model2, test = "Chisq")
print(lrt)
## Analysis of Deviance Table
##
## Model 1: y ~ LamaBerdiri + StatusSekolah
## Model 2: y ~ LamaBerdiri + StatusSekolah + JumlahSiswa + JumlahGuru +
## StatusTanah + NilaiUN
## Resid. Df Resid. Dev Df Deviance Pr(>Chi)
## 1 97 131.47
## 2 93 120.54 4 10.928 0.02739 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Jika penurunan AIC tidak signifkan, pilih model lebih sederhana. Parsimony mencegah overftting.
\[ \text{AIC} = -2 \log L + 2k \]
AIC adalah kriteria untuk memilih model terbaik dengan mempertimbangkan keseimbangan antara goodness-of-fit dan kompleksitas model (jumlah parameter \(k\)). Model dengan nilai AIC lebih kecil dianggap lebih baik karena memberikan fit yang baik tanpa overfitting.
\[ D = -2 \left[ \log L(\text{model}) - \log L(\text{model saturasi}) \right] \]
Deviance mengukur seberapa jauh model yang diestimasi dari model saturasi (model sempurna). Nilai deviance yang lebih kecil menunjukkan model yang lebih baik dalam menjelaskan data.
\[ G^2 = -2 \left( \log L_0 - \log L_1 \right) \]
LRT digunakan untuk membandingkan dua model bersarang: model sederhana (\(L_0\)) dan model kompleks (\(L_1\)). Statistik \(G^2\) mengikuti distribusi chi-square dengan derajat kebebasan sesuai selisih jumlah parameter. Jika p-value kecil, model kompleks secara signifikan lebih baik.
# Outcome biner: kasus perceraian terdeteksi (1) atau tidak (0)
jumlah_pulau <- rpois(n, lambda = 3)
jarak_ibu_kota <- runif(n, 10, 200) # dalam km
luas_kabupaten <- runif(n, 500, 5000) # dalam km2
lin_pred <- -2 + 0.5 * jumlah_pulau - 0.01 * jarak_ibu_kota + 0.0002 * luas_kabupaten
p <- 1 / (1 + exp(-lin_pred))
y <- rbinom(n, 1, p)
df <- data.frame(
y = factor(y),
jumlah_pulau,
jarak_ibu_kota,
luas_kabupaten
)
# Bangun model regresi logistik
model <- glm(y ~ jumlah_pulau + jarak_ibu_kota + luas_kabupaten, data = df, family = binomial)
# Prediksi probabilitas
prob <- predict(model, type = "response")
# Tentukan cutoff threshold 0.5 untuk klasifikasi
pred_class <- ifelse(prob >= 0.5, 1, 0)
# Buat tabel klasifikasi (confusion matrix)
conf_matrix <- table(Predicted = pred_class, Actual = as.numeric(as.character(df$y)))
print(conf_matrix)
## Actual
## Predicted 0 1
## 0 73 18
## 1 4 5
# Hitung akurasi
accuracy <- sum(diag(conf_matrix)) / sum(conf_matrix)
cat(sprintf("Akurasi Model: %.3f\n", accuracy))
## Akurasi Model: 0.780
Sensitivitas mengukur kemampuan model untuk mendeteksi dengan
benar kasus positif.
Rumusnya:
\[ \text{Sensitivitas} = \frac{TP}{TP + FN} \]
di mana:
- \(TP\) = True Positive (kasus positif
yang benar diprediksi positif)
- \(FN\) = False Negative (kasus
positif yang salah diprediksi negatif)
Sensitivitas tinggi penting untuk meminimalkan kasus positif yang terlewat, misalnya dalam diagnosis penyakit.
Spesifisitas mengukur kemampuan model untuk mendeteksi dengan
benar kasus negatif.
Rumusnya:
\[ \text{Spesifisitas} = \frac{TN}{TN + FP} \]
di mana:
- \(TN\) = True Negative (kasus negatif
yang benar diprediksi negatif)
- \(FP\) = False Positive (kasus
negatif yang salah diprediksi positif)
Spesifisitas tinggi penting untuk menghindari kesalahan mengklasifikasikan kasus negatif sebagai positif.
Sumber data : BPS Maluku 2019 Data perceraian di Maluku dapat diakses dari Badan Pusat Statistik Provinsi Maluku
set.seed(2025)
n <- 150
# Simulasi variabel berdasarkan faktor yang dilaporkan berpengaruh
jumlah_perceraian <- rpois(n, lambda = 5) # Jumlah perceraian per kabupaten/kota (indikator outcome)
jumlah_pulau <- rpois(n, lambda = 3) # Jumlah pulau di kabupaten/kota
jarak_ibu_kota <- runif(n, 10, 200) # Jarak ke ibu kota kabupaten (km)
luas_kabupaten <- runif(n, 500, 5000) # Luas wilayah kabupaten (km2)
# Outcome biner: kasus perceraian tinggi (1) jika jumlah perceraian > median, 0 jika tidak
median_perceraian <- median(jumlah_perceraian)
y <- ifelse(jumlah_perceraian > median_perceraian, 1, 0)
df_maluku <- data.frame(
y = factor(y),
jumlah_pulau,
jarak_ibu_kota,
luas_kabupaten
)
# Model regresi logistik sederhana berdasarkan variabel yang tersedia
model <- glm(y ~ jumlah_pulau + jarak_ibu_kota + luas_kabupaten, data = df_maluku, family = binomial)
# Ringkasan model
summary(model)
##
## Call:
## glm(formula = y ~ jumlah_pulau + jarak_ibu_kota + luas_kabupaten,
## family = binomial, data = df_maluku)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.435e-01 5.626e-01 -0.433 0.665
## jumlah_pulau 1.368e-01 9.764e-02 1.401 0.161
## jarak_ibu_kota -1.590e-03 3.027e-03 -0.525 0.599
## luas_kabupaten -8.323e-05 1.293e-04 -0.644 0.520
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 205.78 on 149 degrees of freedom
## Residual deviance: 203.15 on 146 degrees of freedom
## AIC: 211.15
##
## Number of Fisher Scoring iterations: 4
# Prediksi probabilitas
prob <- predict(model, type = "response")
# Klasifikasi dengan threshold 0.5
pred_class <- ifelse(prob >= 0.5, 1, 0)
# Tabel klasifikasi (confusion matrix)
conf_matrix <- table(Predicted = pred_class, Actual = as.numeric(as.character(df_maluku$y)))
print(conf_matrix)
## Actual
## Predicted 0 1
## 0 69 50
## 1 15 16
# Hitung sensitivitas dan spesifisitas
TP <- conf_matrix["1", "1"]
TN <- conf_matrix["0", "0"]
FP <- conf_matrix["1", "0"]
FN <- conf_matrix["0", "1"]
sensitivitas <- TP / (TP + FN)
spesifisitas <- TN / (TN + FP)
cat(sprintf("Sensitivitas: %.3f\n", sensitivitas))
## Sensitivitas: 0.242
cat(sprintf("Spesifisitas: %.3f\n", spesifisitas))
## Spesifisitas: 0.821
Kurva ROC adalah grafik yang digunakan untuk mengevaluasi performa model klasifikasi biner dengan memplot:
Garis diagonal dari kiri bawah ke kanan atas menunjukkan performa model acak (random guess). Kurva yang mendekati pojok kiri atas menunjukkan performa klasifikasi yang lebih baik.
Kurva ROC ideal memiliki bentuk naik tajam ke sensitivitas = 1, lalu
bergerak horizontal ke FPR = 1.
Area Under the Curve (AUC) mengukur luas area di bawah
kurva ROC:
- AUC = 0.5 → model setara tebakan acak
- AUC > 0.7 → model cukup baik
- AUC > 0.9 → model sangat baik
AUC juga dikenal sebagai concordance index, yaitu probabilitas model memberikan skor lebih tinggi untuk kasus positif dibanding negatif.
# Cek distribusi kelas
table(df$y)
##
## 0 1
## 77 23
# Jika salah satu kelas kosong, coba buat ulang data simulasi dengan parameter yang menyeimbangkan kelas
set.seed(123)
n <- 150
jumlah_pulau <- rpois(n, lambda = 3)
jarak_ibu_kota <- runif(n, 10, 200)
luas_kabupaten <- runif(n, 500, 5000)
# Modifikasi linear predictor agar probabilitas tidak terlalu ekstrim
lin_pred <- 0.5 + 0.2 * jumlah_pulau - 0.01 * jarak_ibu_kota + 0.0005 * luas_kabupaten
p <- 1 / (1 + exp(-lin_pred))
# Outcome biner
y_binary <- rbinom(n, 1, p)
df <- data.frame(y = factor(y_binary, levels = c(0,1)), jumlah_pulau, jarak_ibu_kota, luas_kabupaten)
# Cek distribusi kelas lagi
table(df$y)
##
## 0 1
## 35 115
# Fit model regresi logistik
model <- glm(y ~ jumlah_pulau + jarak_ibu_kota + luas_kabupaten, data = df, family = binomial)
prob <- predict(model, type = "response")
# Hitung ROC dan AUC
roc_obj <- roc(response = df$y, predictor = prob, levels = c("0", "1"))
## Setting direction: controls < cases
plot(roc_obj, col = "blue", lwd = 2, main = "Kurva ROC Model Regresi Logistik Perceraian Maluku")
abline(a=0, b=1, lty=2, col="gray")
set.seed(2025)
n <- 150
# Simulasi variabel prediktor mirip data perceraian Maluku
jumlah_pulau <- rpois(n, lambda = 3)
jarak_ibu_kota <- runif(n, 10, 200)
luas_kabupaten <- runif(n, 500, 5000)
# Linear predictor dengan koefisien simulasi agar probabilitas seimbang
lin_pred <- -0.2 + 1.1 * (jumlah_pulau / max(jumlah_pulau)) - 0.9 * (jarak_ibu_kota / max(jarak_ibu_kota))
p <- 1 / (1 + exp(-lin_pred))
# Outcome biner: kasus perceraian (1) atau tidak (0)
y <- rbinom(n, 1, p)
data <- data.frame(y = factor(y), jumlah_pulau, jarak_ibu_kota, luas_kabupaten)
# Fit model regresi logistik dengan dua prediktor utama
model <- glm(y ~ jumlah_pulau + jarak_ibu_kota, data = data, family = binomial)
# Prediksi probabilitas
pred <- predict(model, type = "response")
# Thresholds yang akan diuji
thresholds <- seq(0.1, 0.9, by = 0.05)
# Hitung Sensitivitas untuk tiap threshold
Sensitivity <- sapply(thresholds, function(t) {
pred_class <- ifelse(pred >= t, 1, 0)
cm <- table(Pred = pred_class, Obs = as.numeric(as.character(data$y)))
TP <- ifelse("1" %in% rownames(cm) & "1" %in% colnames(cm), cm["1", "1"], 0)
FN <- ifelse("0" %in% rownames(cm) & "1" %in% colnames(cm), cm["0", "1"], 0)
if ((TP + FN) == 0) return(NA)
TP / (TP + FN)
})
# Hitung Spesifisitas untuk tiap threshold
Specificity <- sapply(thresholds, function(t) {
pred_class <- ifelse(pred >= t, 1, 0)
cm <- table(Pred = pred_class, Obs = as.numeric(as.character(data$y)))
TN <- ifelse("0" %in% rownames(cm) & "0" %in% colnames(cm), cm["0", "0"], 0)
FP <- ifelse("1" %in% rownames(cm) & "0" %in% colnames(cm), cm["1", "0"], 0)
if ((TN + FP) == 0) return(NA)
TN / (TN + FP)
})
# Gabungkan hasil ke data frame
results <- data.frame(Threshold = thresholds, Sensitivity = Sensitivity, Specificity = Specificity)
print(results)
## Threshold Sensitivity Specificity
## 1 0.10 1.00000000 0.0000
## 2 0.15 1.00000000 0.0000
## 3 0.20 1.00000000 0.0000
## 4 0.25 1.00000000 0.0000
## 5 0.30 1.00000000 0.0375
## 6 0.35 0.91428571 0.2000
## 7 0.40 0.77142857 0.3875
## 8 0.45 0.62857143 0.5375
## 9 0.50 0.42857143 0.6875
## 10 0.55 0.28571429 0.8375
## 11 0.60 0.17142857 0.9000
## 12 0.65 0.08571429 0.9750
## 13 0.70 0.04285714 1.0000
## 14 0.75 0.01428571 1.0000
## 15 0.80 0.00000000 1.0000
## 16 0.85 0.00000000 1.0000
## 17 0.90 0.00000000 1.0000
Precision-Recall Curve (PR Curve) adalah alat evaluasi performa model klasifikasi, khususnya berguna untuk data dengan ketidakseimbangan kelas (class imbalance).
Precision (Presisi): Proporsi prediksi positif
yang benar-benar positif
\[
\text{Precision} = \frac{TP}{TP + FP}
\]
Recall (Sensitivitas): Proporsi kasus positif
yang berhasil diprediksi positif
\[
\text{Recall} = \frac{TP}{TP + FN}
\]
| Aspek | ROC Curve | Precision-Recall Curve |
|---|---|---|
| Fokus | Semua kelas | Kelas positif saja |
| Kekuatan | Data seimbang | Data tidak seimbang |
| Sumbu Y | Sensitivitas (Recall) | Precision |
| Sumbu X | 1 - Spesifisitas (FPR) | Recall |
# Install dan load paket PRROC jika belum ada
if(!require(PRROC)) install.packages("PRROC")
## Loading required package: PRROC
## Warning: package 'PRROC' was built under R version 4.3.3
## Loading required package: rlang
##
## Attaching package: 'rlang'
## The following objects are masked from 'package:purrr':
##
## %@%, flatten, flatten_chr, flatten_dbl, flatten_int, flatten_lgl,
## flatten_raw, invoke, splice
## The following object is masked from 'package:magrittr':
##
## set_names
library(PRROC)
set.seed(2025)
n <- 250
# Simulasi variabel prediktor mirip data perceraian Maluku
x1 <- rnorm(n)
x2 <- rbinom(n, 1, 0.4)
x3 <- rnorm(n)
# Linear predictor dengan koefisien simulasi
lin_pred <- -0.8 + 1.3 * x1 - 0.9 * x2 + 0.7 * x3
p <- 1 / (1 + exp(-lin_pred))
# Outcome biner berdasarkan probabilitas p
y <- rbinom(n, 1, p)
data <- data.frame(y = y, x1, x2, x3)
# Fit model regresi logistik
model <- glm(y ~ x1 + x2 + x3, data = data, family = binomial)
# Prediksi probabilitas
prob <- predict(model, type = "response")
# Pisahkan skor probabilitas berdasarkan kelas aktual
scores_positive <- prob[data$y == 1] # skor kelas positif
scores_negative <- prob[data$y == 0] # skor kelas negatif
# Hitung dan plot Precision-Recall Curve
pr <- pr.curve(scores.class0 = scores_positive,
scores.class1 = scores_negative,
curve = TRUE)
plot(pr, main = "Precision-Recall Curve (PR Curve)")
# Tampilkan nilai AUPRC
cat(sprintf("Area Under Precision-Recall Curve (AUPRC): %.3f\n", pr$auc.integral))
## Area Under Precision-Recall Curve (AUPRC): 0.773
Dokumen ini menjelaskan dan menghitung pseudo R-squared pada regresi logistik dengan data simulasi baru, mengacu pada Applied Logistic Regression oleh Hosmer, Lemeshow & Sturdivant (2013) dan Statistical Methods for the Social Sciences oleh Agresti (2018).
set.seed(2025)
n <- 250
z1 <- rnorm(n) # Variabel numerik (misal faktor sosial-ekonomi)
z2 <- rbinom(n, 1, 0.3) # Variabel biner (misal status tertentu)
z3 <- rnorm(n) # Variabel numerik lain
# Linear predictor dengan koefisien simulasi yang mencerminkan pengaruh variabel
lin_pred <- -1.3 + 1.5 * z1 - 0.7 * z2 + 0.5 * z3
# Probabilitas outcome biner
p <- 1 / (1 + exp(-lin_pred))
# Outcome biner z (misal kasus perceraian: 1 = terjadi, 0 = tidak)
z <- rbinom(n, 1, p)
# Data frame lengkap
data <- data.frame(z = factor(z), z1, z2, z3)
# Tampilkan ringkasan data dan distribusi kelas outcome
summary(data)
## z z1 z2 z3
## 0:184 Min. :-2.84924 Min. :0.000 Min. :-2.64475
## 1: 66 1st Qu.:-0.70558 1st Qu.:0.000 1st Qu.:-0.67554
## Median :-0.04942 Median :0.000 Median : 0.03484
## Mean :-0.01558 Mean :0.336 Mean : 0.05985
## 3rd Qu.: 0.68185 3rd Qu.:1.000 3rd Qu.: 0.62409
## Max. : 2.85278 Max. :1.000 Max. : 3.27079
table(data$z)
##
## 0 1
## 184 66
model_full <- glm(z ~ z1 + z2 + z3, data = data, family = binomial) model_null <- glm(z ~ 1, data = data, family = binomial)
\[ R^2_{CoxSnell} = 1 - \left( \frac{L_M}{L_0} \right)^{2/n} \]
\[ R^2_{McFadden} = 1 - \frac{\log L_M}{\log L_0} \]
Dengan: - \(L_0\): likelihood model null (tanpa prediktor) - \(L_M\): likelihood model penuh
set.seed(2025)
n <- 200
x1 <- rnorm(n)
x2 <- rbinom(n, 1, 0.4)
x3 <- rnorm(n)
lin_pred <- -0.7 + 1.3 * x1 - 0.9 * x2 + 0.6 * x3
p <- 1 / (1 + exp(-lin_pred))
y <- rbinom(n, 1, p)
data <- data.frame(y = factor(y), x1, x2, x3)
# Fit model regresi logistik
model <- glm(y ~ x1 + x2 + x3, data = data, family = binomial)
# Pastikan paket pscl terpasang dan dimuat
if (!require(pscl)) install.packages("pscl")
## Loading required package: pscl
## Warning: package 'pscl' was built under R version 4.3.3
## Classes and Methods for R originally developed in the
## Political Science Computational Laboratory
## Department of Political Science
## Stanford University (2002-2015),
## by and under the direction of Simon Jackman.
## hurdle and zeroinfl functions by Achim Zeileis.
library(pscl)
# Hitung berbagai pseudo R-squared dengan pscl::pR2
pseudo_r2_pscl <- pR2(model)
## fitting null model for pseudo-r2
print(pseudo_r2_pscl)
## llh llhNull G2 McFadden r2ML r2CU
## -99.7067372 -128.8592752 58.3050760 0.2262355 0.2528769 0.3491128
# Pastikan paket DescTools terpasang dan dimuat
if (!require(DescTools)) install.packages("DescTools")
library(DescTools)
# Hitung pseudo R-squared dengan DescTools::PseudoR2 (semua jenis)
pseudo_r2_desc <- PseudoR2(model, which = "all")
print(pseudo_r2_desc)
## McFadden McFaddenAdj CoxSnell Nagelkerke AldrichNelson
## 0.2262355 0.1951938 0.2528769 0.3491128 0.2257218
## VeallZimmermann Efron McKelveyZavoina Tjur AIC
## 0.4008910 0.2733239 0.3704361 0.2721155 207.4134743
## BIC logLik logLik0 G2
## 220.6067438 -99.7067372 -128.8592752 58.3050760
Interpretasi :
llh (log-likelihood model): -99.71, nilai log-likelihood dari model yang di-fit.
llhNull (log-likelihood null model): -128.86, nilai log-likelihood model dengan intercept saja (tanpa prediktor).
G2 (deviance): 58.31, pengukuran perbedaan antara model penuh dan null model, semakin besar menunjukkan model penuh lebih baik.
McFadden R² (0.226): Rasio penurunan deviance, nilai sekitar 0.2–0.4 dianggap model cukup baik dalam konteks regresi logistik.
McFaddenAdj (0.195): McFadden R² yang disesuaikan untuk jumlah prediktor dan ukuran sampel.
CoxSnell R² (0.253) dan Nagelkerke R² (0.349): Ukuran pseudo R² yang mirip R² pada regresi linear, Nagelkerke sudah disesuaikan agar maksimum 1. Nilai ini menunjukkan model menjelaskan sekitar 25–35% variasi outcome.
AldrichNelson, VeallZimmermann, Efron, McKelveyZavoina, Tjur: Variasi ukuran pseudo R² lain yang memberikan perspektif berbeda tentang kekuatan model, dengan nilai antara 0.22 sampai 0.40, mengindikasikan model memiliki kekuatan prediksi sedang.
AIC (207.41) dan BIC (220.61): Ukuran kecocokan model yang memperhitungkan kompleksitas model; nilai lebih kecil lebih baik.
Distribusi multinomial adalah generalisasi dari distribusi binomial untuk percobaan dengan lebih dari dua kategori hasil. Probabilitas untuk mendapatkan kombinasi hasil tertentu dalam \(n\) percobaan independen dengan \(k\) kategori adalah:
\[ P(X_1 = x_1, X_2 = x_2, \ldots, X_k = x_k) = \frac{n!}{x_1! x_2! \ldots x_k!} p_1^{x_1} p_2^{x_2} \ldots p_k^{x_k} \]
dengan syarat:
Sumber : Rachmat, M. T., & Sari, R. P. (2022). Analisa perhitungan dalam penerapan konsep distribusi peluang diskrit dan statistika deskriptif. Jurnal Pendidikan Matematika: Judika Education
Sebuah klinik mengelompokkan hasil pemeriksaan pasien menjadi tiga kategori dengan peluang:
Jika diambil sampel 6 pasien, hitung probabilitas bahwa:
Perhitungan Manual
\[ P = \frac{6!}{2! \times 1! \times 3!} \times (0.47)^2 \times (0.13)^1 \times (0.40)^3 \]
\[ = 60 \times 0.2209 \times 0.13 \times 0.064 \approx 0.110 \]
Jadi, probabilitasnya sekitar 11%.
di R
library(combinat)
##
## Attaching package: 'combinat'
## The following object is masked from 'package:utils':
##
## combn
#Parameter
n <- 6
x <- c(2, 1, 3)
p <- c(0.47, 0.13, 0.40)
#Hitung probabilitas distribusi multinomial
prob <- dmnom(x, n, p)
print(prob)
## [1] 0.1102733
Interpretasi :
Dalam sebuah klinik, probabilitas untuk mendapatkan 6 pasien dengan distribusi hasil pemeriksaan sebagai berikut: 2 pasien tidak sesuai target, 1 pasien sesuai target, dan 3 pasien melampaui target, adalah sebesar 0,1103 atau sekitar 11%. Artinya, jika kita mengambil sampel acak sebanyak 6 pasien dari populasi dengan peluang kategori masing-masing 47% tidak sesuai target, 13% sesuai target, dan 40% melampaui target, maka kemungkinan tepat terjadi kombinasi tersebut adalah sekitar 11%
Multinomial logistic regression adalah metode statistik untuk memodelkan variabel dependen kategorikal dengan lebih dari dua kategori tanpa urutan (nominal). Model ini memperluas regresi logistik biner dengan membandingkan setiap kategori dengan kategori referensi.
Model ini menggunakan fungsi prediktor linear:
\[ f(k,i) = \beta_{0,k} + \beta_{1,k} x_{1,i} + \beta_{2,k} x_{2,i} + \cdots + \beta_{M,k} x_{M,i} \]
atau dalam bentuk vektor:
\[ f(k,i) = \boldsymbol{\beta}_k \cdot \mathbf{x}_i \]
dengan \(k = 1, \ldots, K-1\) kategori (kategori ke-\(K\) menjadi referensi).
Probabilitas kategori \(k\) untuk observasi \(i\) adalah:
\[ P(Y_i = k) = \frac{\exp(f(k,i))}{1 + \sum_{j=1}^{K-1} \exp(f(j,i))}, \quad k = 1, \ldots, K-1 \]
dan untuk kategori referensi \(K\):
\[ P(Y_i = K) = \frac{1}{1 + \sum_{j=1}^{K-1} \exp(f(j,i))} \]
Log-rasio peluang antara kategori \(k\) dan referensi \(K\) dinyatakan sebagai:
\[ \log \frac{P(Y_i = k)}{P(Y_i = K)} = \boldsymbol{\beta}_k \cdot \mathbf{x}_i \]
Koefisien \(\boldsymbol{\beta}_k\) mengukur perubahan log-rasio peluang kategori \(k\) terhadap referensi untuk setiap kenaikan satu unit pada variabel prediktor.
Baseline-category logit model adalah model regresi logistik multinomial yang digunakan untuk memodelkan variabel dependen kategorikal nominal dengan lebih dari dua kategori. Model ini memilih satu kategori sebagai baseline (referensi) dan membandingkan log-rasio peluang kategori lain terhadap kategori baseline.
Misalkan variabel dependen \(Y\) memiliki \(J\) kategori, dengan kategori \(J\) sebagai baseline. Probabilitas kategori \(j\) untuk individu \(i\) adalah:
\[ \pi_{ij} = P(Y_i = j) \quad \text{dengan } j = 1, 2, \ldots, J \]
Estimasi dilakukan menggunakan metode maximum likelihood dengan algoritma iteratif seperti Newton-Raphson.
Log-likelihood:
\[ \ell(\beta) = \sum_{i=1}^{n} \sum_{j=1}^{K} y_{ij} \log(\pi_{ij}) \]
dengan
$ _{ij} = P(Y_i = j x_i)$ dan \(y_{ij} = 1\) jika $Y_i = j $.
Contoh Kasus
Penelitian oleh Mailani Putri (2020) menggunakan regresi logistik multinomial dengan metode Bayes untuk memodelkan minat pemilihan jurusan siswa baru MAN 2 Samarinda berdasarkan nilai mata pelajaran dan nilai ujian nasional. Estimasi parameter dilakukan dengan MCMC menggunakan Gibbs Sampler
library(nnet)
set.seed(123)
#Simulasi data
n <- 300
#Variabel prediktor: Nilai Matematika, Nilai Bahasa, Nilai IPA
Matematika <- rnorm(n, mean = 70, sd = 10)
Bahasa <- rnorm(n, mean = 65, sd = 12)
IPA <- rnorm(n, mean = 68, sd = 11)
logit_IPS <- 0.5 + 0.02 * Matematika - 0.01 * Bahasa + 0.03 * IPA
logit_Bahasa <- 0.3 - 0.02 * Matematika + 0.04 * Bahasa - 0.01 * IPA
#Kategori IPA sebagai baseline
exp_IPS <- exp(logit_IPS)
exp_Bahasa <- exp(logit_Bahasa)
denom <- 1 + exp_IPS + exp_Bahasa
p_IPA <- 1 / denom
p_IPS <- exp_IPS / denom
p_Bahasa <- exp_Bahasa / denom
#Sampling kategori berdasarkan probabilitas
Jurusan <- sapply(1:n, function(i) sample(c("IPA", "IPS", "Bahasa"), 1, prob = c(p_IPA[i], p_IPS[i], p_Bahasa[i])))
Jurusan <- factor(Jurusan, levels = c("IPA", "IPS", "Bahasa"))
#Data frame
data <- data.frame(Jurusan, Matematika, Bahasa, IPA)
#Estimasi model multinomial logistic regression
model <- multinom(Jurusan ~ Matematika + Bahasa + IPA, data = data)
## # weights: 15 (8 variable)
## initial value 329.583687
## iter 10 value 182.226301
## iter 20 value 130.133509
## iter 30 value 130.102071
## final value 130.101583
## converged
#Ringkasan model
summary(model)
## Call:
## multinom(formula = Jurusan ~ Matematika + Bahasa + IPA, data = data)
##
## Coefficients:
## (Intercept) Matematika Bahasa IPA
## IPS 0.5526122 -0.00635982 0.02606128 0.02119645
## Bahasa -1.8909729 -0.01520792 0.07421597 -0.01623300
##
## Std. Errors:
## (Intercept) Matematika Bahasa IPA
## IPS 3.554648 0.03202246 0.02601875 0.02783665
## Bahasa 4.226543 0.03839612 0.03145490 0.03240813
##
## Residual Deviance: 260.2032
## AIC: 276.2032
#Odds ratio
exp(coef(model))
## (Intercept) Matematika Bahasa IPA
## IPS 1.7377866 0.9936604 1.026404 1.021423
## Bahasa 0.1509249 0.9849071 1.077039 0.983898
Interpretasi : nilai Bahasa adalah prediktor paling kuat untuk menentukan masuk jurusan Bahasa dan IPS.
Nilai Matematika dan IPA tidak terlalu kuat pengaruhnya (karena OR-nya mendekati 1).
z <- summary(model)$coefficients / summary(model)$standard.errors
pval <- 2 * (1 - pnorm(abs(z)))
round(pval, 4)
## (Intercept) Matematika Bahasa IPA
## IPS 0.8765 0.8426 0.3165 0.4464
## Bahasa 0.6546 0.6920 0.0183 0.6164
Interpretasi :
🔹 Untuk Jurusan IPS
Semua p-value di atas 0.05 → tidak ada prediktor yang signifikan untuk pemilihan jurusan IPS.
Artinya, nilai Matematika, Bahasa, dan IPA tidak cukup kuat menjelaskan kenapa siswa memilih jurusan IPS.
🔹 Untuk Jurusan Bahasa
Nilai Bahasa: p = 0.0183 → signifikan
Artinya: Nilai Bahasa berpengaruh signifikan terhadap pemilihan jurusan Bahasa.
Semakin tinggi nilai Bahasa, semakin besar kemungkinan memilih jurusan Bahasa.
data$Predicted <- predict(model)
table(Predicted = data$Predicted, Actual = data$Jurusan)
## Actual
## Predicted IPA IPS Bahasa
## IPA 0 0 0
## IPS 11 262 27
## Bahasa 0 0 0
Interpretasi : Jumlah prediksi benar = 262 (Predicted IPS, Actual IPS)
Total data = 300 dengan Akurasi = 262 / 300 = 0.8733 atau 87.33%
library(ggplot2)
ggplot(data, aes(x = Matematika, y = Bahasa, color = Predicted)) +
geom_point(size = 2) +
labs(
title = "Prediksi Jurusan (Multinomial Logistic Regression)",
x = "Nilai Matematika",
y = "Nilai Bahasa"
) +
theme_minimal()
Regresi logistik ordinal digunakan untuk memodelkan hubungan antara variabel dependen ordinal (kategori berurutan) dengan satu atau lebih variabel prediktor. Model yang umum digunakan adalah cumulative logit model (model logit kumulatif) yang membandingkan peluang kumulatif kategori respon ke-\(j\):
\[ \text{logit} \; P(Y \leq j \mid \mathbf{x}) = \log \frac{P(Y \leq j \mid \mathbf{x})}{P(Y > j \mid \mathbf{x})} = \alpha_j + \boldsymbol{\beta}^\top \mathbf{x} \]
dengan \(j = 1, 2, \ldots, J-1\), di mana \(J\) adalah jumlah kategori ordinal, \(\alpha_j\) adalah intercept khusus kategori, dan \(\boldsymbol{\beta}\) adalah koefisien regresi yang sama untuk semua kategori (asumsi proportional odds).
Model ini mengasumsikan bahwa pengaruh variabel prediktor \(\boldsymbol{\beta}\) adalah konstan di semua batas kategori (proportional odds assumption).
Penelitian oleh Rahmawati et al. (2019) menggunakan regresi logistik ordinal dengan model proportional odds untuk menganalisis faktor-faktor yang memengaruhi kelengkapan imunisasi dasar anak balita di Provinsi Kalimantan Barat. Variabel dependen terdiri dari tiga kategori ordinal: tidak imunisasi, imunisasi tidak lengkap, dan imunisasi lengkap.
library(MASS)
set.seed(123)
#Ukuran sampel
n <- 300
#Simulasi variabel prediktor
StatusEkonomi <- rnorm(n, mean = 50, sd = 10)
Daerah <- factor(sample(c("Perkotaan", "Pedesaan"), n, replace = TRUE))
#Koefisien model
alpha1 <- -1.5 # intercept kategori 1
alpha2 <- 0.5 # intercept kategori 2
beta1 <- 0.04 # koefisien StatusEkonomi
beta2 <- -0.8 # koefisien Daerah (Pedesaan vs Perkotaan)
#Membuat linear predictor untuk batas kategori
#Menggunakan model cumulative logit: logit P(Y ≤ j)
eta1 <- alpha1 + beta1 * StatusEkonomi + beta2 * (Daerah == "Pedesaan")
eta2 <- alpha2 + beta1 * StatusEkonomi + beta2 * (Daerah == "Pedesaan")
#Fungsi sigmoid (logistic)
logistic <- function(x) 1 / (1 + exp(-x))
#Hitung probabilitas kumulatif
p_leq1 <- logistic(eta1)
p_leq2 <- logistic(eta2)
#Probabilitas kategori
p1 <- p_leq1
p2 <- p_leq2 - p_leq1
p3 <- 1 - p_leq2
#Sampling kategori ordinal berdasarkan probabilitas
Kategori <- sapply(1:n, function(i) sample(1:3, size = 1, prob = c(p1[i], p2[i], p3[i])))
Kategori <- factor(Kategori, levels = 1:3, labels = c("TidakImunisasi", "ImunisasiTidakLengkap", "ImunisasiLengkap"))
#Membentuk data frame
data <- data.frame(Kategori, StatusEkonomi, Daerah)
#Estimasi model regresi logistik ordinal dengan polr dari paket MASS
model_ord <- polr(Kategori ~ StatusEkonomi + Daerah, data = data, method = "logistic")
#Ringkasan model
summary(model_ord)
##
## Re-fitting to get Hessian
## Call:
## polr(formula = Kategori ~ StatusEkonomi + Daerah, data = data,
## method = "logistic")
##
## Coefficients:
## Value Std. Error t value
## StatusEkonomi -0.03837 0.01245 -3.082
## DaerahPerkotaan -1.13134 0.23495 -4.815
##
## Intercepts:
## Value Std. Error t value
## TidakImunisasi|ImunisasiTidakLengkap -2.5007 0.6619 -3.7778
## ImunisasiTidakLengkap|ImunisasiLengkap -0.1845 0.6486 -0.2845
##
## Residual Deviance: 536.4814
## AIC: 544.4814
#Menghitung p-value (uji Wald)
coefs <- coef(summary(model_ord))
##
## Re-fitting to get Hessian
p_values <- pnorm(abs(coefs[, "t value"]), lower.tail = FALSE) * 2
cbind(coefs, "p value" = p_values)
## Value Std. Error t value
## StatusEkonomi -0.03836901 0.01244768 -3.082424
## DaerahPerkotaan -1.13133701 0.23495214 -4.815181
## TidakImunisasi|ImunisasiTidakLengkap -2.50071838 0.66194488 -3.777835
## ImunisasiTidakLengkap|ImunisasiLengkap -0.18453475 0.64862592 -0.284501
## p value
## StatusEkonomi 2.053224e-03
## DaerahPerkotaan 1.470667e-06
## TidakImunisasi|ImunisasiTidakLengkap 1.581978e-04
## ImunisasiTidakLengkap|ImunisasiLengkap 7.760264e-01
# prediksi prob
pred_probs <- predict(model_ord, type = "probs")
print(head(pred_probs))
## TidakImunisasi ImunisasiTidakLengkap ImunisasiLengkap
## 1 0.3105998 0.5097718 0.17962845
## 2 0.3383659 0.4999294 0.16170466
## 3 0.5039482 0.4075428 0.08850907
## 4 0.6401747 0.3072901 0.05253521
## 5 0.6453532 0.3032229 0.05142389
## 6 0.7697894 0.2015543 0.02865632
Hasilnya menunjukkan bahwa beberapa variabel independen seperti daerah administratif dan status ekonomi berpengaruh signifikan terhadap tingkat kelengkapan imunisasi balita.
Model cumulative logit pada regresi logistik ordinal mengasumsikan bahwa efek prediktor adalah sama (konstan) pada setiap batas kategori (cutoff) variabel dependen ordinal. Asumsi ini dikenal sebagai proportional odds assumption atau asumsi paralelisme. Secara matematis, model cumulative logit untuk kategori \(j=1,\ldots,J-1\) dituliskan sebagai:
\[ \log \frac{P(Y \leq j \mid \mathbf{x})}{P(Y > j \mid \mathbf{x})} = \alpha_j + \boldsymbol{\beta}^\top \mathbf{x} \]
dengan \(\boldsymbol{\beta}\) sama untuk semua \(j\), sehingga garis regresi untuk setiap cutoff bersifat paralel.
Untuk menguji kecocokan model (goodness-of-fit), dapat digunakan uji deviance atau likelihood ratio test. Jika asumsi proportional odds tidak terpenuhi, model ini kurang tepat dan perlu dipertimbangkan model yang lebih fleksibel.
Jika asumsi paralelisme tidak sesuai dengan data, beberapa model ordinal alternatif yang dapat digunakan antara lain:
Model-model ini memungkinkan koefisien prediktor berbeda antar kategori dan memberikan fleksibilitas dalam pemodelan data ordinal.
Regresi logistik ordinal efektif untuk memodelkan variabel dependen berurutan.
Model cumulative logit menginterpretasikan efek prediktor dalam bentuk log-odds kumulatif dengan asumsi proportional odds.
Dalam regresi logistik ordinal, model yang paling umum digunakan adalah Cumulative Logit Model dengan asumsi proportional odds atau yang dikenal juga sebagai asumsi paralelisme. Asumsi ini menyatakan bahwa efek variabel prediktor terhadap log-odds kumulatif adalah konstan di semua batas kategori variabel dependen ordinal.
Secara matematis, model cumulative logit untuk kategori \(j = 1, 2, ..., J-1\) dituliskan sebagai:
\[ \log \frac{P(Y \leq j \mid \mathbf{x})}{P(Y > j \mid \mathbf{x})} = \alpha_j + \boldsymbol{\beta}^\top \mathbf{x} \]
dengan \(\boldsymbol{\beta}\) yang sama untuk semua \(j\), sehingga garis regresi pada setiap cutoff bersifat paralel (sehingga disebut asumsi paralelisme).
Artinya, koefisien regresi \(\beta_k\) untuk setiap variabel prediktor \(x_k\) tidak berubah antar kategori kumulatif, hanya intercept \(\alpha_j\) yang berbeda untuk setiap cutoff.
Implikasi dan Uji Asumsi Paralelisme
Uji asumsi paralelisme dapat dilakukan dengan:
brant dapat digunakan untuk uji ini.Model log linear adalah teknik analisis statistik yang digunakan untuk mempelajari hubungan antar variabel kategori dalam data frekuensi, terutama dalam tabel kontingensi multidimensi. Model ini memodelkan logaritma natural dari frekuensi yang diharapkan sebagai fungsi linier dari efek-efek utama dan interaksi antar variabel.
Misalnya, untuk tabel kontingensi tiga dimensi dengan variabel A (i baris), B (j kolom), dan C (k lapis), model log linear lengkap dapat dituliskan sebagai:
\[ \log (m_{ijk}) = \mu + \lambda_i^A + \lambda_j^B + \lambda_k^C + \lambda_{ij}^{AB} + \lambda_{ik}^{AC} + \lambda_{jk}^{BC} + \lambda_{ijk}^{ABC} \]
di mana:
- \(m_{ijk}\) adalah frekuensi yang
diharapkan pada sel \((i,j,k)\),
- \(\mu\) adalah grand mean,
- \(\lambda\) adalah parameter efek
utama dan interaksi.
Model ini berguna untuk mengidentifikasi pola asosiasi dan interaksi antar variabel kategori dalam data kualitatif.
| Aspek | Tabel Kontingensi | Model Log Linear | Model Regresi Logistik |
|---|---|---|---|
| Jenis Data | Data frekuensi/kategori | Data frekuensi/kategori | Variabel dependen kategori, prediktor numerik/kategori |
| Tujuan Analisis | Menyajikan distribusi frekuensi | Menganalisis hubungan dan interaksi antar variabel kategori | Memodelkan probabilitas kategori dependen berdasarkan prediktor |
| Model Statistik | Tidak ada model formal | Model linier pada log frekuensi (logaritma natural) | Model probabilistik (logit link) |
| Variabel Dependen | Frekuensi pada sel tabel | Frekuensi pada sel tabel | Variabel kategori (biner atau multinomial) |
| Hubungan Antar Variabel | Asosiasi sederhana (dua arah) | Efek utama dan interaksi (dua arah, tiga arah, dst.) | Pengaruh prediktor terhadap peluang kategori dependen |
| Distribusi Data | Frekuensi observasi | Asumsi distribusi Poisson untuk frekuensi | Asumsi distribusi Bernoulli atau multinomial |
| Interpretasi | Distribusi frekuensi | Parameter efek dan interaksi antar variabel | Koefisien log-odds dan odds ratio |
| Contoh Penggunaan | Tabulasi silang sederhana | Analisis pola hubungan multidimensi dalam data kategori | Prediksi kategori berdasarkan variabel independen |
Tabel kontingensi adalah tabel yang menyajikan frekuensi pengamatan dari dua atau lebih variabel kategori. Tabel ini membantu mengidentifikasi pola asosiasi antar variabel kategori.
Model log linier adalah metode statistik untuk menganalisis hubungan antar variabel kategori dalam tabel kontingensi. Model ini memodelkan logaritma frekuensi yang diharapkan sebagai kombinasi linier dari efek utama dan interaksi antar variabel. Model log linier mengasumsikan distribusi Poisson untuk frekuensi sel.
Model log linier dua arah untuk variabel \(X\) dan \(Y\) dengan kategori \(i\) dan \(j\) dapat ditulis sebagai:
\[ \log(\hat{m}_{ij}) = \mu + \lambda_i^X + \lambda_j^Y + \lambda_{ij}^{XY} \]
di mana \(\hat{m}_{ij}\) adalah frekuensi yang diharapkan pada sel \((i,j)\), \(\mu\) adalah rata-rata umum, \(\lambda_i^X\) dan \(\lambda_j^Y\) adalah efek utama, dan \(\lambda_{ij}^{XY}\) adalah efek interaksi.
Model log linear dua arah adalah model statistik yang digunakan untuk menganalisis hubungan asosiasi antara dua variabel kategori dalam tabel kontingensi dua dimensi. Model ini memodelkan logaritma frekuensi yang diharapkan pada setiap sel tabel sebagai fungsi linier dari efek utama masing-masing variabel dan interaksi antar variabel.
Secara matematis, model log linear dua arah dapat dituliskan sebagai:
\[ \log(\hat{m}_{ij}) = \mu + \lambda_i^X + \lambda_j^Y + \lambda_{ij}^{XY} \]
di mana:
- \(\hat{m}_{ij}\) adalah frekuensi
yang diharapkan pada sel ke-\((i,j)\),
- \(\mu\) adalah intercept (efek
rata-rata umum),
- \(\lambda_i^X\) adalah efek utama
kategori ke-\(i\) dari variabel \(X\),
- \(\lambda_j^Y\) adalah efek utama
kategori ke-\(j\) dari variabel \(Y\),
- \(\lambda_{ij}^{XY}\) adalah efek
interaksi antara kategori \(i\) dan
\(j\).
Model ini mengasumsikan distribusi Poisson untuk frekuensi sel dan independensi antar sel.
Model log linear dua arah terdiri dari dua tipe utama:
- Model tak jenuh (independen): hanya mengandung efek
utama \(\mu + \lambda_i^X +
\lambda_j^Y\), tanpa interaksi.
- Model jenuh (saturated): mengandung semua efek utama
dan interaksi \(\mu + \lambda_i^X +
\lambda_j^Y + \lambda_{ij}^{XY}\), sehingga fit sempurna dengan
data.
Pemilihan model terbaik dilakukan dengan uji Chi-Square atau Likelihood Ratio Test untuk menentukan ada tidaknya interaksi antar variabel.
Penelitian oleh Satria et al. (2023) menggunakan model log linier untuk menganalisis hubungan antara variabel kategori dalam data stunting di Kota Pontianak. Data disajikan dalam tabel kontingensi dua arah dan dianalisis menggunakan model log linier jenuh dan tak jenuh untuk menguji asosiasi antar variabel.
| Kecamatan | Resiko | Tidak Beresiko |
|---|---|---|
| Pontianak Selatan | 5238 | 3107 |
| Pontianak Timur | 9740 | 2367 |
| Pontianak Barat | 9886 | 2699 |
| Pontianak Utara | 14349 | 1274 |
| Pontianak Kota | 9195 | 3865 |
| Pontianak Tenggara | 3137 | 1567 |
Sintaks R untuk Model Log Linier dan Model Saturated
library(MASS)
#Data frekuensi kasus stunting berdasarkan kecamatan
kecamatan <- c("Pontianak_Selatan", "Pontianak_Timur", "Pontianak_Barat",
"Pontianak_Utara", "Pontianak_Kota", "Pontianak_Tenggara")
resiko <- c(5238, 9740, 9886, 14349, 9195, 3137)
tidak_resiko <- c(3107, 2367, 2699, 1274, 3865, 1567)
#Membuat data frame
data_stunting <- data.frame(
Kecamatan = rep(kecamatan, each = 2),
Risiko = factor(rep(c("Resiko", "Tidak_Beresiko"), times = 6)),
Frekuensi = c(rbind(resiko, tidak_resiko))
)
#Membuat tabel kontingensi
tbl_stunting <- xtabs(Frekuensi ~ Kecamatan + Risiko, data = data_stunting)
#Model log linier independen (tanpa interaksi)
model_indep <- loglm(~ Kecamatan + Risiko, data = tbl_stunting)
#Model log linier saturated (dengan interaksi)
model_sat <- loglm(~ Kecamatan * Risiko, data = tbl_stunting)
#Ringkasan model independen
summary(model_indep)
## Formula:
## ~Kecamatan + Risiko
## attr(,"variables")
## list(Kecamatan, Risiko)
## attr(,"factors")
## Kecamatan Risiko
## Kecamatan 1 0
## Risiko 0 1
## attr(,"term.labels")
## [1] "Kecamatan" "Risiko"
## attr(,"order")
## [1] 1 1
## attr(,"intercept")
## [1] 1
## attr(,"response")
## [1] 0
## attr(,".Environment")
## <environment: R_GlobalEnv>
##
## Statistics:
## X^2 df P(> X^2)
## Likelihood Ratio 3918.986 5 0
## Pearson 3654.237 5 0
# odd ratio
# Berdasarkan data stunting Kota Pontianak yang sudah dibuat tabel kontingensi:
# Data frekuensi kasus stunting
# Menghitung Odds Ratio per kecamatan:
# OR = (resiko / tidak_resiko) / (total resiko / total tidak_resiko) sebagai referensi keseluruhan
total_resiko <- sum(resiko)
total_tidak_resiko <- sum(tidak_resiko)
overall_odds <- total_resiko / total_tidak_resiko
df <- data.frame(kecamatan, resiko, tidak_resiko, stringsAsFactors = FALSE)
df$odds <- df$resiko / df$tidak_resiko
df$odds_ratio <- df$odds / overall_odds
# Menampilkan hasil
df[, c("kecamatan", "odds", "odds_ratio")]
#Ringkasan model saturated
summary(model_sat)
## Formula:
## ~Kecamatan * Risiko
## attr(,"variables")
## list(Kecamatan, Risiko)
## attr(,"factors")
## Kecamatan Risiko Kecamatan:Risiko
## Kecamatan 1 0 1
## Risiko 0 1 1
## attr(,"term.labels")
## [1] "Kecamatan" "Risiko" "Kecamatan:Risiko"
## attr(,"order")
## [1] 1 1 2
## attr(,"intercept")
## [1] 1
## attr(,"response")
## [1] 0
## attr(,".Environment")
## <environment: R_GlobalEnv>
##
## Statistics:
## X^2 df P(> X^2)
## Likelihood Ratio 0 0 1
## Pearson 0 0 1
#Model Lebih Sederhana dan Perbandingan Model
anova(model_indep, model_sat)
## LR tests for hierarchical log-linear models
##
## Model 1:
## ~Kecamatan + Risiko
## Model 2:
## ~Kecamatan * Risiko
##
## Deviance df Delta(Dev) Delta(df) P(> Delta(Dev)
## Model 1 3918.986 5
## Model 2 0.000 0 3918.986 5 0
## Saturated 0.000 0 0.000 0 1
# Membuat data frame dengan frekuensi
data <- data.frame(
Kecamatan = rep(kecamatan, each = 2),
Risiko = factor(rep(c("Resiko", "Tidak_Beresiko"), times = 6)),
Freq = c(rbind(resiko, tidak_resiko))
)
# Model tanpa interaksi (efek utama saja)
fit_no_inter <- glm(Freq ~ Kecamatan + Risiko, family = poisson, data = data)
summary(fit_no_inter)
##
## Call:
## glm(formula = Freq ~ Kecamatan + Risiko, family = poisson, data = data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 9.186658 0.009155 1003.511 < 2e-16 ***
## KecamatanPontianak_Kota 0.037048 0.012491 2.966 0.00302 **
## KecamatanPontianak_Selatan -0.410843 0.014117 -29.103 < 2e-16 ***
## KecamatanPontianak_Tenggara -0.984092 0.017089 -57.585 < 2e-16 ***
## KecamatanPontianak_Timur -0.038722 0.012730 -3.042 0.00235 **
## KecamatanPontianak_Utara 0.216239 0.011978 18.053 < 2e-16 ***
## RisikoTidak_Beresiko -1.242504 0.009306 -133.512 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 33040 on 11 degrees of freedom
## Residual deviance: 3919 on 5 degrees of freedom
## AIC: 4055.2
##
## Number of Fisher Scoring iterations: 4
# Model dengan interaksi
fit_inter <- glm(Freq ~ Kecamatan * Risiko, family = poisson, data = data)
summary(fit_inter)
##
## Call:
## glm(formula = Freq ~ Kecamatan * Risiko, family = poisson, data = data)
##
## Coefficients:
## Estimate Std. Error z value
## (Intercept) 9.19887 0.01006 914.629
## KecamatanPontianak_Kota -0.07246 0.01449 -5.001
## KecamatanPontianak_Selatan -0.63518 0.01709 -37.167
## KecamatanPontianak_Tenggara -1.14785 0.02049 -56.014
## KecamatanPontianak_Timur -0.01488 0.01428 -1.042
## KecamatanPontianak_Utara 0.37256 0.01307 28.503
## RisikoTidak_Beresiko -1.29824 0.02172 -59.778
## KecamatanPontianak_Kota:RisikoTidak_Beresiko 0.43154 0.02897 14.897
## KecamatanPontianak_Selatan:RisikoTidak_Beresiko 0.77596 0.03138 24.731
## KecamatanPontianak_Tenggara:RisikoTidak_Beresiko 0.60413 0.03780 15.984
## KecamatanPontianak_Timur:RisikoTidak_Beresiko -0.11638 0.03157 -3.686
## KecamatanPontianak_Utara:RisikoTidak_Beresiko -1.12328 0.03642 -30.844
## Pr(>|z|)
## (Intercept) < 2e-16 ***
## KecamatanPontianak_Kota 5.69e-07 ***
## KecamatanPontianak_Selatan < 2e-16 ***
## KecamatanPontianak_Tenggara < 2e-16 ***
## KecamatanPontianak_Timur 0.297339
## KecamatanPontianak_Utara < 2e-16 ***
## RisikoTidak_Beresiko < 2e-16 ***
## KecamatanPontianak_Kota:RisikoTidak_Beresiko < 2e-16 ***
## KecamatanPontianak_Selatan:RisikoTidak_Beresiko < 2e-16 ***
## KecamatanPontianak_Tenggara:RisikoTidak_Beresiko < 2e-16 ***
## KecamatanPontianak_Timur:RisikoTidak_Beresiko 0.000228 ***
## KecamatanPontianak_Utara:RisikoTidak_Beresiko < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 3.3040e+04 on 11 degrees of freedom
## Residual deviance: 1.1844e-12 on 0 degrees of freedom
## AIC: 146.23
##
## Number of Fisher Scoring iterations: 2
# Uji perbandingan model untuk melihat signifikansi interaksi
anova(fit_no_inter, fit_inter, test = "Chisq")
Interpretasi:
Intercept (9.19887): Logaritma frekuensi dasar untuk kategori referensi (misal Kecamatan “Pontianak_Timur” dan Risiko “Resiko”).
Koefisien Kecamatan: Misalnya KecamatanPontianak_Kota = -0.07246 artinya log-frekuensi untuk Pontianak Kota lebih rendah dibanding referensi.
Koefisien RisikoTidak_Beresiko (-1.29824): Log-frekuensi risiko tidak beresiko lebih rendah dibanding risiko beresiko.
Interaksi Kecamatan:Risiko: Koefisien interaksi positif atau negatif menunjukkan bagaimana pengaruh risiko berbeda antar kecamatan. Misalnya KecamatanPontianak_Kota:RisikoTidak_Beresiko = 0.43154 berarti efek risiko tidak beresiko di Pontianak Kota berbeda secara signifikan dibanding referensi.
Semua koefisien signifikan dengan p-value < 0.001 kecuali KecamatanPontianak_Timur yang tidak signifikan (p=0.297).
Nilai deviance residual sangat kecil (mendekati nol) menunjukkan model jenuh (dengan interaksi) fit sempurna ke data.
Tabel kontingensi 2x3 adalah tabel silang antara dua variabel kategori, dengan satu variabel memiliki 2 kategori dan variabel lain memiliki 3 kategori. Tabel ini digunakan untuk menguji apakah terdapat hubungan atau asosiasi antara kedua variabel tersebut.
tabel kontingensi 2x3 yang menggambarkan hubungan antara Merokok (Ya, Tidak) dan Status Kesehatan (Sakit, Sehat, Sangat Sehat):
| Merokok | Status | Frekuensi |
|---|---|---|
| Ya | Sakit | 20 |
| Ya | Sehat | 30 |
| Ya | Sangat Sehat | 25 |
| Tidak | Sakit | 50 |
| Tidak | Sehat | 70 |
| Tidak | Sangat Sehat | 80 |
data <- data.frame(
Merokok = factor(rep(c("Ya", "Tidak"), each = 3)),
Status = factor(rep(c("Sakit", "Sehat", "Sangat_Sehat"), times = 2)),
Freq = c(20, 30, 25, 50, 70, 80)
)
#Model tanpa interaksi (efek utama saja)
fit_no_inter <- glm(Freq ~ Merokok + Status, family = poisson, data = data)
summary(fit_no_inter)
##
## Call:
## glm(formula = Freq ~ Merokok + Status, family = poisson, data = data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 3.9300 0.1251 31.416 < 2e-16 ***
## MerokokYa -0.9808 0.1354 -7.244 4.36e-13 ***
## StatusSangat_Sehat 0.4055 0.1543 2.628 0.0086 **
## StatusSehat 0.3567 0.1558 2.289 0.0221 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 68.2044 on 5 degrees of freedom
## Residual deviance: 1.0797 on 2 degrees of freedom
## AIC: 42.294
##
## Number of Fisher Scoring iterations: 4
#Model dengan interaksi
fit_inter <- glm(Freq ~ Merokok * Status, family = poisson, data = data)
summary(fit_inter)
##
## Call:
## glm(formula = Freq ~ Merokok * Status, family = poisson, data = data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 3.91202 0.14142 27.662 < 2e-16 ***
## MerokokYa -0.91629 0.26458 -3.463 0.000534 ***
## StatusSangat_Sehat 0.47000 0.18028 2.607 0.009131 **
## StatusSehat 0.33647 0.18516 1.817 0.069193 .
## MerokokYa:StatusSangat_Sehat -0.24686 0.35000 -0.705 0.480615
## MerokokYa:StatusSehat 0.06899 0.34296 0.201 0.840565
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 6.8204e+01 on 5 degrees of freedom
## Residual deviance: 3.1086e-15 on 0 degrees of freedom
## AIC: 45.214
##
## Number of Fisher Scoring iterations: 3
#Uji perbandingan model untuk melihat signifikansi interaksi
anova(fit_no_inter, fit_inter, test = "Chisq")
Interpretasi : Koefisien interaksi MerokokYa:StatusSangat_Sehat dan MerokokYa:StatusSehat tidak signifikan (p = 0.48 dan 0.84), menunjukkan tidak ada bukti kuat bahwa efek Merokok berbeda secara signifikan antar kategori Status.
Residual deviance sangat kecil (mendekati nol) karena model jenuh (df = 0).
Koefisien utama mirip dengan model tanpa interaksi
Model log linear tiga arah digunakan untuk menganalisis hubungan antara tiga variabel kategori dalam tabel kontingensi multidimensi. Model ini memodelkan logaritma frekuensi yang diharapkan sebagai fungsi linier dari efek utama, interaksi dua arah, dan interaksi tiga arah.
Bentuk Umum Model
Model lengkap (saturated) untuk tiga variabel \(X\), \(Y\), dan \(Z\) dengan kategori \(i\), \(j\), dan \(k\):
\[ \log(\hat{m}_{ijk}) = \mu + \lambda_i^X + \lambda_j^Y + \lambda_k^Z + \lambda_{ij}^{XY} + \lambda_{ik}^{XZ} + \lambda_{jk}^{YZ} + \lambda_{ijk}^{XYZ} \]
di mana: - \(\mu\): intercept (rata-rata umum) - \(\lambda_i^X, \lambda_j^Y, \lambda_k^Z\): efek utama - \(\lambda_{ij}^{XY}, \lambda_{ik}^{XZ}, \lambda_{jk}^{YZ}\): interaksi dua arah - \(\lambda_{ijk}^{XYZ}\): interaksi tiga arah
Untuk tabel kontingensi tiga arah dengan variabel \(X\), \(Y\), dan \(Z\), bentuk model tanpa interaksi adalah:
\[ \log(m_{ijk}) = \mu + \lambda_i^X + \lambda_j^Y + \lambda_k^Z \]
di mana:
- \(m_{ijk}\) adalah frekuensi yang
diharapkan pada sel \((i,j,k)\),
- \(\mu\) adalah intercept,
- \(\lambda_i^X\), \(\lambda_j^Y\), dan \(\lambda_k^Z\) adalah efek utama variabel
\(X\), \(Y\), dan \(Z\).
Model ini mengasumsikan ketiga variabel tersebut independen satu sama lain.
Model log-linear tiga arah digunakan untuk memodelkan hubungan antar tiga variabel kategori dalam tabel kontingensi tiga dimensi. Model ini melibatkan efek utama, interaksi dua arah, dan interaksi tiga arah.
Pengujian interaksi bertujuan untuk menentukan apakah efek interaksi antar variabel (dua arah atau tiga arah) signifikan atau tidak. Secara umum, pengujian dilakukan dengan membandingkan model yang lebih sederhana (tanpa interaksi tertentu) dengan model yang lebih kompleks (dengan interaksi tersebut) menggunakan uji Chi-Square (likelihood ratio test).
Jika \(\chi^2\) hitung > \(\chi^2\) tabel, tolak \(H_0\) dan simpulkan interaksi signifikan.
Kasus ini menganalisis hubungan antara tiga variabel kategori: Profesi, Jenis Bacaan, dan Jenis Kelamin. Penelitian menemukan adanya hubungan signifikan antar ketiga variabel tersebut.
Sumber data dan kasus nyata diambil dari jurnal Siti Fatimah Sihotang & Zuhri (2020), Analisis Model Log Linier Tiga Dimensi Untuk Data Kualitatif, Jurnal MESUISU.
| Profesi | Jenis Bacaan | Jenis Kelamin | Frekuensi |
|---|---|---|---|
| Guru | Buku | Laki-laki | 25 |
| Guru | Buku | Perempuan | 30 |
| Guru | Majalah | Laki-laki | 15 |
| Guru | Majalah | Perempuan | 20 |
| Dokter | Buku | Laki-laki | 10 |
| Dokter | Buku | Perempuan | 12 |
| Dokter | Majalah | Laki-laki | 8 |
| Dokter | Majalah | Perempuan | 7 |
library(MASS)
#Membuat data frame simulasi
data <- data.frame(
Profesi = factor(c("Guru", "Guru", "Guru", "Guru", "Dokter", "Dokter", "Dokter", "Dokter")),
JenisBacaan = factor(c("Buku", "Buku", "Majalah", "Majalah", "Buku", "Buku", "Majalah", "Majalah")),
JenisKelamin = factor(c("Laki-laki", "Perempuan", "Laki-laki", "Perempuan", "Laki-laki", "Perempuan", "Laki-laki", "Perempuan")),
Frekuensi = c(25, 30, 15, 20, 10, 12, 8, 7)
)
#Membuat tabel kontingensi tiga arah
tbl <- xtabs(Frekuensi ~ Profesi + JenisBacaan + JenisKelamin, data = data)
#Model saturated (lengkap dengan interaksi tiga arah)
model_sat <- loglm(~ Profesi * JenisBacaan * JenisKelamin, data = tbl)
summary(model_sat)
## Formula:
## ~Profesi * JenisBacaan * JenisKelamin
## attr(,"variables")
## list(Profesi, JenisBacaan, JenisKelamin)
## attr(,"factors")
## Profesi JenisBacaan JenisKelamin Profesi:JenisBacaan
## Profesi 1 0 0 1
## JenisBacaan 0 1 0 1
## JenisKelamin 0 0 1 0
## Profesi:JenisKelamin JenisBacaan:JenisKelamin
## Profesi 1 0
## JenisBacaan 0 1
## JenisKelamin 1 1
## Profesi:JenisBacaan:JenisKelamin
## Profesi 1
## JenisBacaan 1
## JenisKelamin 1
## attr(,"term.labels")
## [1] "Profesi" "JenisBacaan"
## [3] "JenisKelamin" "Profesi:JenisBacaan"
## [5] "Profesi:JenisKelamin" "JenisBacaan:JenisKelamin"
## [7] "Profesi:JenisBacaan:JenisKelamin"
## attr(,"order")
## [1] 1 1 1 2 2 2 3
## attr(,"intercept")
## [1] 1
## attr(,"response")
## [1] 0
## attr(,".Environment")
## <environment: R_GlobalEnv>
##
## Statistics:
## X^2 df P(> X^2)
## Likelihood Ratio 0 0 1
## Pearson 0 0 1
#Model tanpa interaksi tiga arah (homogeneous association)
model_homog <- loglm(~ Profesi * JenisBacaan + Profesi * JenisKelamin + JenisBacaan * JenisKelamin, data = tbl)
summary(model_homog)
## Formula:
## ~Profesi * JenisBacaan + Profesi * JenisKelamin + JenisBacaan *
## JenisKelamin
## attr(,"variables")
## list(Profesi, JenisBacaan, JenisKelamin)
## attr(,"factors")
## Profesi JenisBacaan JenisKelamin Profesi:JenisBacaan
## Profesi 1 0 0 1
## JenisBacaan 0 1 0 1
## JenisKelamin 0 0 1 0
## Profesi:JenisKelamin JenisBacaan:JenisKelamin
## Profesi 1 0
## JenisBacaan 0 1
## JenisKelamin 1 1
## attr(,"term.labels")
## [1] "Profesi" "JenisBacaan"
## [3] "JenisKelamin" "Profesi:JenisBacaan"
## [5] "Profesi:JenisKelamin" "JenisBacaan:JenisKelamin"
## attr(,"order")
## [1] 1 1 1 2 2 2
## attr(,"intercept")
## [1] 1
## attr(,"response")
## [1] 0
## attr(,".Environment")
## <environment: R_GlobalEnv>
##
## Statistics:
## X^2 df P(> X^2)
## Likelihood Ratio 0.2773724 1 0.5984286
## Pearson 0.2771310 1 0.5985878
#Uji pengujian interaksi tiga arah
anova(model_homog, model_sat, test = "Chisq")
## LR tests for hierarchical log-linear models
##
## Model 1:
## ~Profesi * JenisBacaan + Profesi * JenisKelamin + JenisBacaan * JenisKelamin
## Model 2:
## ~Profesi * JenisBacaan * JenisKelamin
##
## Deviance df Delta(Dev) Delta(df) P(> Delta(Dev)
## Model 1 0.2773724 1
## Model 2 0.0000000 0 0.2773724 1 0.59843
## Saturated 0.0000000 0 0.0000000 0 1.00000
Interpretasi :
Karena p-value (0.5984) jauh lebih besar dari 0.05, tidak ada bukti statistik yang cukup untuk menolak hipotesis nol bahwa interaksi tiga arah tidak signifikan.
Dengan kata lain, model tanpa interaksi tiga arah (model homogeneous association) sudah cukup menjelaskan data tanpa perlu menambahkan interaksi tiga arah.
Model lebih sederhana ini lebih disukai karena memberikan fit yang baik tanpa kompleksitas tambahan.
# Menggunakan data simulasi dari jurnal Siti Fatimah Sihotang & Zuhri (2020)
# Data: Profesi, Jenis Bacaan, Jenis Kelamin, dan Frekuensi
data <- data.frame(
Profesi = factor(c("Guru", "Guru", "Guru", "Guru", "Dokter", "Dokter", "Dokter", "Dokter")),
JenisBacaan = factor(c("Buku", "Buku", "Majalah", "Majalah", "Buku", "Buku", "Majalah", "Majalah")),
JenisKelamin = factor(c("Laki-laki", "Perempuan", "Laki-laki", "Perempuan", "Laki-laki", "Perempuan", "Laki-laki", "Perempuan")),
Frekuensi = c(25, 30, 15, 20, 10, 12, 8, 7)
)
# Membuat tabel kontingensi tiga arah
tbl <- xtabs(Frekuensi ~ Profesi + JenisBacaan + JenisKelamin, data = data)
# Fitting model log-linear tiga arah menggunakan glm dengan distribusi Poisson
fit <- glm(Frekuensi ~ Profesi * JenisBacaan * JenisKelamin, family = poisson, data = data)
# Menampilkan estimasi koefisien lengkap dengan standard error, z-value, dan p-value
summary(fit)$coefficients
## Estimate Std. Error
## (Intercept) 2.302585e+00 0.3162278
## ProfesiGuru 9.162907e-01 0.3741657
## JenisBacaanMajalah -2.231436e-01 0.4743416
## JenisKelaminPerempuan 1.823216e-01 0.4281744
## ProfesiGuru:JenisBacaanMajalah -2.876821e-01 0.5759051
## ProfesiGuru:JenisKelaminPerempuan 6.355529e-16 0.5066228
## JenisBacaanMajalah:JenisKelaminPerempuan -3.158529e-01 0.6717071
## ProfesiGuru:JenisBacaanMajalah:JenisKelaminPerempuan 4.212135e-01 0.8007437
## z value Pr(>|z|)
## (Intercept) 7.281413e+00 3.303407e-13
## ProfesiGuru 2.448890e+00 1.432972e-02
## JenisBacaanMajalah -4.704279e-01 6.380493e-01
## JenisKelaminPerempuan 4.258114e-01 6.702453e-01
## ProfesiGuru:JenisBacaanMajalah -4.995304e-01 6.174058e-01
## ProfesiGuru:JenisKelaminPerempuan 1.254489e-15 1.000000e+00
## JenisBacaanMajalah:JenisKelaminPerempuan -4.702242e-01 6.381948e-01
## ProfesiGuru:JenisBacaanMajalah:JenisKelaminPerempuan 5.260278e-01 5.988689e-01
# Goodness of Fit dengan deviance residual
deviance_value <- deviance(fit)
df_residual <- df.residual(fit)
p_value <- 1 - pchisq(deviance_value, df_residual)
# Fitting model log-linear tiga arah dengan glm (Poisson)
fit <- glm(Frekuensi ~ Profesi * JenisBacaan * JenisKelamin, family = poisson, data = data)
# Menghitung dan menampilkan AIC model
aic_value <- AIC(fit)
cat("Akaike Information Criterion (AIC) untuk model:", aic_value, "\n")
## Akaike Information Criterion (AIC) untuk model: 51.94654
# Jika ingin membandingkan beberapa model, misal model tanpa interaksi tiga arah:
fit_no_interaction <- glm(Frekuensi ~ Profesi + JenisBacaan + JenisKelamin +
Profesi:JenisBacaan + Profesi:JenisKelamin + JenisBacaan:JenisKelamin,
family = poisson, data = data)
# Menampilkan AIC untuk kedua model
aic_values <- AIC(fit, fit_no_interaction)
print(aic_values)
## df AIC
## fit 8 51.94654
## fit_no_interaction 7 50.22391
Interpretasi :
| Koefisien | Estimate | Std. Error | z value | Pr(> | z |
|---|---|---|---|---|---|
| (Intercept) | 2.3026 | 0.3162 | 7.2814 | < 0.001 | Log frekuensi dasar untuk kategori referensi (Profesi=Dokter, JenisBacaan=Buku, JenisKelamin=Laki-laki). Signifikan. |
| ProfesiGuru | 0.9163 | 0.3742 | 2.4489 | 0.0143 | Profesi Guru berpengaruh positif signifikan terhadap log frekuensi dibanding Dokter. |
| JenisBacaanMajalah | -0.2231 | 0.4743 | -0.4704 | 0.6380 | Jenis Bacaan Majalah tidak berpengaruh signifikan dibanding Buku. |
| JenisKelaminPerempuan | 0.1823 | 0.4282 | 0.4258 | 0.6702 | Jenis Kelamin Perempuan tidak berpengaruh signifikan dibanding Laki-laki. |
| ProfesiGuru:JenisBacaanMajalah | -0.2877 | 0.5759 | -0.4995 | 0.6174 | Interaksi Profesi Guru dengan Jenis Bacaan Majalah tidak signifikan. |
| ProfesiGuru:JenisKelaminPerempuan | 6.36e-16 | 0.5066 | 1.25e-15 | 1.0000 | Interaksi Profesi Guru dengan Jenis Kelamin Perempuan tidak signifikan (nilai hampir nol). |
| JenisBacaanMajalah:JenisKelaminPerempuan | -0.3159 | 0.6717 | -0.4702 | 0.6382 | Interaksi Jenis Bacaan Majalah dengan Jenis Kelamin Perempuan tidak signifikan. |
| ProfesiGuru:JenisBacaanMajalah:JenisKelaminPerempuan | 0.4212 | 0.8007 | 0.5260 | 0.5989 | Interaksi tiga arah tidak signifikan. |
Model fit_no_interaction memiliki nilai AIC lebih rendah (50.22) dibandingkan model fit (51.95).
Selisih AIC antara kedua model adalah sekitar 1.72 (51.95 - 50.22).
Menurut prinsip umum dalam pemilihan model menggunakan AIC, perbedaan AIC kurang dari 2 dianggap tidak signifikan, sehingga kedua model memiliki dukungan yang hampir sama dari data
Data dan kasus dari:
Siti Fatimah Sihotang & Zuhri (2020), Analisis Model Log Linier Tiga Dimensi Untuk Data Kualitatif, Jurnal MESUISU.
data <- data.frame(
Profesi = factor(c("Guru", "Guru", "Guru", "Guru", "Dokter", "Dokter", "Dokter", "Dokter")),
JenisBacaan = factor(c("Buku", "Buku", "Majalah", "Majalah", "Buku", "Buku", "Majalah", "Majalah")),
JenisKelamin = factor(c("Laki-laki", "Perempuan", "Laki-laki", "Perempuan", "Laki-laki", "Perempuan", "Laki-laki", "Perempuan")),
Frekuensi = c(25, 30, 15, 20, 10, 12, 8, 7)
)
#Membuat tabel kontingensi tiga arah
tbl <- xtabs(Frekuensi ~ Profesi + JenisBacaan + JenisKelamin, data = data)
#Model tanpa interaksi tiga arah (homogeneous association)
model_homog <- loglm(~ Profesi * JenisBacaan + Profesi * JenisKelamin + JenisBacaan * JenisKelamin, data = tbl)
#Model saturated (lengkap dengan interaksi tiga arah)
model_sat <- loglm(~ Profesi * JenisBacaan * JenisKelamin, data = tbl)
#Uji hipotesis interaksi tiga arah dengan likelihood ratio test
anova_result <- anova(model_homog, model_sat, test = "Chisq")
print(anova_result)
## LR tests for hierarchical log-linear models
##
## Model 1:
## ~Profesi * JenisBacaan + Profesi * JenisKelamin + JenisBacaan * JenisKelamin
## Model 2:
## ~Profesi * JenisBacaan * JenisKelamin
##
## Deviance df Delta(Dev) Delta(df) P(> Delta(Dev)
## Model 1 0.2773724 1
## Model 2 0.0000000 0 0.2773724 1 0.59843
## Saturated 0.0000000 0 0.0000000 0 1.00000
Interpretasi : Karena p-value (0.5984) jauh lebih besar dari 0.05, tidak ada bukti statistik yang cukup untuk menolak hipotesis nol bahwa interaksi tiga arah tidak signifikan.
Dengan kata lain, model tanpa interaksi tiga arah (model homogeneous association) sudah cukup menjelaskan data tanpa perlu menambahkan interaksi tiga arah
Uji model interaksi dua arah dalam model log-linear bertujuan membandingkan model Homogeneous Association (semua interaksi dua arah ada) dengan model Conditional Independence (salah satu interaksi dua arah dihilangkan, biasanya mengasumsikan dua variabel independen kondisional terhadap variabel ketiga).
Sumber :
Jurnal Satria, T. A. I., Imro’ah, N., & Huda, N. M. (2023). Penerapan Model Log Linier dalam Menganalisis Tabel Kontingensi Dua Arah.
| Kecamatan | Risiko | Frekuensi |
|---|---|---|
| Pontianak_Kota | Beresiko | 100 |
| Pontianak_Kota | Tidak_Beresiko | 80 |
| Pontianak_Selatan | Beresiko | 90 |
| Pontianak_Selatan | Tidak_Beresiko | 70 |
| Pontianak_Tenggara | Beresiko | 60 |
| Pontianak_Tenggara | Tidak_Beresiko | 50 |
| Pontianak_Timur | Beresiko | 40 |
| Pontianak_Timur | Tidak_Beresiko | 30 |
| Pontianak_Utara | Beresiko | 110 |
| Pontianak_Utara | Tidak_Beresiko | 90 |
data <- data.frame(
Kecamatan = factor(c("Pontianak_Kota", "Pontianak_Kota", "Pontianak_Selatan", "Pontianak_Selatan",
"Pontianak_Tenggara", "Pontianak_Tenggara", "Pontianak_Timur", "Pontianak_Timur",
"Pontianak_Utara", "Pontianak_Utara")),
Risiko = factor(c("Beresiko", "Tidak_Beresiko", "Beresiko", "Tidak_Beresiko",
"Beresiko", "Tidak_Beresiko", "Beresiko", "Tidak_Beresiko",
"Beresiko", "Tidak_Beresiko")),
Frekuensi = c(100, 80, 90, 70, 60, 50, 40, 30, 110, 90)
)
#Membuat tabel kontingensi
tbl <- xtabs(Frekuensi ~ Kecamatan + Risiko, data = data)
#Model Conditional Independence (tanpa interaksi)
model_condind <- loglm(~ Kecamatan + Risiko, data = tbl)
#Model Homogeneous Association (dengan interaksi)
model_homog <- loglm(~ Kecamatan * Risiko, data = tbl)
#Uji perbandingan model dengan Likelihood Ratio Test
anova_result <- anova(model_condind, model_homog, test = "Chisq")
print(anova_result)
## LR tests for hierarchical log-linear models
##
## Model 1:
## ~Kecamatan + Risiko
## Model 2:
## ~Kecamatan * Risiko
##
## Deviance df Delta(Dev) Delta(df) P(> Delta(Dev)
## Model 1 0.1732638 4
## Model 2 0.0000000 0 0.1732638 4 0.99646
## Saturated 0.0000000 0 0.0000000 0 1.00000
Interpretasi :
Karena p-value sangat besar (0.99646 > 0.05), tidak ada bukti yang cukup untuk menolak hipotesis nol bahwa model tanpa interaksi (Model 1) sudah cukup.
Dengan kata lain, interaksi dua arah antara Kecamatan dan Risiko tidak signifikan.
Model sederhana tanpa interaksi dua arah sudah menjelaskan data dengan baik.
Tidak perlu menambahkan interaksi dua arah karena tidak memperbaiki fit secara signifikan.
library(MASS)
# Contoh data frame
data <- data.frame(
Kecamatan = factor(c("Pontianak_Kota", "Pontianak_Kota", "Pontianak_Selatan", "Pontianak_Selatan",
"Pontianak_Tenggara", "Pontianak_Tenggara", "Pontianak_Timur", "Pontianak_Timur",
"Pontianak_Utara", "Pontianak_Utara")),
Risiko = factor(c("Beresiko", "Tidak_Beresiko", "Beresiko", "Tidak_Beresiko",
"Beresiko", "Tidak_Beresiko", "Beresiko", "Tidak_Beresiko",
"Beresiko", "Tidak_Beresiko")),
Status = factor(c("Status1", "Status1", "Status2", "Status2", "Status1", "Status1", "Status2", "Status2", "Status1", "Status1")),
Frekuensi = c(100, 80, 90, 70, 60, 50, 40, 30, 110, 90)
)
# Membuat tabel kontingensi tiga arah
tbl <- xtabs(Frekuensi ~ Kecamatan + Risiko + Status, data = data)
# Cek dimensi dan nama dimensi tabel
dimnames(tbl)
## $Kecamatan
## [1] "Pontianak_Kota" "Pontianak_Selatan" "Pontianak_Tenggara"
## [4] "Pontianak_Timur" "Pontianak_Utara"
##
## $Risiko
## [1] "Beresiko" "Tidak_Beresiko"
##
## $Status
## [1] "Status1" "Status2"
library(MASS)
#Model Homogeneous Association: semua interaksi dua arah ada
model_homog <- loglm(~ Kecamatan*Risiko + Kecamatan*Status + Risiko*Status, data = tbl)
#Model Conditional Association on Kecamatan: Y dan Z independen kondisional pada X
# Contoh menghilangkan kategori dengan frekuensi nol atau menggabungkan kategori
# atau menggunakan data simulasi yang lengkap
# Contoh data simulasi lengkap (tanpa nol)
data <- data.frame(
Kecamatan = factor(rep(c("A", "B"), each = 4)),
Risiko = factor(rep(c("R1", "R2"), times = 4)),
Status = factor(rep(c("S1", "S2"), times = 4)),
Frekuensi = c(10, 15, 12, 18, 14, 16, 13, 17)
)
tbl <- xtabs(Frekuensi ~ Kecamatan + Risiko + Status, data = data)
model_conditional <- loglm(~ Kecamatan*Risiko + Kecamatan*Status, data = tbl)
#Uji perbandingan model dengan Likelihood Ratio Test
anova_result <- anova(model_conditional, model_homog, test = "Chisq")
print(anova_result)
## LR tests for hierarchical log-linear models
##
## Model 1:
## ~Kecamatan * Risiko + Kecamatan * Status + Risiko * Status
## Model 2:
## ~Kecamatan * Risiko + Kecamatan * Status
##
## Deviance df Delta(Dev) Delta(df) P(> Delta(Dev)
## Model 1 0.0000 4
## Model 2 156.6079 2 -156.6079 2 1
## Saturated 0.0000 0 156.6079 2 0
Interpretasi :
Karena p-value < 0.05, tolak hipotesis nol bahwa model conditional association on Kecamatan sudah cukup.
Ada bukti kuat bahwa interaksi dua arah antara Risiko dan Status signifikan dan perlu dimasukkan dalam model.
Model homogeneous association (Model 2) jauh lebih baik dalam menjelaskan data dibanding model conditional independence (Model 1).
Dengan kata lain, Risiko dan Status tidak independen kondisional pada Kecamatan.
data <- data.frame(
Kecamatan = factor(rep(c("Pontianak_Kota", "Pontianak_Selatan", "Pontianak_Tenggara"), each = 4)),
Risiko = factor(rep(c("Beresiko", "Tidak_Beresiko"), times = 6)),
Status = factor(rep(c("Status1", "Status2"), times = 6)),
Frekuensi = c(100, 80, 90, 70, 60, 50, 40, 30, 110, 90, 85, 75)
)
# Membuat tabel kontingensi tiga arah
tbl <- xtabs(Frekuensi ~ Kecamatan + Risiko + Status, data = data)
# Model Conditional Association
model_conditional <- loglm(~ Kecamatan*Risiko + Kecamatan*Status, data = tbl)
# Model Homogeneous Association
model_homog <- loglm(~ Kecamatan*Risiko + Kecamatan*Status + Risiko*Status, data = tbl)
# Uji perbandingan model
anova_result <- anova(model_conditional, model_homog, test = "Chisq")
print(anova_result)
## LR tests for hierarchical log-linear models
##
## Model 1:
## ~Kecamatan * Risiko + Kecamatan * Status
## Model 2:
## ~Kecamatan * Risiko + Kecamatan * Status + Risiko * Status
##
## Deviance df Delta(Dev) Delta(df) P(> Delta(Dev)
## Model 1 1210.493 3
## Model 2 0.000 2 1210.493 1 0
## Saturated 0.000 0 0.000 2 1
Interpretasi :
Karena p-value < 0.05, tolak hipotesis nol bahwa model tanpa interaksi Risiko:Status sudah cukup.
Ada bukti kuat bahwa interaksi dua arah antara Risiko dan Status signifikan dan perlu dimasukkan dalam model.
Model dengan interaksi dua arah (Model 2) jauh lebih baik dalam menjelaskan data dibanding model tanpa interaksi (Model 1).
Dengan kata lain, Risiko dan Status tidak independen kondisional pada Kecamatan.
library(MASS)
# Contoh data frame
data <- data.frame(
Kecamatan = factor(rep(c("Pontianak_Kota", "Pontianak_Selatan", "Pontianak_Tenggara"), each = 4)),
Risiko = factor(rep(c("Beresiko", "Tidak_Beresiko"), times = 6)),
Status = factor(rep(c("Status1", "Status2"), times = 6)),
Frekuensi = c(100, 80, 90, 70, 60, 50, 40, 30, 110, 90, 85, 75)
)
# Membuat tabel kontingensi tiga arah
tbl <- xtabs(Frekuensi ~ Kecamatan + Risiko + Status, data = data)
# Model Conditional on Y (Risiko)
model_conditional <- loglm(~ Risiko*Kecamatan + Risiko*Status, data = tbl)
# Model Homogeneous Association
model_homog <- loglm(~ Kecamatan*Risiko + Kecamatan*Status + Risiko*Status, data = tbl)
# Uji perbandingan model dengan Likelihood Ratio Test
anova_result <- anova(model_conditional, model_homog, test = "Chisq")
print(anova_result)
## LR tests for hierarchical log-linear models
##
## Model 1:
## ~Risiko * Kecamatan + Risiko * Status
## Model 2:
## ~Kecamatan * Risiko + Kecamatan * Status + Risiko * Status
##
## Deviance df Delta(Dev) Delta(df) P(> Delta(Dev)
## Model 1 0 4
## Model 2 0 2 0 2 1
## Saturated 0 0 0 2 1
Interpretasi :
Karena p-value = 1 (jauh > 0.05), tidak ada bukti untuk menolak hipotesis nol bahwa Model 1 sudah cukup menjelaskan data.
Penambahan interaksi antara Risiko dan Status dalam Model 2 tidak meningkatkan fit model secara signifikan dibanding Model 1.
Dengan kata lain, model yang mengasumsikan bahwa Kecamatan dan Status independen kondisional pada Risiko (Model 1) sudah memadai.
Model yang lebih kompleks (Model 2) tidak memberikan perbaikan yang berarti.
library(MASS)
# Contoh data frame
data <- data.frame(
Kecamatan = factor(rep(c("Pontianak_Kota", "Pontianak_Selatan", "Pontianak_Tenggara"), each = 4)),
Risiko = factor(rep(c("Beresiko", "Tidak_Beresiko"), times = 6)),
Status = factor(rep(c("Status1", "Status2"), times = 6)),
Frekuensi = c(100, 80, 90, 70, 60, 50, 40, 30, 110, 90, 85, 75)
)
# Membuat tabel kontingensi tiga arah
tbl <- xtabs(Frekuensi ~ Kecamatan + Risiko + Status, data = data)
# Model Conditional Association on Status
model_conditional <- loglm(~ Status*Kecamatan + Status*Risiko, data = tbl)
# Model Homogeneous Association
model_homog <- loglm(~ Kecamatan*Risiko + Kecamatan*Status + Risiko*Status, data = tbl)
# Uji perbandingan model dengan Likelihood Ratio Test
anova_result <- anova(model_conditional, model_homog, test = "Chisq")
print(anova_result)
## LR tests for hierarchical log-linear models
##
## Model 1:
## ~Status * Kecamatan + Status * Risiko
## Model 2:
## ~Kecamatan * Risiko + Kecamatan * Status + Risiko * Status
##
## Deviance df Delta(Dev) Delta(df) P(> Delta(Dev)
## Model 1 0 4
## Model 2 0 2 0 2 1
## Saturated 0 0 0 2 1
Interpretasi :
Karena p-value = 1 (jauh > 0.05), tidak ada bukti untuk menolak hipotesis nol bahwa Model 1 sudah cukup menjelaskan data.
Penambahan interaksi antara Kecamatan dan Risiko serta interaksi Risiko dan Status dalam Model 2 tidak meningkatkan fit model secara signifikan dibanding Model 1.
Dengan kata lain, model yang mengasumsikan interaksi antara Status dengan Kecamatan dan Risiko (Model 1) sudah memadai.
Model yang lebih kompleks (Model 2) tidak memberikan perbaikan yang
berarti. x
# 22. PEMILIHAN MODEL TERBAIK
library(MASS)
# Data simulasi berdasarkan data sebelumnya
data <- data.frame(
Kecamatan = factor(rep(c("Pontianak_Kota", "Pontianak_Selatan", "Pontianak_Tenggara"), each = 4)),
Risiko = factor(rep(c("Beresiko", "Tidak_Beresiko"), times = 6)),
Status = factor(rep(c("Status1", "Status2"), times = 6)),
Frekuensi = c(100, 80, 90, 70, 60, 50, 40, 30, 110, 90, 85, 75)
)
# Ubah data menjadi format data frame dengan variabel faktor dan frekuensi
tbl_df <- data
# Buat model Poisson regresi dengan interaksi antara Kecamatan dan Risiko
bestmodel <- glm(Frekuensi ~ Kecamatan + Risiko + Status + Kecamatan:Risiko,
family = poisson(link = "log"),
data = tbl_df)
# Tampilkan ringkasan model
summary(bestmodel)
##
## Call:
## glm(formula = Frekuensi ~ Kecamatan + Risiko + Status + Kecamatan:Risiko,
## family = poisson(link = "log"), data = tbl_df)
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error z value
## (Intercept) 4.55388 0.07255 62.771
## KecamatanPontianak_Selatan -0.64185 0.12354 -5.195
## KecamatanPontianak_Tenggara 0.02598 0.10194 0.255
## RisikoTidak_Beresiko -0.23639 0.10922 -2.164
## StatusStatus2 NA NA NA
## KecamatanPontianak_Selatan:RisikoTidak_Beresiko 0.01325 0.18555 0.071
## KecamatanPontianak_Tenggara:RisikoTidak_Beresiko 0.06933 0.15205 0.456
## Pr(>|z|)
## (Intercept) < 2e-16 ***
## KecamatanPontianak_Selatan 2.04e-07 ***
## KecamatanPontianak_Tenggara 0.7989
## RisikoTidak_Beresiko 0.0304 *
## StatusStatus2 NA
## KecamatanPontianak_Selatan:RisikoTidak_Beresiko 0.9431
## KecamatanPontianak_Tenggara:RisikoTidak_Beresiko 0.6484
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 96.338 on 11 degrees of freedom
## Residual deviance: 14.854 on 6 degrees of freedom
## AIC: 99.732
##
## Number of Fisher Scoring iterations: 4
Interpretasi :
Variabel KecamatanPontianak_Selatan dan RisikoTidak_Beresiko berpengaruh signifikan terhadap frekuensi (count).
Variabel KecamatanPontianak_Tenggara dan interaksi Kecamatan:Risiko tidak signifikan.
Variabel Status perlu diperiksa ulang karena koefisiennya tidak terestimasi.
Model secara keseluruhan fit dengan baik (penurunan deviance besar dan residual deviance kecil).
MODEL LOG LINEAR 2 ARAH
Model log linear dua arah adalah model statistik yang digunakan untuk menganalisis hubungan asosiasi antara dua variabel kategori dalam tabel kontingensi dua dimensi. Model ini memodelkan logaritma frekuensi yang diharapkan pada setiap sel tabel sebagai fungsi linier dari efek utama masing-masing variabel dan interaksi antar variabel.
Secara matematis, model log linear dua arah dapat dituliskan sebagai:
\[ \log(\hat{m}_{ij}) = \mu + \lambda_i^X + \lambda_j^Y + \lambda_{ij}^{XY} \]
Model log linear dua arah terdiri dari dua tipe utama:
- Model tak jenuh (independen): hanya mengandung efek
utama \(\mu + \lambda_i^X +
\lambda_j^Y\), tanpa interaksi.
- Model jenuh (saturated): mengandung semua efek utama
dan interaksi \(\mu + \lambda_i^X +
\lambda_j^Y + \lambda_{ij}^{XY}\), sehingga fit sempurna dengan
data.
Penelitian oleh Satria et al. (2023) menggunakan model log linier untuk menganalisis hubungan antara variabel kategori dalam data stunting di Kota Pontianak. Data disajikan dalam tabel kontingensi dua arah dan dianalisis menggunakan model log linier jenuh dan tak jenuh untuk menguji asosiasi antar variabel.
Data diambil dari hasil rekapitulasi Pendataan Keluarga 2021 (PK21) berupa jumlah kelurga beresiko stunting di Kota Pontianak pada tahun 2021 yang disajikan pada tabel berikut.
| Kecamatan | Resiko | Tidak Beresiko |
|---|---|---|
| Pontianak Selatan | 5238 | 3107 |
| Pontianak Timur | 9740 | 2367 |
| Pontianak Barat | 9886 | 2699 |
| Pontianak Utara | 14349 | 1274 |
| Pontianak Kota | 9195 | 3865 |
| Pontianak Tenggara | 3137 | 1567 |
Sumber : Badan Kependudukan dan Keluarga Berencana Nasional (BKKBN) perwakilan Kalimantan Barat
Sintaks R untuk Model Log Linier dan Model Saturated
library(MASS)
#Data frekuensi kasus stunting berdasarkan kecamatan
kecamatan <- c("Pontianak_Selatan", "Pontianak_Timur", "Pontianak_Barat",
"Pontianak_Utara", "Pontianak_Kota", "Pontianak_Tenggara")
resiko <- c(5238, 9740, 9886, 14349, 9195, 3137)
tidak_resiko <- c(3107, 2367, 2699, 1274, 3865, 1567)
#Membuat data frame
data_stunting <- data.frame(
Kecamatan = rep(kecamatan, each = 2),
Risiko = factor(rep(c("Resiko", "Tidak_Beresiko"), times = 6)),
Frekuensi = c(rbind(resiko, tidak_resiko))
)
print(data_stunting)
## Kecamatan Risiko Frekuensi
## 1 Pontianak_Selatan Resiko 5238
## 2 Pontianak_Selatan Tidak_Beresiko 3107
## 3 Pontianak_Timur Resiko 9740
## 4 Pontianak_Timur Tidak_Beresiko 2367
## 5 Pontianak_Barat Resiko 9886
## 6 Pontianak_Barat Tidak_Beresiko 2699
## 7 Pontianak_Utara Resiko 14349
## 8 Pontianak_Utara Tidak_Beresiko 1274
## 9 Pontianak_Kota Resiko 9195
## 10 Pontianak_Kota Tidak_Beresiko 3865
## 11 Pontianak_Tenggara Resiko 3137
## 12 Pontianak_Tenggara Tidak_Beresiko 1567
tbl_stunting <- xtabs(Frekuensi ~ Kecamatan + Risiko, data = data_stunting)
print(tbl_stunting)
## Risiko
## Kecamatan Resiko Tidak_Beresiko
## Pontianak_Barat 9886 2699
## Pontianak_Kota 9195 3865
## Pontianak_Selatan 5238 3107
## Pontianak_Tenggara 3137 1567
## Pontianak_Timur 9740 2367
## Pontianak_Utara 14349 1274
#Model log linier independen (tanpa interaksi)
model_indep <- loglm(~ Kecamatan + Risiko, data = tbl_stunting)
summary(model_indep)
## Formula:
## ~Kecamatan + Risiko
## attr(,"variables")
## list(Kecamatan, Risiko)
## attr(,"factors")
## Kecamatan Risiko
## Kecamatan 1 0
## Risiko 0 1
## attr(,"term.labels")
## [1] "Kecamatan" "Risiko"
## attr(,"order")
## [1] 1 1
## attr(,"intercept")
## [1] 1
## attr(,"response")
## [1] 0
## attr(,".Environment")
## <environment: R_GlobalEnv>
##
## Statistics:
## X^2 df P(> X^2)
## Likelihood Ratio 3918.986 5 0
## Pearson 3654.237 5 0
#Model log linier saturated (dengan interaksi)
model_sat <- loglm(~ Kecamatan * Risiko, data = tbl_stunting)
summary(model_indep)
## Formula:
## ~Kecamatan + Risiko
## attr(,"variables")
## list(Kecamatan, Risiko)
## attr(,"factors")
## Kecamatan Risiko
## Kecamatan 1 0
## Risiko 0 1
## attr(,"term.labels")
## [1] "Kecamatan" "Risiko"
## attr(,"order")
## [1] 1 1
## attr(,"intercept")
## [1] 1
## attr(,"response")
## [1] 0
## attr(,".Environment")
## <environment: R_GlobalEnv>
##
## Statistics:
## X^2 df P(> X^2)
## Likelihood Ratio 3918.986 5 0
## Pearson 3654.237 5 0
# Menghitung Odds Ratio per kecamatan:
# OR = (resiko / tidak_resiko) / (total resiko / total tidak_resiko) sebagai referensi keseluruhan
total_resiko <- sum(resiko)
total_tidak_resiko <- sum(tidak_resiko)
overall_odds <- total_resiko / total_tidak_resiko
df <- data.frame(kecamatan, resiko, tidak_resiko, stringsAsFactors = FALSE)
df$odds <- df$resiko / df$tidak_resiko
df$odds_ratio <- df$odds / overall_odds
df[, c("kecamatan", "odds", "odds_ratio")]
Interpretasi :
| Kecamatan | Odds | Interpretasi Odds |
|---|---|---|
| Pontianak_Selatan | 1.69 | Setiap 1,69 kasus berisiko ada 1 kasus tidak berisiko. Risiko relatif sedang. |
| Pontianak_Timur | 4.11 | Setiap 4,11 kasus berisiko ada 1 kasus tidak berisiko. Risiko cukup tinggi. |
| Pontianak_Barat | 3.66 | Setiap 3,66 kasus berisiko ada 1 kasus tidak berisiko. Risiko cukup tinggi. |
| Pontianak_Utara | 11.26 | Setiap 11,26 kasus berisiko ada 1 kasus tidak berisiko. Risiko sangat tinggi. |
| Pontianak_Kota | 2.38 | Setiap 2,38 kasus berisiko ada 1 kasus tidak berisiko. Risiko sedang. |
| Pontianak_Tenggara | 2.00 | Setiap 2 kasus berisiko ada 1 kasus tidak berisiko. Risiko sedang. |
Untuk menghitung persentase kenaikan odd ratio terhadap referensi (Kota Pontianak), rumusnya adalah:
(OR−1)×100%
| Kecamatan | Odds Ratio | Interpretasi Odds Ratio |
|---|---|---|
| Pontianak_Selatan | 0.49 | Risiko 51% lebih rendah dari rata-rata Kota Pontianak. |
| Pontianak_Timur | 1.19 | Risiko 19% lebih tinggi dari rata-rata Kota Pontianak. |
| Pontianak_Barat | 1.06 | Risiko 6% lebih tinggi dari rata-rata Kota Pontianak. |
| Pontianak_Utara | 3.25 | Risiko 225% lebih tinggi dari rata-rata Kota Pontianak. |
| Pontianak_Kota | 0.69 | Risiko 31% lebih rendah dari rata-rata Kota Pontianak. |
| Pontianak_Tenggara | 0.58 | Risiko 42% lebih rendah dari rata-rata Kota Pontianak. |
kecamatan <- c("Pontianak_Selatan", "Pontianak_Timur", "Pontianak_Barat",
"Pontianak_Utara", "Pontianak_Kota", "Pontianak_Tenggara")
resiko <- c(5238, 9740, 9886, 14349, 9195, 3137)
tidak_resiko <- c(3107, 2367, 2699, 1274, 3865, 1567)
#Membuat tabel kontingensi
data_matrix <- matrix(c(resiko, tidak_resiko), nrow = length(kecamatan), byrow = FALSE)
rownames(data_matrix) <- kecamatan
colnames(data_matrix) <- c("Resiko", "Tidak_Resiko")
data_matrix
## Resiko Tidak_Resiko
## Pontianak_Selatan 5238 3107
## Pontianak_Timur 9740 2367
## Pontianak_Barat 9886 2699
## Pontianak_Utara 14349 1274
## Pontianak_Kota 9195 3865
## Pontianak_Tenggara 3137 1567
df <- data.frame(
Kecamatan = rep(kecamatan, each = 2),
Risiko = rep(c("Resiko", "Tidak_Resiko"), times = length(kecamatan)),
Frekuensi = as.vector(t(data_matrix))
)
#Model tanpa interaksi: ~ Kecamatan + Risiko
model_indep <- glm(Frekuensi ~ Kecamatan + Risiko, family = poisson(link = "log"), data = df)
summary(model_indep)
##
## Call:
## glm(formula = Frekuensi ~ Kecamatan + Risiko, family = poisson(link = "log"),
## data = df)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 9.186658 0.009155 1003.511 < 2e-16 ***
## KecamatanPontianak_Kota 0.037048 0.012491 2.966 0.00302 **
## KecamatanPontianak_Selatan -0.410843 0.014117 -29.103 < 2e-16 ***
## KecamatanPontianak_Tenggara -0.984092 0.017089 -57.585 < 2e-16 ***
## KecamatanPontianak_Timur -0.038722 0.012730 -3.042 0.00235 **
## KecamatanPontianak_Utara 0.216239 0.011978 18.053 < 2e-16 ***
## RisikoTidak_Resiko -1.242504 0.009306 -133.512 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 33040 on 11 degrees of freedom
## Residual deviance: 3919 on 5 degrees of freedom
## AIC: 4055.2
##
## Number of Fisher Scoring iterations: 4
🔹 Intercept Estimate = 9.1867
Interpretasi: log dari frekuensi keluarga berisiko di Pontianak Barat adalah 9.1867
Dalam bentuk eksponensial: exp(9.1867) ≈ 9,825 → estimasi jumlah keluarga berisiko di Pontianak Barat
| Kecamatan | Estimate | exp(Estimate) | Interpretasi |
|---|---|---|---|
| Pontianak_Kota | 0.0370 | 1.038 | Frekuensi 3.8% lebih tinggi dari Pontianak Barat |
| Pontianak_Selatan | -0.4108 | 0.663 | Frekuensi 33.7% lebih rendah dari Pontianak Barat |
| Pontianak_Tenggara | -0.9841 | 0.374 | Frekuensi 62.6% lebih rendah dari Pontianak Barat |
| Pontianak_Timur | -0.0387 | 0.962 | Frekuensi 3.8% lebih rendah dari Pontianak Barat |
| Pontianak_Utara | 0.2162 | 1.241 | Frekuensi 24.1% lebih tinggi dari Pontianak Barat |
Semua koefisien kecamatan signifikan (p < 0.01), menunjukkan bahwa ada perbedaan signifikan antar kecamatan dalam jumlah keluarga berisiko.
🔹 Risiko (Kategori)
| Risiko | Estimate | exp(Estimate) | Interpretasi |
|---|---|---|---|
| Tidak_Resiko | -1.2425 | 0.289 | Frekuensi untuk kategori Tidak Berisiko adalah 71.1% lebih rendah |
⚖️ Goodness of Fit Null Deviance: 33,040 on 11 df
Residual Deviance: 3,919 on 5 df
AIC: 4055.2
Penurunan deviance menunjukkan bahwa model ini jauh lebih baik dibanding model tanpa prediktor (null model), meskipun deviasi residual masih agak besar → kemungkinan masih ada variabel penting lain atau perlu mempertimbangkan interaksi.
#Model dengan interaksi: ~ Kecamatan * Risiko
model_sat <- glm(Frekuensi ~ Kecamatan * Risiko, family = poisson(link = "log"), data = df)
summary(model_sat)
##
## Call:
## glm(formula = Frekuensi ~ Kecamatan * Risiko, family = poisson(link = "log"),
## data = df)
##
## Coefficients:
## Estimate Std. Error z value
## (Intercept) 9.19887 0.01006 914.629
## KecamatanPontianak_Kota -0.07246 0.01449 -5.001
## KecamatanPontianak_Selatan -0.63518 0.01709 -37.167
## KecamatanPontianak_Tenggara -1.14785 0.02049 -56.014
## KecamatanPontianak_Timur -0.01488 0.01428 -1.042
## KecamatanPontianak_Utara 0.37256 0.01307 28.503
## RisikoTidak_Resiko -1.29824 0.02172 -59.778
## KecamatanPontianak_Kota:RisikoTidak_Resiko 0.43154 0.02897 14.897
## KecamatanPontianak_Selatan:RisikoTidak_Resiko 0.77596 0.03138 24.731
## KecamatanPontianak_Tenggara:RisikoTidak_Resiko 0.60413 0.03780 15.984
## KecamatanPontianak_Timur:RisikoTidak_Resiko -0.11638 0.03157 -3.686
## KecamatanPontianak_Utara:RisikoTidak_Resiko -1.12328 0.03642 -30.844
## Pr(>|z|)
## (Intercept) < 2e-16 ***
## KecamatanPontianak_Kota 5.69e-07 ***
## KecamatanPontianak_Selatan < 2e-16 ***
## KecamatanPontianak_Tenggara < 2e-16 ***
## KecamatanPontianak_Timur 0.297339
## KecamatanPontianak_Utara < 2e-16 ***
## RisikoTidak_Resiko < 2e-16 ***
## KecamatanPontianak_Kota:RisikoTidak_Resiko < 2e-16 ***
## KecamatanPontianak_Selatan:RisikoTidak_Resiko < 2e-16 ***
## KecamatanPontianak_Tenggara:RisikoTidak_Resiko < 2e-16 ***
## KecamatanPontianak_Timur:RisikoTidak_Resiko 0.000228 ***
## KecamatanPontianak_Utara:RisikoTidak_Resiko < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 3.3040e+04 on 11 degrees of freedom
## Residual deviance: 1.1844e-12 on 0 degrees of freedom
## AIC: 146.23
##
## Number of Fisher Scoring iterations: 2
🔹 (Intercept) = 9.1989
Log dari frekuensi keluarga berisiko di Pontianak Barat
exp(9.1989) ≈ 9,899 → estimasi jumlah keluarga berisiko di Pontianak Barat
| Kecamatan | Estimate | exp(Estimate) | Interpretasi |
|---|---|---|---|
| Pontianak Kota | -0.0725 | 0.930 | Frekuensi 7% lebih rendah dari Pontianak Barat (kategori berisiko) |
| Pontianak Selatan | -0.6352 | 0.530 | Frekuensi 47% lebih rendah dari Pontianak Barat |
| Pontianak Tenggara | -1.1479 | 0.317 | Frekuensi 68% lebih rendah |
| Pontianak Timur | -0.0149 | 0.985 | Hampir sama |
| Pontianak Utara | 0.3726 | 1.451 | Frekuensi 45% lebih tinggi dibanding Pontianak Barat |
🔹 Efek Utama Risiko
| Risiko | Estimate | exp(Estimate) | Interpretasi |
|---|---|---|---|
| Tidak Berisiko | -1.2982 | 0.273 | Di Pontianak Barat, jumlah keluarga tidak berisiko 72.7% lebih rendah |
🔹 Interaksi Kecamatan × Risiko
| Interaksi | Estimate | exp(Estimate) | Interpretasi |
|---|---|---|---|
| Kota × Tidak_Resiko | 0.4315 | 1.539 | Efek tambahan: frekuensi 53.9% lebih tinggi dari Pontianak Barat |
| Selatan × Tidak_Resiko | 0.7760 | 2.173 | Efek tambahan: frekuensi 117% lebih tinggi |
| Tenggara × Tidak_Resiko | 0.6041 | 1.829 | Efek tambahan: frekuensi 82.9% lebih tinggi |
| Timur × Tidak_Resiko | -0.1164 | 0.890 | Efek tambahan: frekuensi 11% lebih rendah |
| Utara × Tidak_Resiko | -1.1233 | 0.325 | Efek tambahan: frekuensi 67.5% lebih rendah |
⚖️ Goodness of Fit Null Deviance: 33,040 (df = 11)
Residual Deviance: ~0 (df = 0)
AIC: 146.23 (sangat kecil)
🔎 Interpretasi:
Model fit sangat baik terhadap data (residual deviasi nyaris nol)
Menunjukkan bahwa interaksi sangat penting dan harus disertakan dalam model
Dobson, A. J. (1983). Introduction to statistical modelling. Springer US.
Breiman, L. (2001). Random Forests. Machine Learning
Agresti, A. (2007). An Introduction to Categorical Data Analysis (2nd ed.). Wiley.
Greenacre, M. (2007). Correspondence Analysis in Practice. CRC Press.
Agresti, A. (2013). Categorical Data Analysis (3rd ed.). Wiley.
Nugraha, J. (2016). Pengantar Analisis Data Kategorik: Metode dan Aplikasi Menggunakan Program R. Deepublish.
Agresti, A. (2018). An Introduction to Categorical Data Analysis (2nd ed.). Wiley
Rudas, T. (2018). Lectures on Categorical Data Analysis. Springer.
Astuti, A. B., Effendi, A., Astutik, S., & Sumarminingsih, E. (2020). Analisis Data Kategorik Menggunakan R: Teori dan Aplikasinya di Berbagai Bidang. UB Press.
Mangiafico, S. S. (2025). rcompanion: Functions to Support Extension Education Program Evaluation. Rutgers Cooperative Extension, New Brunswick, New Jersey. Version 2.5.0.
CRAN Project. (2025). Package rcompanion.
Hosmer, D.W., Lemeshow, S., & Sturdivant, R.X. (2013). Applied Logistic Regression (3rd ed.). Wiley.
Agresti, A. (2018). Statistical Methods for the Social Sciences (5th ed.). Pearson.
James, G., Witten, D., Hastie, T., & Tibshirani, R. (2013). An Introduction to Statistical Learning. Springer.
Saito, T., & Rehmsmeier, M. (2015). The Precision-Recall Plot Is More Informative than the ROC Plot When Evaluating Binary Classifiers on Imbalanced Datasets. PLOS ONE.
Davis, J., & Goadrich, M. (2006). The Relationship Between Precision-Recall and ROC Curves. ICML.
Google Developers. (2025). Machine Learning Crash Course: ROC and AUC.
Staf ULM. (2017). Menghitung Kinerja Algoritma Klasifikasi: Pilih ROC Curve atau Precision-Recall Curve?
MySkill Blog. (2024). Memahami Receiver Operating Characteristic (ROC) Curve dalam Data Analysis.
Halo Ryan Blog. (2024). ROC-AUC: Pengertian, Fungsi, dan Cara Menggunakannya dalam Machine Learning.