par4 = '0.05' par3 = '0.00083' par2 = '0.00068' par1 = '77822' par4 <- '0.05' par3 <- '0.00083' par2 <- '0.00068' par1 <- '77822' #'GNU S' R Code compiled by R2WASP v. 1.0.44 () #Author: Prof. Dr. P. Wessa #To cite this work: AUTHOR(S), (YEAR), YOUR SOFTWARE TITLE (vNUMBER) in Free Statistics Software (v$_version), Office for Research Development and Education, URL http://www.wessa.net/rwasp_YOURPAGE.wasp/ #Source of accompanying publication: Office for Research, Development, and Education #Technical description: Write here your technical program description (don't use hard returns!) 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) #Note: the /var/wessaorg/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab load(file="/var/wessaorg/rcomp/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="/var/wessaorg/rcomp/tmp/1s4181430553111.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="/var/wessaorg/rcomp/tmp/2lij91430553111.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="/var/wessaorg/rcomp/tmp/3rse11430553112.tab")