postscript("l08.ps");options(width=68)
#***********************************************************
#Mark A: Chi-Square Power                                   
#***********************************************************
library(pwr)
p0<-c(31,28,31,30,31,30,31,31,30,31,30,31)
p1<-p0*(1+c(1,1,2,0,0,0,0,0,0,0,2,2)*1)
p1<-p1/sum(p1)
p0<-p0/sum(p0)
pwr.chisq.test(ES.w1(p0,p1),N=1000,df=11)
fun.testncp<-function(p0,p1,size=10,nsamp=10000){
  out<-rep(NA,nsamp)
  for(j in seq(length(out))){
    out[j]<-chisq.test(rmultinom(1,size,p1),p=p0)$statistic
  }
  plot(ecdf(out))
  ncp1<-size*sum((p1-p0)^2/p0)
  x<-(0:100)*max(out)/100
  lines(x,pchisq(x,df=length(p1)-1,ncp=ncp1))
}
fun.testncp((1:3)/6,rep(1,3)/3)
#Two-way chi-square power.
ha<-array(.025,c(10,4))
ha[1,1]<-ha[2,2]<-ha[3,3]<-ha[4,4]<-.04
ha[2,1]<-ha[3,2]<-ha[4,3]<-ha[1,4]<-.01
pwr.chisq.test(ES.w2(ha),N=300,df=(4-1)*(10-1))
#*******************************************************/
# Laundry data from Cox and Snell (1981) Applied Stat- */
# istics.  Variables are count, temperature (low or    */
# high), previous user of standard detergent (no or    */
# yes, preference (new or old), and water hardness.    */
#*******************************************************/
laundry<-array(c( 68, 42, 37, 24,110, 72, 89, 67,
66, 33, 47, 23,116, 56,102, 70, 
63, 29, 57, 19,116, 56,106, 48),c(2,2,2,3))
dimnames(laundry)<-list(c("Low","High"),c("Nonuser","User"), 
  c("Old","New"),c("Hard","Medium","Soft")) 
laundry[,,2,]<-laundry[,,2,]-laundry[,,1,] 
laundry<-as.data.frame.table(laundry) 
names(laundry)<-c("tl","mpu","nr","ws","n") 
#*******************************************************/
# Mark B: 3 regressions show that collapsing over mp   */
# changes other interactions a bit.                    */
#*******************************************************/
cat('\n Laundry Data With 6 2 Way Interactions  \n')
coef(summary(glmo<-glm(n~ws+nr+mpu+tl+nr+ws*nr+ws*mpu+ 
  ws*tl+nr*mpu+nr*tl+mpu*tl,data=laundry,family=poisson)))
anova(glmo)
cat('\n Laundry Data With 4 2 Way Interactions  \n')
coef(summary(glmo<-glm(n~ws+nr+mpu+tl+nr+ws*mpu+ws*tl+ 
  nr*mpu+nr*tl,data=laundry,family=poisson))) 
anova(glmo)
cat('\n Laundry Data With Prior Detergent Removed  \n')
coef(summary(glmo<-glm(n~ws+nr+tl+nr+ws*tl+nr*tl,
  data=laundry,family=poisson))) 
anova(glmo)
#****************************************************/
# Housing data from Cox and Snell (1980), Example W,*/
# on satisfaction with housing in Copenhagen.  Data */
# was extracted from R package MASS.  Data may also */
# be found at                                       */
# www.stat.ucla.edu/data/cox-and-snell/exampleW.data*/
#****************************************************/
housing<-as.data.frame(scan("housing.dat",
  what=list(nn=0,sat="",infl="",type="",contact="",freq=0)))
housing$nsat<-(housing$sat=="Medium")+2*(housing$sat=="High")
housing$ninf<-(housing$infl=="Medium")+2*(housing$infl=="High")
housing$ncont<-(housing$contact=="Medium")+
  2*(housing$contact=="High")
fullhouse<-housing[rep(1:72,housing$freq),]
cat('\n Copenhagen housing data, linear by linear inter.  \n')
#*********************************************************/
# Mark C: Regression has linear*linear interactions show-*/
# ing satisfaction increasing with influence, contact.   */
#*********************************************************/
summary(glm(freq~sat+infl+type+contact+
  nsat*ninf+nsat*ncont,family=poisson,data=housing))
#****************************************************/
# Performing likelihood ratio test using likelihood */
# shows richer interaction model is not necessary.  */
#****************************************************/
cat('\n Housing data, larger overparameterized  model  \n')
summary(glm(freq~type+nsat*ninf+nsat*ncont+sat*contact
  +sat*infl,family=poisson,data=housing))