R version 2.6.0 (2007-10-03)
Copyright (C) 2007 The R Foundation for Statistical Computing
ISBN 3-900051-07-0

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

  Natural language support but running in an English locale

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> par4 = '0.05'
> par3 = '0.69'
> par2 = '0.8571'
> par1 = '98'
> #'GNU S' R Code compiled by R2WASP v. 1.0.44 ()
> #Author: Prof. Dr. P. Wessa
> #To cite this work: Wessa P., (2007), Testing Population Proportion (Critical values) (v1.0.2) in Free Statistics Software (v$_version), Office for Research Development and Education, URL http://www.wessa.net/rwasp_hypothesisprop1.wasp/
> #Source of accompanying publication: Office for Research, Development, and Education
> #Technical description: Write here your technical program description
> 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='/var/www/html/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<br />(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/www/html/rcomp/tmp/1eisv1194873678.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<br />(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/www/html/rcomp/tmp/2v6wb1194873678.tab") 
> library(Hmisc)

Attaching package: 'Hmisc'


	The following object(s) are masked from package:base :

	 format.pval,
	 round.POSIXt,
	 trunc.POSIXt,
	 units,
	 units<- 

> 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<br />(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<br />(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<br />(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<br />(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<br />(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<br />(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/www/html/rcomp/tmp/33b081194873678.tab") 
> 
> 
> 
> proc.time()
   user  system elapsed 
  1.220   0.029   1.240