R version 2.13.0 (2011-04-13) Copyright (C) 2011 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i486-pc-linux-gnu (32-bit) 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. 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. > x <- c(24300 + ,24375 + ,24375 + ,24550 + ,24725 + ,24825 + ,25100 + ,24950 + ,25325 + ,25325 + ,24800 + ,24975 + ,25125 + ,25125 + ,25125 + ,25400 + ,25175 + ,24650 + ,24775 + ,24675 + ,24825 + ,24775 + ,24675 + ,24750 + ,24875 + ,25400 + ,25400 + ,24750 + ,24900 + ,24825 + ,24875 + ,24975 + ,25375 + ,25600 + ,26000 + ,25900 + ,25850 + ,26075 + ,26275 + ,26050 + ,26000 + ,25825 + ,26075 + ,26150 + ,26275 + ,26475 + ,26500 + ,26575 + ,26425 + ,26275 + ,26375 + ,25900 + ,25850 + ,25625 + ,25900 + ,26050 + ,26150 + ,26275 + ,26100 + ,25975 + ,25975 + ,26125 + ,26175 + ,26225 + ,26225 + ,26200 + ,26275 + ,26275 + ,26275 + ,26750 + ,27075 + ,27475 + ,27525 + ,27125 + ,27000 + ,26950 + ,27075 + ,27150 + ,26875 + ,26925 + ,27150 + ,27150 + ,27425 + ,27625 + ,27475 + ,28075 + ,28075 + ,28175 + ,28350 + ,28350 + ,28500 + ,29350 + ,30225 + ,29575 + ,30125 + ,30125 + ,31150 + ,31350 + ,32175 + ,31725 + ,31600 + ,30800 + ,30800 + ,29700 + ,30875 + ,31275 + ,31500 + ,31375 + ,31400 + ,31650 + ,31975 + ,31650 + ,31975 + ,32575 + ,32025 + ,33050 + ,32300 + ,32100 + ,32250 + ,32050 + ,31975 + ,32100 + ,32025 + ,32275 + ,32100 + ,32275 + ,31975 + ,32175 + ,32375 + ,32300 + ,32450 + ,32425 + ,30800 + ,30850 + ,30750 + ,30175 + ,30350 + ,30125 + ,30625 + ,30375 + ,30425 + ,30325 + ,29825 + ,29450 + ,29100 + ,29450 + ,29550 + ,29575 + ,29425 + ,29050 + ,28525 + ,28575 + ,28500 + ,28875 + ,28625 + ,28625 + ,28925 + ,28925 + ,28950 + ,28950 + ,29100 + ,29700 + ,30000 + ,30400 + ,30375 + ,30425 + ,30625 + ,30700 + ,30825 + ,30800 + ,31100 + ,31175 + ,31025 + ,30975 + ,31025 + ,31350 + ,31075 + ,31125 + ,30900 + ,31150 + ,31575 + ,31575 + ,31375 + ,31100 + ,30975 + ,31200 + ,31125 + ,31075 + ,31275 + ,31175 + ,30950 + ,30725 + ,30900 + ,30700 + ,30625 + ,30700 + ,30650 + ,30525 + ,30850 + ,30725 + ,31025 + ,30975 + ,30550 + ,30900 + ,31000 + ,31000 + ,31000 + ,31000 + ,31325 + ,31000 + ,31000 + ,30300 + ,30575 + ,30575 + ,30775 + ,30550 + ,30750 + ,31025 + ,31000 + ,30850 + ,30600 + ,31150 + ,31800 + ,32500 + ,32325 + ,31800 + ,31850 + ,31625 + ,31750 + ,31650 + ,31525 + ,32075 + ,32725 + ,32900 + ,32775 + ,32825 + ,33200 + ,34100 + ,33800 + ,33525 + ,33775 + ,34000 + ,33425 + ,33550 + ,33400 + ,33300 + ,33400 + ,33000 + ,33500 + ,33550 + ,33725 + ,33700 + ,33600 + ,33550 + ,33500 + ,34200 + ,34000 + ,33600) > x <-sort(x[!is.na(x)]) > q1 <- function(data,n,p,i,f) { + np <- n*p; + i <<- floor(np) + f <<- np - i + qvalue <- (1-f)*data[i] + f*data[i+1] + } > q2 <- function(data,n,p,i,f) { + np <- (n+1)*p + i <<- floor(np) + f <<- np - i + qvalue <- (1-f)*data[i] + f*data[i+1] + } > q3 <- function(data,n,p,i,f) { + np <- n*p + i <<- floor(np) + f <<- np - i + if (f==0) { + qvalue <- data[i] + } else { + qvalue <- data[i+1] + } + } > q4 <- function(data,n,p,i,f) { + np <- n*p + i <<- floor(np) + f <<- np - i + if (f==0) { + qvalue <- (data[i]+data[i+1])/2 + } else { + qvalue <- data[i+1] + } + } > q5 <- function(data,n,p,i,f) { + np <- (n-1)*p + i <<- floor(np) + f <<- np - i + if (f==0) { + qvalue <- data[i+1] + } else { + qvalue <- data[i+1] + f*(data[i+2]-data[i+1]) + } + } > q6 <- function(data,n,p,i,f) { + np <- n*p+0.5 + i <<- floor(np) + f <<- np - i + qvalue <- data[i] + } > q7 <- function(data,n,p,i,f) { + np <- (n+1)*p + i <<- floor(np) + f <<- np - i + if (f==0) { + qvalue <- data[i] + } else { + qvalue <- f*data[i] + (1-f)*data[i+1] + } + } > q8 <- function(data,n,p,i,f) { + np <- (n+1)*p + i <<- floor(np) + f <<- np - i + if (f==0) { + qvalue <- data[i] + } else { + if (f == 0.5) { + qvalue <- (data[i]+data[i+1])/2 + } else { + if (f < 0.5) { + qvalue <- data[i] + } else { + qvalue <- data[i+1] + } + } + } + } > lx <- length(x) > qval <- array(NA,dim=c(99,8)) > mystep <- 25 > mystart <- 25 > if (lx>10){ + mystep=10 + mystart=10 + } > if (lx>20){ + mystep=5 + mystart=5 + } > if (lx>50){ + mystep=2 + mystart=2 + } > if (lx>=100){ + mystep=1 + mystart=1 + } > for (perc in seq(mystart,99,mystep)) { + qval[perc,1] <- q1(x,lx,perc/100,i,f) + qval[perc,2] <- q2(x,lx,perc/100,i,f) + qval[perc,3] <- q3(x,lx,perc/100,i,f) + qval[perc,4] <- q4(x,lx,perc/100,i,f) + qval[perc,5] <- q5(x,lx,perc/100,i,f) + qval[perc,6] <- q6(x,lx,perc/100,i,f) + qval[perc,7] <- q7(x,lx,perc/100,i,f) + qval[perc,8] <- q8(x,lx,perc/100,i,f) + } > postscript(file="/var/wessaorg/rcomp/tmp/1y12z1324630904.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) > myqqnorm <- qqnorm(x,col=2) > qqline(x) > grid() > dev.off() null device 1 > > #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,'Percentiles - Ungrouped Data',9,TRUE) > a<-table.row.end(a) > a<-table.row.start(a) > a<-table.element(a,'p',1,TRUE) > a<-table.element(a,hyperlink('http://www.xycoon.com/method_1.htm', 'Weighted Average at Xnp',''),1,TRUE) > a<-table.element(a,hyperlink('http://www.xycoon.com/method_2.htm','Weighted Average at X(n+1)p',''),1,TRUE) > a<-table.element(a,hyperlink('http://www.xycoon.com/method_3.htm','Empirical Distribution Function',''),1,TRUE) > a<-table.element(a,hyperlink('http://www.xycoon.com/method_4.htm','Empirical Distribution Function - Averaging',''),1,TRUE) > a<-table.element(a,hyperlink('http://www.xycoon.com/method_5.htm','Empirical Distribution Function - Interpolation',''),1,TRUE) > a<-table.element(a,hyperlink('http://www.xycoon.com/method_6.htm','Closest Observation',''),1,TRUE) > a<-table.element(a,hyperlink('http://www.xycoon.com/method_7.htm','True Basic - Statistics Graphics Toolkit',''),1,TRUE) > a<-table.element(a,hyperlink('http://www.xycoon.com/method_8.htm','MS Excel (old versions)',''),1,TRUE) > a<-table.row.end(a) > for (perc in seq(mystart,99,mystep)) { + a<-table.row.start(a) + a<-table.element(a,round(perc/100,2),1,TRUE) + for (j in 1:8) { + a<-table.element(a,round(qval[perc,j],6)) + } + a<-table.row.end(a) + } > a<-table.end(a) > table.save(a,file="/var/wessaorg/rcomp/tmp/2oz431324630904.tab") > > try(system("convert tmp/1y12z1324630904.ps tmp/1y12z1324630904.png",intern=TRUE)) character(0) > > > proc.time() user system elapsed 1.062 0.077 1.157