Praktikum 10 - Analisis Data Kategorik
Nofrida Elly
5/13/2021
setwd ("D:/PASCASARJANA/Semester 3/1. ADK/02. Praktikum/10")Model Log Linear untuk Data Respon Poisson
Problem 7.1 (Azen hlm.177)
7.1 Table 7.20 depicts data that was obtained from the 1994 administration of the General Social Survey (GSS) on respondent’s sex, level of fundamentalism and whether they favor or oppose the death penalty for murder. Fit and interpret the most parsimoniuos log-linear model to this data. Describe the process you went through to determine the best fitting, most parsimoniuous model. What types of association exist? Demonstrate how the fitted values obtained from the model depict these associations.
Input data
z.fund <- factor(rep(c("1fund", "2mod", "3lib"), each=4))
x.sex <- factor(rep(c("1M", "2F"), each=2, times=3))
y.fav<-factor(rep(c("1fav","2opp"),times=6))
counts<-c(128,32,123,73,182,56,168,105,119,49,111,70)
data.frame(z.fund,x.sex,y.fav,counts)## z.fund x.sex y.fav counts
## 1 1fund 1M 1fav 128
## 2 1fund 1M 2opp 32
## 3 1fund 2F 1fav 123
## 4 1fund 2F 2opp 73
## 5 2mod 1M 1fav 182
## 6 2mod 1M 2opp 56
## 7 2mod 2F 1fav 168
## 8 2mod 2F 2opp 105
## 9 3lib 1M 1fav 119
## 10 3lib 1M 2opp 49
## 11 3lib 2F 1fav 111
## 12 3lib 2F 2opp 70Dengan data.frame, kita dapat melakukan pengecekan apakah data yang sudah diinput dalam R merupakan data yang sama dengan data asli.
Menentukan Kategori Referensi-nya
x.sex <- relevel(x.sex, ref="2F")
y.fav <- relevel(y.fav, ref = "2opp")
z.fund <- relevel(z.fund, ref = "3lib")1. Saturated Model (Asosiasi Tiga Arah)
Pembentukan Saturated Model
model_sat <- glm(counts ~ x.sex+y.fav+z.fund+x.sex*y.fav+x.sex*z.fund+y.fav*z.fund+x.sex*y.fav*z.fund,family=poisson("link"=log))
summary(model_sat)##
## Call:
## glm(formula = counts ~ x.sex + y.fav + z.fund + x.sex * y.fav +
## x.sex * z.fund + y.fav * z.fund + x.sex * y.fav * z.fund,
## family = poisson(link = log))
##
## Deviance Residuals:
## [1] 0 0 0 0 0 0 0 0 0 0 0 0
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 4.248495 0.119523 35.545 < 2e-16 ***
## x.sex1M -0.356675 0.186263 -1.915 0.05551 .
## y.fav1fav 0.461035 0.152626 3.021 0.00252 **
## z.fund1fund 0.041964 0.167285 0.251 0.80193
## z.fund2mod 0.405465 0.154303 2.628 0.00860 **
## x.sex1M:y.fav1fav 0.426268 0.228268 1.867 0.06185 .
## x.sex1M:z.fund1fund -0.468049 0.282210 -1.659 0.09721 .
## x.sex1M:z.fund2mod -0.271934 0.249148 -1.091 0.27507
## y.fav1fav:z.fund1fund 0.060690 0.212423 0.286 0.77511
## y.fav1fav:z.fund2mod 0.008969 0.196903 0.046 0.96367
## x.sex1M:y.fav1fav:z.fund1fund 0.438301 0.336151 1.304 0.19227
## x.sex1M:y.fav1fav:z.fund2mod 0.282383 0.301553 0.936 0.34905
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 2.4536e+02 on 11 degrees of freedom
## Residual deviance: 1.4655e-14 on 0 degrees of freedom
## AIC: 100.14
##
## Number of Fisher Scoring iterations: 3Diperoleh Residual Deviance = 0 untuk Saturated Model.
2. Homogenous Model
model_hom <- glm(counts~x.sex+y.fav+z.fund+x.sex*y.fav+x.sex*z.fund+y.fav*z.fund, family = poisson("link"=log))
summary(model_hom)##
## Call:
## glm(formula = counts ~ x.sex + y.fav + z.fund + x.sex * y.fav +
## x.sex * z.fund + y.fav * z.fund, family = poisson(link = log))
##
## Deviance Residuals:
## 1 2 3 4 5 6 7 8
## 0.2996 -0.5744 -0.3002 0.3994 0.0856 -0.1530 -0.0887 0.1129
## 9 10 11 12
## -0.4085 0.6655 0.4342 -0.5281
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 4.31096 0.10522 40.972 < 2e-16 ***
## x.sex1M -0.51575 0.13814 -3.733 0.000189 ***
## y.fav1fav 0.35707 0.12658 2.821 0.004788 **
## z.fund1fund -0.06762 0.14452 -0.468 0.639854
## z.fund2mod 0.33196 0.13142 2.526 0.011540 *
## x.sex1M:y.fav1fav 0.66406 0.12728 5.217 1.81e-07 ***
## x.sex1M:z.fund1fund -0.16201 0.15300 -1.059 0.289649
## x.sex1M:z.fund2mod -0.08146 0.14079 -0.579 0.562887
## y.fav1fav:z.fund1fund 0.23873 0.16402 1.455 0.145551
## y.fav1fav:z.fund2mod 0.13081 0.14951 0.875 0.381614
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 245.361 on 11 degrees of freedom
## Residual deviance: 1.798 on 2 degrees of freedom
## AIC: 97.934
##
## Number of Fisher Scoring iterations: 3Uji Model Interaksi Tiga Arah (Saturated VS Homogenous)
deltadev_modelSH <- model_hom$deviance - model_sat$deviance
deltadev_modelSH## [1] 1.797977deltadb_modelSH <- (4-0)
deltadb_modelSH## [1] 4chi_tabelSH <- qchisq((1-0.05), df=deltadev_modelSH)
chi_tabelSH## [1] 5.593874Keputusan_SH <- ifelse(deltadev_modelSH <= chi_tabelSH, "Tidak Tolak H0", "Tolak H0")
Keputusan_SH## [1] "Tidak Tolak H0"Dengan taraf nyata 5% dinyatakan bahwa belum cukup bukti untuk menolak H0 artinya bahwa tidak ada interaksi tiga arah antara jenis kelamin, fundamentalisme dan pendapat mengenai hukuman mati.
Uji Model Interaksi Dua Arah (Homogenous VS Conditional on X)
model_HCX <- glm(counts~x.sex+y.fav+z.fund+x.sex*y.fav+x.sex*z.fund,family = poisson("link"=log))
summary(model_HCX)##
## Call:
## glm(formula = counts ~ x.sex + y.fav + z.fund + x.sex * y.fav +
## x.sex * z.fund, family = poisson(link = log))
##
## Deviance Residuals:
## 1 2 3 4 5 6 7 8
## 0.60542 -1.11492 0.16142 -0.20684 0.11953 -0.21283 -0.06470 0.08220
## 9 10 11 12
## -0.74698 1.26595 -0.08912 0.11304
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 4.23495 0.08955 47.293 < 2e-16 ***
## x.sex1M -0.52960 0.13966 -3.792 0.000149 ***
## y.fav1fav 0.48302 0.08075 5.982 2.20e-09 ***
## z.fund1fund 0.07962 0.10309 0.772 0.439916
## z.fund2mod 0.41097 0.09585 4.288 1.81e-05 ***
## x.sex1M:y.fav1fav 0.65845 0.12708 5.181 2.20e-07 ***
## x.sex1M:z.fund1fund -0.12841 0.15109 -0.850 0.395405
## x.sex1M:z.fund2mod -0.06267 0.13908 -0.451 0.652274
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 245.3612 on 11 degrees of freedom
## Residual deviance: 3.9303 on 4 degrees of freedom
## AIC: 96.067
##
## Number of Fisher Scoring iterations: 4deltadev_modelCXH_ <- 3.903 - 1.798
deltadev_modelCXH_## [1] 2.105deltadb_modelCXH <- (4-2)
deltadb_modelCXH## [1] 2chi_tabelCXH <- qchisq((1-0.05), df=deltadb_modelCXH)
chi_tabelCXH## [1] 5.991465Keputusan_CXH <- ifelse(deltadev_modelCXH_ <= chi_tabelCXH, "Tidak Tolak H0", "Tolak H0")
Keputusan_CXH## [1] "Tidak Tolak H0"Dengan taraf nyata 5% belum cukup bukti untuk Tolak H0 atau dapat dikatakan bahwa tidak ada interaksi antara pendapat tentang hukuman mati dan fundamentalisme.
Uji Model Interaksi Dua Arah (HOmogenous VS Conditional on Y)
model_HCY <- glm(counts~x.sex+y.fav+z.fund+x.sex*y.fav+y.fav*z.fund, family = poisson("link"=log))
summary(model_HCY)##
## Call:
## glm(formula = counts ~ x.sex + y.fav + z.fund + x.sex * y.fav +
## y.fav * z.fund, family = poisson(link = log))
##
## Deviance Residuals:
## 1 2 3 4 5 6 7 8
## -0.13887 -0.89983 0.14286 0.64384 0.09764 -0.17120 -0.10112 0.12650
## 9 10 11 12
## 0.02418 0.99745 -0.02499 -0.77148
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 4.33931 0.09919 43.748 < 2e-16 ***
## x.sex1M -0.59345 0.10645 -5.575 2.48e-08 ***
## y.fav1fav 0.37259 0.12438 2.996 0.00274 **
## z.fund1fund -0.12516 0.13389 -0.935 0.34989
## z.fund2mod 0.30228 0.12089 2.500 0.01240 *
## x.sex1M:y.fav1fav 0.65845 0.12708 5.181 2.20e-07 ***
## y.fav1fav:z.fund1fund 0.21254 0.16205 1.312 0.18966
## y.fav1fav:z.fund2mod 0.11757 0.14771 0.796 0.42606
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 245.3612 on 11 degrees of freedom
## Residual deviance: 2.9203 on 4 degrees of freedom
## AIC: 95.057
##
## Number of Fisher Scoring iterations: 4deltadev_modelCYH <- 2.9203 - 1.798
deltadev_modelCYH## [1] 1.1223deltadb_modelCYH <- (4-2)
deltadb_modelCYH## [1] 2chi_tabel3 <- qchisq((1-0.05), df=deltadb_modelCYH)
chi_tabel3## [1] 5.991465Keputusan_CYH <- ifelse(deltadev_modelCYH <= chi_tabel3, "Tidak Tolak H0", "Tolak H0")
Keputusan_CYH## [1] "Tidak Tolak H0"Dengan taraf nyata 5% belum cukup bukti untuk Tolak H0, atau dapat dikatakan bahwa tidak ada interaksi antara jenis kelamin dan fundamentalisme.
Uji Model Interaksi Dua Arah (Homogenous VS Conditional on Z)
model_HCZ <- glm(counts~x.sex+y.fav+z.fund+x.sex*z.fund+y.fav*z.fund, family = poisson("link"=log))
summary(model_HCZ)##
## Call:
## glm(formula = counts ~ x.sex + y.fav + z.fund + x.sex * z.fund +
## y.fav * z.fund, family = poisson(link = log))
##
## Deviance Residuals:
## 1 2 3 4 5 6 7 8
## 1.3998 -2.3495 -1.3171 1.9188 1.4595 -2.2965 -1.4130 1.9781
## 9 10 11 12
## 0.7777 -1.1226 -0.7675 1.0321
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 4.12255 0.10518 39.195 < 2e-16 ***
## x.sex1M -0.07453 0.10713 -0.696 0.487
## y.fav1fav 0.65896 0.11292 5.836 5.36e-09 ***
## z.fund1fund -0.06540 0.15126 -0.432 0.665
## z.fund2mod 0.33196 0.13777 2.410 0.016 *
## x.sex1M:z.fund1fund -0.12841 0.15109 -0.850 0.395
## x.sex1M:z.fund2mod -0.06267 0.13908 -0.451 0.652
## y.fav1fav:z.fund1fund 0.21254 0.16205 1.312 0.190
## y.fav1fav:z.fund2mod 0.11757 0.14771 0.796 0.426
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 245.361 on 11 degrees of freedom
## Residual deviance: 29.729 on 3 degrees of freedom
## AIC: 123.87
##
## Number of Fisher Scoring iterations: 4deltadev_modelCZH <- 29.729 - 1.798
deltadev_modelCZH## [1] 27.931deltadb_modelCZH <- 3 - 2
deltadb_modelCZH## [1] 1chi_tabel4 <- qchisq((1-0.05), df=deltadb_modelCZH)
chi_tabel4## [1] 3.841459Keputusan_CZH <- ifelse(deltadev_modelCZH <= chi_tabel4, "Tidak Tolak H0", "Tolak H0")
Keputusan_CZH## [1] "Tolak H0"Model Terbaik
model_terbaik <- glm(counts~x.sex+y.fav+z.fund+x.sex*y.fav, family = poisson("link"=log))
summary(model_terbaik)##
## Call:
## glm(formula = counts ~ x.sex + y.fav + z.fund + x.sex * y.fav,
## family = poisson(link = log))
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.32758 -0.24954 -0.01277 0.14946 1.48613
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 4.26518 0.07794 54.721 < 2e-16 ***
## x.sex1M -0.59345 0.10645 -5.575 2.48e-08 ***
## y.fav1fav 0.48302 0.08075 5.982 2.20e-09 ***
## z.fund1fund 0.01986 0.07533 0.264 0.792
## z.fund2mod 0.38130 0.06944 5.491 4.00e-08 ***
## x.sex1M:y.fav1fav 0.65845 0.12708 5.181 2.20e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 245.3612 on 11 degrees of freedom
## Residual deviance: 4.6532 on 6 degrees of freedom
## AIC: 92.79
##
## Number of Fisher Scoring iterations: 4data.frame(koef=model_terbaik$coefficients,exp_koef=exp(model_terbaik$coefficients))## koef exp_koef
## (Intercept) 4.26517861 71.1776316
## x.sex1M -0.59344782 0.5524194
## y.fav1fav 0.48302334 1.6209677
## z.fund1fund 0.01985881 1.0200573
## z.fund2mod 0.38129767 1.4641834
## x.sex1M:y.fav1fav 0.65845265 1.9318008Nilai Dugaan Model Terbaik
data.frame(Fund=z.fund, Sex=x.sex, Favor=y.fav, counts=counts, fitted=model_terbaik$fitted.values)## Fund Sex Favor counts fitted
## 1 1fund 1M 1fav 128 125.59539
## 2 1fund 1M 2opp 32 40.10855
## 3 1fund 2F 1fav 123 117.69079
## 4 1fund 2F 2opp 73 72.60526
## 5 2mod 1M 1fav 182 180.27878
## 6 2mod 1M 2opp 56 57.57155
## 7 2mod 2F 1fav 168 168.93257
## 8 2mod 2F 2opp 105 104.21711
## 9 3lib 1M 1fav 119 123.12582
## 10 3lib 1M 2opp 49 39.31990
## 11 3lib 2F 1fav 111 115.37664
## 12 3lib 2F 2opp 70 71.17763