source('/home/pw/wessanet/cretab') myrfcuid = '' x <- c(1.83,-1.8,0.09,-1.53,-0.58,0.21,1.25,-1.22,1.32,3.63,-2.3,0.65,-0.01,-1.11,0.13,-1.07,0.8,-1.98,0.02,0.25,3.3,1.036,2.042,1.04,-0.87,-0.39,-0.29,2.08,3.36,-0.53,-0.07,0.57,2.92,1.99,1.74,-0.76,2.35,-1.91,2.22,2.57) #'GNU S' R Code compiled by R2WASP v. 1.2.327 (Sun, 11 Sep 2016 10:56:48 +0200) #Author: root #To cite this work: Wessa P., (2016), Percentiles (v1.0.7) in Free Statistics Software (v$_version), Office for Research Development and Education, URL http://www.wessa.net/rwasp_percentiles.wasp/ #Source of accompanying publication: Office for Research, Development, and Education # 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="/home/pw/wessanet/rcomp/tmp/1sdl41580685242.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() 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, 'Weighted Average at Xnp',1,TRUE) a<-table.element(a, 'Weighted Average at X(n+1)p',1,TRUE) a<-table.element(a, 'Empirical Distribution Function',1,TRUE) a<-table.element(a, 'Empirical Distribution Function - Averaging',1,TRUE) a<-table.element(a, 'Empirical Distribution Function - Interpolation',1,TRUE) a<-table.element(a, 'Closest Observation',1,TRUE) a<-table.element(a, 'True Basic - Statistics Graphics Toolkit',1,TRUE) a<-table.element(a, '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,signif(qval[perc,j],6)) } a<-table.row.end(a) } a<-table.end(a) table.save(a,file="/home/pw/wessanet/rcomp/tmp/22c391580685242.tab") try(system("convert /home/pw/wessanet/rcomp/tmp/1sdl41580685242.ps /home/pw/wessanet/rcomp/tmp/1sdl41580685242.png",intern=TRUE))