# Detecting overdispersion in Binomial data

 T2.overdisp.bin<-function(yy,rr) {
 
 # yy = vector of observed events
 # rr = vector of replicate counts (same length as yy)

   ppi<- sum(yy)/sum(rr)
   denom <- 2*sum(rr*(rr-1))
   top1<- sum((yy-rr*ppi)^2)/(ppi*(1-ppi))
   top2<- sum(rr)
   (top1 - top2)^2/denom
 }

 # input the boric acid teratogenicity data
 dead.0<-c(0,0,1,1,1,2,0,0,1,2,0,0,3,1,0,0,2,3,0,2,
           0,0,2,1,1,0,0)
 implant.0<-c(15,3,9,12,13,13,16,11,11,8,14,13,14,13,8,
           13,14,14,11,12,15,15,14,11,16,12,14)

 dead.1<-c(0,1,1,0,2,0,0,3,0,2,3,1,1,0,0,0,1,0,2,2,2,3,
           1,0,1,1,1)
 implant.1<-c(6,14,12,10,14,12,14,14,10,12,13,11,11,11,
           13,10,12,11,10,12,15,12,12,12,12,13,15)

 dead.2<-c(1,0,0,0,0,0,4,0,0,1,2,0,1,1,0,0,1,0,1,0,0,1,
           2,1,0,0,1)
 implant.2<-c(12,12,11,13,12,14,15,14,12,6,13,10,14,12,
           10,9,12,13,14,13,14,13,12,14,13,12,7)

 dead.4<-c(12,1,0,2,2,4,0,1,0,1,3,0,1,0,3,2,3,3,1,1,8,0,
           2,8,4,2)
 implant.4<-c(12,12,13,8,12,13,13,13,12,9,9,11,14,10,12,
           21,10,11,11,11,14,15,13,11,12,12)

 # calculate the test of overdispersion
 T2.0<-T2.overdisp.bin(dead.0,implant.0)
 T2.1<-T2.overdisp.bin(dead.1,implant.1)
 T2.2<-T2.overdisp.bin(dead.2,implant.2)
 T2.4<-T2.overdisp.bin(dead.4,implant.4)

 conc<-c(0,.1,.2,.4)
 all.T2<-c(T2.0,T2.1,T2.2,T2.4)

 for (jj in 1:4)
    cat("conc = ",conc[jj],":  T2 = ",signif(all.T2[jj]),
        "; P-value = ",signif(1-pchisq(all.T2[jj],1)),
        "\n")

 cat("\nOVERALL:  sum(T2) = ",signif(sum(all.T2)),
        "; P-value = ",signif(1-pchisq(sum(all.T2),4)),
        "\n")


# output follows ...

 conc =  0   :  T2 =  0.509 ; P-value =  0.475565 
 conc =  0.1 :  T2 =  0.042 ; P-value =  0.837406 
 conc =  0.2 :  T2 =  1.716 ; P-value =  0.19015 
 conc =  0.4 :  T2 =140.941 ; P-value =  0 

 OVERALL:  sum(T2) =  143.209 ; P-value =  0