Solution: Problem 1. (a) Look at the partial odds ratio. Only the one for the department A are significantly less than one. Thus, we conclude that the probablity for admission between male and female in the department B to F are not significant different. Department A likes to admit more female students than male students. Look at the marginal odds ratio. It tells us that the six departments significantly admitted more male students than famle students. ###### R Output: Confidence Interval for Partial odds ratio. lower upper A 0.2086736 0.5844009 B 0.3403761 1.8920464 C 0.8545284 1.5023774 D 0.6863308 1.2366687 E 0.8250689 1.8087978 F 0.4552009 1.5056500 Confidence interval for the marginal odds ratio. lower upper Marginal 1.624373 2.086698 ######### (b) Fit the saturated model and run the ANOVA table. I found that the interaction effect between Gender and Admitted are not significant. All the others are signifincant. The Deparment:Gender term tells us the number of applicants between gender are related to the department. It tells us that more male applied department A, B, and more female applied deparemtn C, D, E, F. The Department:Admitted tells us the admitted probability are different among those departments. It tells us that the admitted rates for department A and B are higher than the other departments. The three-factor interaction term tells the difference of the admitted rate for male and female among the departments. It tells us that the admitted rate of department A for female students is relatively higher then those of the other departments. (c) After exclude department A from the analysis. The fit for the model with all the main effects and Deparment:Gender and Department:Admitted is good. The deviance is 2.681 based on 5 degrees of freedom. The three-factor interaction effect is not significant any more. (d) The inconsistence happens becuase more female students applied the departments with less admitted rate. 2. (a). Fit the saturated model and do the ANOVA. I find all the main effects are not significant. GPA:Gender, GPA:Race, Gender:Esteem, GPA:Gender:Race, GPA:Race:Esteem are significant. (b). I fit a log-linear model with the two significant three-factor interaction effects, the signifcant two-factor interaction effects, and low order effects related to the significant interaction effect. I find that the white with GPA low is more likely to be low self-esteem then balck with GPA low. the white with GPA high is more likely to be high self-esteem then balck with GPA high. Then, I fit a log-linear model with all the three two-factor interaction effects. It tells us that the male is more likely to be high self-esteem. Note: Stdeunts may provide other good models. The key terms are the interaction effects involving self_esteem. (c). I find the logit model with all the main effects and the interaction between gpa and race. We can find the logit model tells us that the same thing as the log-linear model. The fit for such logit model is good. 3. (a). I compare the saturated model and model with all two-factor interaction effects, the model with all two-facotr interaction effects and three models with only two two-factor interaction effect. Here is the summary of the result Full Model Reduced Model Deviance Diff Df p-value Result (BSD) (BS,SD,BD) 0 1 1 B:S:D (BS,SD,BD) (BD,SD) 185.86 2 4.370e-41 B:S (BS,SD,BD) (BS,DS) 0 1 1 B:D (BS,SD,BD) (BS,BD) 25.869 2 2.413e-06 S:D Therefore, the log-linear model should include all the main terms and B:S, D:S intetaction terms. The p-value for the goodness of fit is 1. This model tells us given S, B and D are independent. (b) The marginal B-D table is D B Yes No Yes 36 364 No 60 340 The odds ratio is 0.642353 and its 95% confidence interval [0.4142,0.9962] It tells us that B and D are not marginal independent. ################### R code and Output ################### 1. (a) > graduate <- read.table("c:\\data\\graduate.data",h=T) > graduate Department Gender Admitted Freq 1 A Male Yes 512 2 A Male No 313 3 A Female Yes 89 4 A Female No 19 5 B Male Yes 353 6 B Male No 207 7 B Female Yes 17 8 B Female No 8 9 C Male Yes 120 10 C Male No 205 11 C Female Yes 202 12 C Female No 391 13 D Male Yes 138 14 D Male No 279 15 D Female Yes 131 16 D Female No 244 17 E Male Yes 53 18 E Male No 138 19 E Female Yes 94 20 E Female No 299 21 F Male Yes 22 22 F Male No 351 23 F Female Yes 24 24 F Female No 317 > > graduate.table <- matrix(graduate$Freq,ncol=6) > graduate.table [,1] [,2] [,3] [,4] [,5] [,6] [1,] 512 353 120 138 53 22 [2,] 313 207 205 279 138 351 [3,] 89 17 202 131 94 24 [4,] 19 8 391 244 299 317 > odds.department <- (graduate.table[1,]*graduate.table[4,])/(graduate.table[2,]*graduate.table[3,]) > odds.std <- sqrt(1/graduate.table[1,]+1/graduate.table[2,]+1/graduate.table[3,]+1/graduate.table[4,]) > > lower <- odds.department*exp(-1.96*odds.std) > upper <- odds.department*exp(1.96*odds.std) > interval.department <- cbind(lower,upper) > > interval.department lower upper [1,] 0.2086736 0.5844009 [2,] 0.3403761 1.8920464 [3,] 0.8545284 1.5023774 [4,] 0.6863308 1.2366687 [5,] 0.8250689 1.8087978 [6,] 0.4552009 1.5056500 > > > marginal <- apply(graduate.table,1,sum) > odd.marginal <- marginal[1]*marginal[4]/(marginal[2]*marginal[3]) > std <- sqrt(1/marginal[1]+1/marginal[2]+1/marginal[3]+1/marginal[4]) > interval.marginal <- c(odd.marginal*exp(-1.96*std),odd.marginal*exp(1.96*std)) > interval.marginal [1] 1.624373 2.086698 (b) > graduate$Department <- relevel(graduate$Department,ref="F") > g.saturated <- glm(Freq~Department*Gender*Admitted,data=graduate,fam=poisson) > anova(g.saturated,test="Chi") Analysis of Deviance Table Model: poisson, link: log Response: Freq Terms added sequentially (first to last) Df Deviance Resid. Df Resid. Dev P(>|Chi|) NULL 23 2650.10 Department 5 159.52 18 2490.57 1.251e-32 Gender 1 162.87 17 2327.70 2.665e-37 Admitted 1 230.03 16 2097.67 5.879e-52 Department:Gender 5 1220.61 11 877.06 1.006e-261 Department:Admitted 5 855.32 6 21.74 1.242e-182 Gender:Admitted 1 1.53 5 20.20 0.22 Department:Gender:Admitted 5 20.20 0 2.022e-13 1.144e-03 > summary(g.saturated) Call: glm(formula = Freq ~ Department * Gender * Admitted, family = poisson, data = graduate) Deviance Residuals: [1] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 Coefficients: Estimate Std. Error z value Pr(>|z|) (Intercept) 5.75890 0.05617 102.534 < 2e-16 *** DepartmentA -2.81446 0.23619 -11.916 < 2e-16 *** DepartmentB -3.67946 0.35797 -10.279 < 2e-16 *** DepartmentC 0.20981 0.07558 2.776 0.00550 ** DepartmentD -0.26173 0.08516 -3.073 0.00212 ** DepartmentE -0.05846 0.08062 -0.725 0.46837 GenderMale 0.10188 0.07748 1.315 0.18853 AdmittedYes -2.58085 0.21171 -12.191 < 2e-16 *** DepartmentA:GenderMale 2.69988 0.24866 10.858 < 2e-16 *** DepartmentB:GenderMale 3.15139 0.36854 8.551 < 2e-16 *** DepartmentC:GenderMale -0.74758 0.11593 -6.449 1.13e-10 *** DepartmentD:GenderMale 0.03216 0.11699 0.275 0.78340 DepartmentE:GenderMale -0.87507 0.12882 -6.793 1.10e-11 *** DepartmentA:AdmittedYes 4.12505 0.32968 12.512 < 2e-16 *** DepartmentB:AdmittedYes 3.33462 0.47816 6.974 3.08e-12 *** DepartmentC:AdmittedYes 1.92041 0.22876 8.395 < 2e-16 *** DepartmentD:AdmittedYes 1.95888 0.23781 8.237 < 2e-16 *** DepartmentE:AdmittedYes 1.42370 0.24249 5.871 4.33e-09 *** GenderMale:AdmittedYes -0.18890 0.30516 -0.619 0.53592 DepartmentA:GenderMale:AdmittedYes -0.86318 0.40266 -2.144 0.03206 * DepartmentB:GenderMale:AdmittedYes -0.03113 0.53348 -0.058 0.95347 DepartmentC:GenderMale:AdmittedYes 0.31382 0.33741 0.930 0.35233 DepartmentD:GenderMale:AdmittedYes 0.10691 0.34013 0.314 0.75328 DepartmentE:GenderMale:AdmittedYes 0.38908 0.36499 1.066 0.28643 --- Signif. codes: 0 `***' 0.001 `**' 0.01 `*' 0.05 `.' 0.1 ` ' 1 (Dispersion parameter for poisson family taken to be 1) Null deviance: 2.6501e+03 on 23 degrees of freedom Residual deviance: 2.0221e-13 on 0 degrees of freedom AIC: 207.06 Number of Fisher Scoring iterations: 2 ######### We can not explain the two-factor interaction effect based on the model becase (1). THe constraint is not zero-sum. (2). THe three-factor interaction effect is in tor model. Then, I want to try two method to explain the two-factor interaction effect ######### (i) #### > g <- glm(Freq~Department*(Gender+Admitted),data=graduate,fam=poisson) > summary(g) Call: glm(formula = Freq ~ Department * (Gender + Admitted), family = poisson, data = graduate) Deviance Residuals: Min 1Q Median 3Q Max -3.477632 -0.414437 0.009785 0.308923 2.232081 Coefficients: Estimate Std. Error z value Pr(>|z|) (Intercept) 5.76529 0.05504 104.754 < 2e-16 *** DepartmentA -2.11642 0.11915 -17.763 < 2e-16 *** DepartmentB -3.54739 0.21441 -16.545 < 2e-16 *** DepartmentC 0.18795 0.07283 2.581 0.00986 ** DepartmentD -0.25334 0.07966 -3.180 0.00147 ** DepartmentE -0.08145 0.07842 -1.039 0.29899 GenderMale 0.08970 0.07492 1.197 0.23124 AdmittedYes -2.67565 0.15243 -17.553 < 2e-16 *** DepartmentA:GenderMale 1.94355 0.12670 15.339 < 2e-16 *** DepartmentB:GenderMale 3.01937 0.21771 13.869 < 2e-16 *** DepartmentC:GenderMale -0.69107 0.10187 -6.784 1.17e-11 *** DepartmentD:GenderMale 0.01646 0.10334 0.159 0.87341 DepartmentE:GenderMale -0.81123 0.11573 -7.010 2.39e-12 *** DepartmentA:AdmittedYes 3.26911 0.16706 19.568 < 2e-16 *** DepartmentB:AdmittedYes 3.21851 0.17490 18.402 < 2e-16 *** DepartmentC:AdmittedYes 2.05996 0.16739 12.306 < 2e-16 *** DepartmentD:AdmittedYes 2.01078 0.16990 11.835 < 2e-16 *** DepartmentE:AdmittedYes 1.58615 0.17980 8.822 < 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: 2650.095 on 23 degrees of freedom Residual deviance: 21.736 on 6 degrees of freedom AIC: 216.80 Number of Fisher Scoring iterations: 3 ### (ii) ### > options(contrasts=c("contr.sum","contr.sum")) > g <- glm(Freq~Department*Gender*Admitted,data=graduate,fam=poisson) > summary(g) Call: glm(formula = Freq ~ Department * Gender * Admitted, family = poisson, data = graduate) Deviance Residuals: [1] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 Coefficients: Estimate Std. Error z value Pr(>|z|) (Intercept) 4.786576 0.027544 173.779 < 2e-16 *** Department1 -0.314380 0.068109 -4.616 3.92e-06 *** Department2 0.067825 0.060285 1.125 0.26056 Department3 -0.758615 0.093471 -8.116 4.82e-16 *** Department4 0.560293 0.040274 13.912 < 2e-16 *** Department5 0.446132 0.041216 10.824 < 2e-16 *** Gender1 -0.355262 0.027544 -12.898 < 2e-16 *** Admitted1 0.277615 0.027544 10.079 < 2e-16 *** Department1:Gender1 0.351544 0.068109 5.161 2.45e-07 *** Department2:Gender1 -0.782601 0.060285 -12.982 < 2e-16 *** Department3:Gender1 -1.216371 0.093471 -13.013 < 2e-16 *** Department4:Gender1 0.646881 0.040274 16.062 < 2e-16 *** Department5:Gender1 0.308737 0.041216 7.491 6.85e-14 *** Department1:Admitted1 1.060033 0.068109 15.564 < 2e-16 *** Department2:Admitted1 -0.786694 0.060285 -13.050 < 2e-16 *** Department3:Admitted1 -0.599495 0.093471 -6.414 1.42e-10 *** Department4:Admitted1 0.021375 0.040274 0.531 0.59560 Department5:Admitted1 0.053868 0.041216 1.307 0.19123 Gender1:Admitted1 -0.050745 0.027544 -1.842 0.06543 . Department1:Gender1:Admitted1 0.003521 0.068109 0.052 0.95877 Department2:Gender1:Admitted1 -0.212274 0.060285 -3.521 0.00043 *** Department3:Gender1:Admitted1 -0.004261 0.093471 -0.046 0.96364 Department4:Gender1:Admitted1 0.081975 0.040274 2.035 0.04181 * Department5:Gender1:Admitted1 0.030248 0.041216 0.734 0.46302 --- Signif. codes: 0 `***' 0.001 `**' 0.01 `*' 0.05 `.' 0.1 ` ' 1 (Dispersion parameter for poisson family taken to be 1) Null deviance: 2.6501e+03 on 23 degrees of freedom Residual deviance: -5.3994e-15 on 0 degrees of freedom AIC: 207.06 Number of Fisher Scoring iterations: 2 > model.matrix(g) ########################################## ########################################### The coding results tell us that Department code is 1(F), 2(A), 3(B), 4(C), 5(D); The estimate for department6:Admitted1 is the negative of > 1.060033-0.786694-0.599495+0.021375+0.053868 [1] -0.250913 The estimate for department6:Gender1 is the negative of > 0.351543862-0.782600986-1.216370860+0.646880514+0.308737151 [1] -0.6918103 ### The Gender code is Gender 1("Female"); The Admitted code is Admitted 1("NO") It tells us that (1) Department A admitted moe students than expected [1/exp(-0.786694) times than expected] Department B admitted moe students than expected [1/exp(-0.599495) times than expected] Department C rejected more students than expected [exp(0.021375) times than expected] Department D rejected more students than expected [exp(0.053868) times than expected] Department E rejected more students than expected [exp(0.25.913) times than expected] Department F rejected more students than expected [exp(1.060033) times than expected] 2) The proportation of female applicants for department A is lower than expected [exp(0.7867) times] for department B is lower than expected [exp(1.216371) times] for department C is higher than expected [exp(0.64688) times] for department D is higher than expected [exp(0.30873) times] for department E is higher than expected [exp(0.69181) times] for department F is higher than expected [exp(1.0600) times] ##################################################### ##################################################### #### (c) #### > graduate.remain <- graduate[-(1:4),] > graduate.remain <- graduate[-(1:4),] > g <- glm(Freq~Department*(Gender+Admitted),data=graduate.remain,fam=poisson) > g Call: glm(formula = Freq ~ Department * (Gender + Admitted), family = poisson, data = graduate.remain) Coefficients: (Intercept) DepartmentB DepartmentC 5.76529 -3.54739 0.18795 DepartmentD DepartmentE GenderMale -0.25334 -0.08145 0.08970 AdmittedYes DepartmentB:GenderMale DepartmentC:GenderMale -2.67565 3.01937 -0.69107 DepartmentD:GenderMale DepartmentE:GenderMale DepartmentB:AdmittedYes 0.01646 -0.81123 3.21851 DepartmentC:AdmittedYes DepartmentD:AdmittedYes DepartmentE:AdmittedYes 2.05996 2.01078 1.58615 Degrees of Freedom: 19 Total (i.e. Null); 5 Residual Null Deviance: 1880 Residual Deviance: 2.681 AIC: 165 ### 2. ### > g.saturated <- glm(Freq~GPA*Gender*Race*Esteem,fam=poisson,data=selfesteem) > anova(g.saturated,test="Chi") Analysis of Deviance Table Model: poisson, link: log Response: Freq Terms added sequentially (first to last) Df Deviance Resid. Df Resid. Dev P(>|Chi|) NULL 15 51.553 GPA 1 1.088 14 50.465 0.297 Gender 1 0.658 13 49.807 0.417 Race 1 0.000 12 49.807 1.000 Esteem 1 0.658 11 49.149 0.417 GPA:Gender 1 13.447 10 35.702 2.455e-04 GPA:Race 1 6.545 9 29.157 0.011 GPA:Esteem 1 0.004 8 29.153 0.947 Gender:Race 1 2.319 7 26.834 0.128 Gender:Esteem 1 8.725 6 18.109 0.003 Race:Esteem 1 3.808 5 14.301 0.051 GPA:Gender:Race 1 6.863 4 7.438 0.009 GPA:Gender:Esteem 1 0.421 3 7.017 0.517 GPA:Race:Esteem 1 4.671 2 2.347 0.031 Gender:Race:Esteem 1 0.852 1 1.495 0.356 GPA:Gender:Race:Esteem 1 1.495 0 6.413e-14 0.221 (b) > g <- glm(Freq~GPA*Gender*Race+GPA*Race*Esteem+Gender*Esteem,fam=poisson,data=selfesteem) > summary(g) Call: glm(formula = Freq ~ GPA * Gender * Race + GPA * Race * Esteem + Gender * Esteem, family = poisson, data = selfesteem) Deviance Residuals: 1 2 3 4 5 6 7 8 0.15920 -0.48512 -0.16611 0.54078 0.05076 0.38035 -0.04430 -0.85591 9 10 11 12 13 14 15 16 -0.19833 0.65314 0.13088 -0.51377 -0.06547 -0.33318 0.03693 0.43632 Coefficients: Estimate Std. Error z value Pr(>|z|) (Intercept) 2.61067 0.24307 10.740 < 2e-16 *** GPALow 0.45493 0.30047 1.514 0.13002 GenderMale 0.05599 0.29744 0.188 0.85069 RaceWhite 0.48980 0.30278 1.618 0.10573 EsteemLow 0.45234 0.28582 1.583 0.11351 GPALow:GenderMale 0.23016 0.34664 0.664 0.50670 GPALow:RaceWhite -2.00019 0.47389 -4.221 2.43e-05 *** GPALow:EsteemLow -0.27720 0.34378 -0.806 0.42007 GenderMale:RaceWhite -0.33559 0.36240 -0.926 0.35443 GenderMale:EsteemLow -0.85639 0.25234 -3.394 0.00069 *** RaceWhite:EsteemLow -0.09361 0.35063 -0.267 0.78948 GPALow:GenderMale:RaceWhite 1.50307 0.50769 2.961 0.00307 ** GPALow:RaceWhite:EsteemLow 1.08875 0.49471 2.201 0.02775 * --- Signif. codes: 0 `***' 0.001 `**' 0.01 `*' 0.05 `.' 0.1 ` ' 1 (Dispersion parameter for poisson family taken to be 1) Null deviance: 51.5526 on 15 degrees of freedom Residual deviance: 2.5165 on 3 degrees of freedom AIC: 103.06 Number of Fisher Scoring iterations: 3 > g <- glm(Freq~GPA*(Gender+Race)+Gender*Esteem,fam=poisson,data=selfesteem) > summary(g) Call: glm(formula = Freq ~ GPA * (Gender + Race) + Gender * Esteem, family = poisson, data = selfesteem) Deviance Residuals: Min 1Q Median 3Q Max -2.97974 -0.52975 -0.05204 0.21403 2.08845 Coefficients: Estimate Std. Error z value Pr(>|z|) (Intercept) 2.70181 0.17539 15.405 < 2e-16 *** GPALow 0.01738 0.20186 0.086 0.931405 GenderMale -0.20789 0.21452 -0.969 0.332504 RaceWhite 0.31691 0.17116 1.852 0.064085 . EsteemLow 0.41616 0.16360 2.544 0.010969 * GPALow:GenderMale 0.86298 0.23824 3.622 0.000292 *** GPALow:RaceWhite -0.59721 0.23476 -2.544 0.010960 * GenderMale:EsteemLow -0.67105 0.23536 -2.851 0.004356 ** --- Signif. codes: 0 `***' 0.001 `**' 0.01 `*' 0.05 `.' 0.1 ` ' 1 (Dispersion parameter for poisson family taken to be 1) Null deviance: 51.553 on 15 degrees of freedom Residual deviance: 20.917 on 8 degrees of freedom AIC: 111.46 Number of Fisher Scoring iterations: 4 (c) > g <- glm(Y~gpa*race+gender,fam=binomial) > summary(g) Call: glm(formula = Y ~ gpa * race + gender, family = binomial) Deviance Residuals: [1] 0.25432 -0.81360 -0.21148 0.74592 0.08284 0.50564 -0.05768 [8] -0.96070 Coefficients: Estimate Std. Error z value Pr(>|z|) (Intercept) -0.45234 0.28582 -1.583 0.11351 gpaLow 0.27720 0.34379 0.806 0.42007 raceWhite 0.09361 0.35063 0.267 0.78949 genderMale 0.85639 0.25236 3.394 0.00069 *** gpaLow:raceWhite -1.08875 0.49473 -2.201 0.02776 * --- Signif. codes: 0 `***' 0.001 `**' 0.01 `*' 0.05 `.' 0.1 ` ' 1 (Dispersion parameter for binomial family taken to be 1) Null deviance: 19.9671 on 7 degrees of freedom Residual deviance: 2.5165 on 3 degrees of freedom AIC: 43.821 Number of Fisher Scoring iterations: 3 3. (a) > boyscout <- read.table("h:\\data\\boyscout.data",h=T) > boyscout B S D Freq 1 Yes Low Yes 10 2 No Low Yes 40 3 Yes Medium Yes 18 4 No Medium Yes 18 5 Yes High Yes 8 6 No High Yes 2 7 Yes Low No 40 8 No Low No 160 9 Yes Medium No 132 10 No Medium No 132 11 Yes High No 192 12 No High No 48 (b) > g.saturated <- glm(Freq~B*S*D,fam=poisson,data=boyscout) > anova(g.saturated,test="Chi") Analysis of Deviance Table Model: poisson, link: log Response: Freq Terms added sequentially (first to last) Df Deviance Resid. Df Resid. Dev P(>|Chi|) NULL 11 753.58 B 1 0.00 10 753.58 1.00 S 2 6.13 8 747.45 0.05 D 1 521.96 7 225.50 1.589e-115 B:S 2 192.74 5 32.75 1.400e-42 B:D 1 6.88 4 25.87 0.01 S:D 2 25.87 2 4.175e-14 2.413e-06 B:S:D 2 0.00 0 9.431e-13 1.00 #### From this result, we can believe B:S:D is not signifincant. I am going to check three two factor interaction effect. #### > g.large <- glm(Freq~(B+S+D)^2,fam=poisson,data=boyscout) > g.small <- glm(Freq~(B+S)*D,fam=poisson,data=boyscout) > anova(g.small,g.large,test="Chi") Analysis of Deviance Table Model 1: Freq ~ (B + S) * D Model 2: Freq ~ (B + S + D)^2 Resid. Df Resid. Dev Df Deviance P(>|Chi|) 1 4 185.86 2 2 4.175e-14 2 185.86 4.370e-41 ###### It says that B:S is significant ###### > g.large <- glm(Freq~(B+S+D)^2,fam=poisson,data=boyscout) > g.small <- glm(Freq~(B+D)*S,fam=poisson,data=boyscout) > anova(g.small,g.large,test="Chi") Analysis of Deviance Table Model 1: Freq ~ (B + D) * S Model 2: Freq ~ (B + S + D)^2 Resid. Df Resid. Dev Df Deviance P(>|Chi|) 1 3 3.230e-14 2 2 4.175e-14 1 -9.449e-15 1 ####### It says E:D is not significant ####### > g.large <- glm(Freq~(B+S+D)^2,fam=poisson,data=boyscout) > g.small <- glm(Freq~(S+D)*B,fam=poisson,data=boyscout) > anova(g.small,g.large,test="Chi") Analysis of Deviance Table Model 1: Freq ~ (S + D) * B Model 2: Freq ~ (B + S + D)^2 Resid. Df Resid. Dev Df Deviance P(>|Chi|) 1 4 25.869 2 2 4.175e-14 2 25.869 2.413e-06 ###### It says S:D is significant ###### ####### The fitted model is ####### > summary(g) Call: glm(formula = Freq ~ (B + D) * S, family = poisson, data = boyscout) Deviance Residuals: 1 2 3 4 5 6 0.000e+00 -4.214e-08 -2.107e-08 -2.107e-08 -1.312e-07 -6.716e-08 7 8 9 10 11 12 0.000e+00 1.686e-07 0.000e+00 0.000e+00 0.000e+00 -5.903e-08 Coefficients: Estimate Std. Error z value Pr(>|z|) (Intercept) 3.8712 0.1420 27.261 < 2e-16 *** BYes 1.3863 0.1581 8.768 < 2e-16 *** DYes -3.1781 0.3227 -9.848 < 2e-16 *** SLow 1.2040 0.1618 7.443 9.84e-14 *** SMedium 1.0116 0.1652 6.124 9.13e-10 *** BYes:SLow -2.7726 0.2236 -12.400 < 2e-16 *** BYes:SMedium -1.3863 0.1958 -7.081 1.43e-12 *** DYes:SLow 1.7918 0.3594 4.986 6.16e-07 *** DYes:SMedium 1.1856 0.3684 3.219 0.00129 ** --- Signif. codes: 0 `***' 0.001 `**' 0.01 `*' 0.05 `.' 0.1 ` ' 1 (Dispersion parameter for poisson family taken to be 1) Null deviance: 7.5358e+02 on 11 degrees of freedom Residual deviance: 3.2302e-14 on 3 degrees of freedom AIC: 82.413 Number of Fisher Scoring iterations: 2 > a11 <- (boyscout$B=="Yes")*(boyscout$D=="Yes") > a12 <- (boyscout$B=="Yes")*(boyscout$D=="No") > a21 <- (boyscout$B=="No")*(boyscout$D=="Yes") > a22 <- (boyscout$B=="No")*(boyscout$D=="No") > > x11 <- sum(boyscout$Freq[a11==1]) > x12 <- sum(boyscout$Freq[a12==1]) > x21 <- sum(boyscout$Freq[a21==1]) > x22 <- sum(boyscout$Freq[a22==1]) > > > odds <- x11*x12/(x21*x22) > std <- sqrt(1/x11+1/x12+1/x21+1/x22) > > interval <- c(odds*exp(-1.96*std),odds*exp(1.96*std)) > odds [1] 0.642353 > interval [1] 0.4141742 0.9962410 > matrix(c(x11,x21,x12,x22),2) [,1] [,2] [1,] 36 364 [2,] 60 340