par1 <- as.numeric(par1) par2 <- as.numeric(par2) par3 <- as.numeric(par3) par4 <- as.numeric(par4) if (par2 < par3) { ucv <- qnorm(par4) } else { ucv <- -qnorm(par4) } cv1 <- par3 + ucv * sqrt(par3 * (1-par3) / par1) cv2low <- par2 - abs(qnorm(par4/2)) * sqrt(par3 * (1-par3) / par1) cv2upp <- par2 + abs(qnorm(par4/2)) * sqrt(par3 * (1-par3) / par1) z21 <- qnorm(par4/2)^2 / par1 z2 <- qnorm(par4/2)^2 / (2*par1) z24 <- qnorm(par4/2)^2 / (4*par1^2) cv2lowexact <- (par2 + z2 - abs(qnorm(par4/2)) * sqrt(par3 * (1-par3) / par1 + z24)) / (1 + z21) cv2uppexact <- (par2 + z2 + abs(qnorm(par4/2)) * sqrt(par3 * (1-par3) / par1 + z24)) / (1 + z21) z11 <- qnorm(par4)^2 / par1 z1 <- qnorm(par4)^2 / (2*par1) z14 <- qnorm(par4)^2 / (4*par1^2) cv1lowexact <- (par2 + z1 - abs(qnorm(par4)) * sqrt(par3 * (1-par3) / par1 + z14)) / (1 + z11) cv1uppexact <- (par2 + z1 + abs(qnorm(par4)) * sqrt(par3 * (1-par3) / par1 + z14)) / (1 + z11) load(file='createtable') a<-table.start() a<-table.row.start(a) a<-table.element(a,'Testing Population Proportion (normal approximation)',2,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Sample size',header=TRUE) a<-table.element(a,par1) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Sample Proportion',header=TRUE) a<-table.element(a,par2) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Null hypothesis',header=TRUE) a<-table.element(a,par3) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Type I error (alpha)',header=TRUE) a<-table.element(a,par4) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'1-sided critical value',header=TRUE) a<-table.element(a,cv1) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'1-sided test',header=TRUE) if (par2 < par3) { if (par2 < cv1) { a<-table.element(a,'Reject the Null Hypothesis') } else { a<-table.element(a,'Do not reject the Null Hypothesis') } } else { if (par2 > cv1) { a<-table.element(a,'Reject the Null Hypothesis') } else { a<-table.element(a,'Do not reject the Null Hypothesis') } } a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'2-sided Confidence Interval (sample proportion)',header=TRUE) dum <- paste('[',cv2low) dum <- paste(dum,',') dum <- paste(dum,cv2upp) dum <- paste(dum,']') a<-table.element(a,dum) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'2-sided test',header=TRUE) if ((par3 < cv2low) | (par3 > cv2upp)) { a<-table.element(a,'Reject the Null Hypothesis') } else { a<-table.element(a,'Do not reject the Null Hypothesis') } a<-table.row.end(a) a<-table.end(a) table.save(a,file='mytable.tab') a<-table.start() a<-table.row.start(a) a<-table.element(a,'Testing Population Proportion (Agresti-Coull method)',2,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Sample size',header=TRUE) a<-table.element(a,par1) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Sample Proportion',header=TRUE) a<-table.element(a,par2) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Null hypothesis',header=TRUE) a<-table.element(a,par3) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Type I error (alpha)',header=TRUE) a<-table.element(a,par4) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Left 1-sided confidence interval',header=TRUE) dum <- paste('[',cv1lowexact) dum <- paste(dum,', 1 ]') a<-table.element(a,dum) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Right 1-sided confidence interval',header=TRUE) dum <- paste('[ 0 ,',cv1uppexact) dum <- paste(dum,' ]') a<-table.element(a,dum) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'2-sided Confidence Interval (sample proportion)',header=TRUE) dum <- paste('[',cv2lowexact) dum <- paste(dum,',') dum <- paste(dum,cv2uppexact) dum <- paste(dum,']') a<-table.element(a,dum) a<-table.row.end(a) a<-table.end(a) table.save(a,file='mytable.tab') library(Hmisc) re <- binconf(par2*par1,par1,par4,method='exact') re1 <- binconf(par2*par1,par1,par4*2,method='exact') rw <- binconf(par2*par1,par1,par4,method='wilson') rw1 <- binconf(par2*par1,par1,par4*2,method='wilson') a<-table.start() a<-table.row.start(a) a<-table.element(a,'Testing Population Proportion (Exact and Wilson method)',2,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Sample size',header=TRUE) a<-table.element(a,par1) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Sample Proportion',header=TRUE) a<-table.element(a,par2) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Null hypothesis',header=TRUE) a<-table.element(a,par3) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Type I error (alpha)',header=TRUE) a<-table.element(a,par4) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Left 1-sided confidence interval (Exact method)',header=TRUE) dum <- paste('[',re1[2]) dum <- paste(dum,', 1 ]') a<-table.element(a,dum) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Right 1-sided confidence interval (Exact method)',header=TRUE) dum <- paste('[ 0 ,',re1[3]) dum <- paste(dum,' ]') a<-table.element(a,dum) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'2-sided Confidence Interval (Exact method)',header=TRUE) dum <- paste('[',re[2]) dum <- paste(dum,',') dum <- paste(dum,re[3]) dum <- paste(dum,']') a<-table.element(a,dum) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Left 1-sided confidence interval (Wilson method)',header=TRUE) dum <- paste('[',rw1[2]) dum <- paste(dum,', 1 ]') a<-table.element(a,dum) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Right 1-sided confidence interval (Wilson method)',header=TRUE) dum <- paste('[ 0 ,',rw1[3]) dum <- paste(dum,' ]') a<-table.element(a,dum) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'2-sided Confidence Interval (Wilson method)',header=TRUE) dum <- paste('[',rw[2]) dum <- paste(dum,',') dum <- paste(dum,rw[3]) dum <- paste(dum,']') a<-table.element(a,dum) a<-table.row.end(a) a<-table.end(a) table.save(a,file='mytable.tab')
|