source('/home/pw/wessanet/cretab') myrfcuid = '' x <- c(0.288.0.289.0.29.0.29.0.294.0.295.0.295.0.296.0.298.0.299.0.302.0.303.0.304.0.304.0.305.0.305.0.306.0.307.0.307.0.308.0.309.0.31.0.31.0.312.0.312.0.312.0.312.0.313.0.313.0.313.0.313.0.313.0.314.0.314.0.314.0.315.0.316.0.316.0.316.0.316.0.316.0.317.0.317.0.318.0.319.0.319.0.319.0.319.0.321.0.321.0.321.0.321.0.321.0.321.0.322.0.322.0.322.0.323.0.324.0.325.0.325.0.325.0.325.0.325.0.326.0.327.0.327.0.328.0.329.0.329.0.329.0.33.0.33.0.33.0.331.0.331.0.332.0.332.0.333.0.335.0.336.0.336.0.336.0.338.0.338.0.34.0.346.0.347.0.349.0.355) #'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/1p8n01584625355.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/2qb1n1584625355.tab") try(system("convert /home/pw/wessanet/rcomp/tmp/1p8n01584625355.ps /home/pw/wessanet/rcomp/tmp/1p8n01584625355.png",intern=TRUE))