Tugas Praktikum 10
Abdullah Pannu
5/11/2021
Melakukan Set Direktori
setwd("D:/KULIAH/STT 2019/SEM3/SEMESTER 3/ADK/UAS/prak 10")MODEL LOG-LINEAR UNTUK DATA RESPON POISSON
Penyelesaian untuk soal dari Buku Agresti Problem 8.1
Soal
Memasukkan Data Tabel Kontingensi ke Program R
x.info<-factor(rep(c("1sup","2opp"),each=2,times=2))
y.health<-factor(rep(c("1sup","2opp"),times=4))
z.gender<-factor(rep(c("1M","2F"),each=4))
counts<-c(76,160,6,25,114,181,11,48)
data.frame(x.info,y.health,z.gender,counts)## x.info y.health z.gender counts
## 1 1sup 1sup 1M 76
## 2 1sup 2opp 1M 160
## 3 2opp 1sup 1M 6
## 4 2opp 2opp 1M 25
## 5 1sup 1sup 2F 114
## 6 1sup 2opp 2F 181
## 7 2opp 1sup 2F 11
## 8 2opp 2opp 2F 48data.framedalam hal ini digunakan untuk mengecek apakah data yang diinput dalam R dan pada data asli sama. Dalam hal ini adalah sama, dimana jumlah data adalah 8
Menentukan Kategori Referensi
x.info<-relevel(x.info,ref="2opp")
y.health<-relevel(y.health,ref="2opp")
z.gender<-relevel(z.gender,ref="2F")a. Fit log linier model (GH,GI), (GH,HI), (GI,HI), dan (GH,GI, HI). Tunjukkan bahwa model yang tidak mengandung komponen HI fit poorly
Penyelesaian
Model (GH,GI)–> conditional on G(z)
model1<- glm(counts~x.info+y.health+z.gender+x.info*z.gender+ y.health*z.gender,
family=poisson("link"=log))
summary(model1)##
## Call:
## glm(formula = counts ~ x.info + y.health + z.gender + x.info *
## z.gender + y.health * z.gender, family = poisson(link = log))
##
## Deviance Residuals:
## 1 2 3 4 5 6 7 8
## 0.4103 -0.2763 -1.2251 0.7402 0.9489 -0.7181 -2.3699 1.5298
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 3.6420 0.1360 26.783 < 2e-16 ***
## x.info1sup 1.6094 0.1426 11.285 < 2e-16 ***
## y.health1sup -0.6054 0.1112 -5.444 5.21e-08 ***
## z.gender1M -0.5749 0.2289 -2.511 0.0120 *
## x.info1sup:z.gender1M 0.4204 0.2384 1.763 0.0778 .
## y.health1sup:z.gender1M -0.2082 0.1731 -1.203 0.2290
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 445.823 on 7 degrees of freedom
## Residual deviance: 11.666 on 2 degrees of freedom
## AIC: 69.048
##
## Number of Fisher Scoring iterations: 4data.frame(info=x.info,health=y.health,gender=z.gender,counts=counts, fitted=model1$fitted.values)## info health gender counts fitted
## 1 1sup 1sup 1M 76 72.479401
## 2 1sup 2opp 1M 160 163.520599
## 3 2opp 1sup 1M 6 9.520599
## 4 2opp 2opp 1M 25 21.479401
## 5 1sup 1sup 2F 114 104.166667
## 6 1sup 2opp 2F 181 190.833333
## 7 2opp 1sup 2F 11 20.833333
## 8 2opp 2opp 2F 48 38.166667Model (GH,HI)–> conditional on H(y)
model2<- glm(counts~x.info+y.health+z.gender+x.info*y.health+y.health*z.gender,
family=poisson("link"=log))
summary(model2)##
## Call:
## glm(formula = counts ~ x.info + y.health + z.gender + x.info *
## y.health + y.health * z.gender, family = poisson(link = log))
##
## Deviance Residuals:
## 1 2 3 4 5 6 7 8
## 0.08450 0.61232 -0.28835 -1.39207 -0.06863 -0.55869 0.22653 1.16424
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 3.69832 0.12510 29.563 < 2e-16 ***
## x.info1sup 1.54142 0.12896 11.953 < 2e-16 ***
## y.health1sup -1.36951 0.27864 -4.915 8.88e-07 ***
## z.gender1M -0.21337 0.09885 -2.158 0.03090 *
## x.info1sup:y.health1sup 0.87239 0.28411 3.071 0.00214 **
## y.health1sup:z.gender1M -0.20823 0.17311 -1.203 0.22903
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 445.8233 on 7 degrees of freedom
## Residual deviance: 4.1267 on 2 degrees of freedom
## AIC: 61.509
##
## Number of Fisher Scoring iterations: 4data.frame(info=x.info,health=y.health,gender=z.gender,counts=counts, fitted=model2$fitted.values)## info health gender counts fitted
## 1 1sup 1sup 1M 76 75.26570
## 2 1sup 2opp 1M 160 152.37923
## 3 2opp 1sup 1M 6 6.73430
## 4 2opp 2opp 1M 25 32.62077
## 5 1sup 1sup 2F 114 114.73430
## 6 1sup 2opp 2F 181 188.62077
## 7 2opp 1sup 2F 11 10.26570
## 8 2opp 2opp 2F 48 40.37923Model (GI,HI)–> conditional on I(x)
model3<- glm(counts~x.info+y.health+z.gender+x.info*y.health+x.info*z.gender,
family=poisson("link"=log))
summary(model3)##
## Call:
## glm(formula = counts ~ x.info + y.health + z.gender + x.info *
## y.health + x.info * z.gender, family = poisson(link = log))
##
## Deviance Residuals:
## 1 2 3 4 5 6 7 8
## -0.93493 0.67971 0.05945 -0.02883 0.81131 -0.61817 -0.04336 0.02087
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 3.8682 0.1398 27.675 < 2e-16 ***
## x.info1sup 1.3759 0.1548 8.886 < 2e-16 ***
## y.health1sup -1.4572 0.2693 -5.411 6.26e-08 ***
## z.gender1M -0.6436 0.2218 -2.901 0.00372 **
## x.info1sup:y.health1sup 0.8724 0.2841 3.071 0.00214 **
## x.info1sup:z.gender1M 0.4204 0.2384 1.763 0.07782 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 445.8233 on 7 degrees of freedom
## Residual deviance: 2.3831 on 2 degrees of freedom
## AIC: 59.765
##
## Number of Fisher Scoring iterations: 3data.frame(info=x.info,health=y.health,gender=z.gender,counts=counts, fitted=model3$fitted.values)## info health gender counts fitted
## 1 1sup 1sup 1M 76 84.444444
## 2 1sup 2opp 1M 160 151.555556
## 3 2opp 1sup 1M 6 5.855556
## 4 2opp 2opp 1M 25 25.144444
## 5 1sup 1sup 2F 114 105.555556
## 6 1sup 2opp 2F 181 189.444444
## 7 2opp 1sup 2F 11 11.144444
## 8 2opp 2opp 2F 48 47.855556Model (GH,GI,HI)
model4<- glm(counts~x.info+y.health+z.gender+x.info*y.health+x.info*z.gender+ y.health*z.gender,
family=poisson("link"=log))
summary(model4)##
## Call:
## glm(formula = counts ~ x.info + y.health + z.gender + x.info *
## y.health + x.info * z.gender + y.health * z.gender, family = poisson(link = log))
##
## Deviance Residuals:
## 1 2 3 4 5 6 7 8
## -0.10362 0.07183 0.39073 -0.17923 0.08516 -0.06730 -0.26626 0.13173
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 3.8521 0.1415 27.219 < 2e-16 ***
## x.info1sup 1.3514 0.1575 8.578 < 2e-16 ***
## y.health1sup -1.3750 0.2750 -5.001 5.71e-07 ***
## z.gender1M -0.5976 0.2242 -2.666 0.00768 **
## x.info1sup:y.health1sup 0.8997 0.2852 3.155 0.00160 **
## x.info1sup:z.gender1M 0.4636 0.2406 1.927 0.05401 .
## y.health1sup:z.gender1M -0.2516 0.1749 -1.438 0.15035
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 445.82335 on 7 degrees of freedom
## Residual deviance: 0.30072 on 1 degrees of freedom
## AIC: 59.683
##
## Number of Fisher Scoring iterations: 4data.frame(info=x.info,heal=y.health,gender=z.gender,counts=counts, fitted=model4$fitted.values)## info heal gender counts fitted
## 1 1sup 1sup 1M 76 76.90689
## 2 1sup 2opp 1M 160 159.09311
## 3 2opp 1sup 1M 6 5.09311
## 4 2opp 2opp 1M 25 25.90689
## 5 1sup 1sup 2F 114 113.09311
## 6 1sup 2opp 2F 181 181.90689
## 7 2opp 1sup 2F 11 11.90689
## 8 2opp 2opp 2F 48 47.09311Untuk melihat model yang fit poorly, dapat dilihat dari nilai AIC nya. Model yang baik adalah model yang memiliki AIC terkecil. Berdasarkan output model diatas, AIC terbesar dihasilkan oleh model (GH,GI), 69.048. jika dibandingkan dengan 3 model lainnya maka model (GH,GI) tidak mengandung komponen HI. Sehingga cukup bukti bahwa dari ke empat model tersebut, model yang tidak mengandung HI fit poorly paling tidak sesuai
b. Untuk model (GH,GI,HI) tunjukkan bahwa 95% wald confidence interval sama dengan (0.55,1.1) untuk GH conditional odd ratio dan (0.99, 2.55) untuk GI conditional oddd ratio. Interpretasikan. Apakah masuk akal bahwa jenis kelamin tidak berpengaruh terhadap isu tersebut.
SK 95 % untuk rasio odd GH adalah
zse_gh<-1.96*summary(model4)$coefficient[7,2]Wald CI 95 persen untuk odd ratio GH conditional
exp(model4$coefficients[7]+c(-1,1)*zse_gh)## [1] 0.5518465 1.0955582Interpretasi: Dengan tingkat kepercayaan 95 persen, kita yakin bahwa jika laki-laki, odd mendukung healt care cost berada antara 0,55 sampai 1,095 kali dibandingkan jika ia perempuan.
SK 95 % untuk rasio odd GI adalah
zse_gi<-1.96*summary(model4)$coefficient[6,2]Wald CI 95 persen untuk odd ratio GI conditional
exp(model4$coefficients[6]+c(-1,1)*zse_gi)## [1] 0.9920389 2.5477685Interpretasi: Dengan tingkat kepercayaan 95 persen, odds mendukung information program jika ia laki-laki berada antara 0,99 sampai 2,55 kali dibandingkan odd yang sama jika ia perempuan. Dari hasil diatas terlihat bahwa kedua selang kepercayaan wald mencakup nilai 1. Hal ini berarti jenis kelamin tidak memberikan pengaruh terhadap opini penanganan aids melalui information program maupun healt care cost