x <- c(20 ,25 ,15 ,15 ,25 ,25 ,25 ,21 ,30 ,25 ,20 ,40 ,13 ,30 ,25 ,20 ,25 ,20 ,25 ,20 ,20 ,15 ,15 ,12 ,20 ,5 ,20 ,15 ,25 ,22 ,20 ,22 ,25 ,20 ,20 ,35 ,30 ,25 ,20 ,20 ,20 ,25 ,25 ,15 ,20 ,35 ,25 ,25 ,30 ,23 ,10 ,22 ,25 ,25 ,22 ,30 ,20 ,25 ,25 ,22 ,25 ,25 ,25 ,22 ,25 ,12 ,18 ,20 ,20 ,22 ,30 ,25 ,22 ,20 ,50 ,30 ,25 ,20 ,30 ,22 ,25 ,30 ,22 ,25 ,22 ,22 ,25 ,25 ,25 ,20 ,22 ,15 ,20 ,30 ,20 ,25 ,30 ,35 ,22 ,12 ,30 ,15 ,10 ,30 ,9 ,25 ,20 ,20 ,35 ,25 ,35 ,30 ,12 ,25 ,15 ,25 ,25 ,20 ,20 ,6 ,15 ,40 ,20 ,40 ,25 ,25 ,20 ,15 ,15 ,22 ,24 ,22 ,20 ,25 ,25 ,25 ,35 ,40 ,20 ,22 ,22 ,20 ,25 ,25 ,18 ,25 ,20 ,25 ,30 ,20 ,22 ,35 ,22 ,25 ,25 ,25 ,25 ,22 ,23 ,35 ,15 ,25 ,18 ,22 ,25 ,25 ,28 ,30 ,20 ,25 ,25 ,30 ,22 ,30 ,10 ,10 ,25 ,20 ,22 ,25 ,25 ,15 ,22 ,25 ,25 ,28 ,22 ,30 ,25 ,20 ,25 ,25 ,20 ,30 ,20 ,30 ,50 ,19 ,20 ,28 ,20 ,25 ,35 ,25 ,25 ,15 ,16 ,20 ,20 ,25 ,30 ,20 ,25 ,25 ,25 ,20 ,20 ,25 ,25 ,30 ,22 ,20 ,25 ,25 ,18 ,18 ,20 ,25 ,25 ,30 ,25 ,20 ,25 ,20 ,20 ,20 ,22 ,18 ,22 ,20 ,15 ,25 ,25 ,20 ,25 ,15 ,22 ,25 ,25 ,15 ,12 ,25 ,30 ,22 ,15 ,22 ,25 ,12 ,18 ,30 ,25 ,25 ,40 ,24 ,25 ,15 ,25 ,20 ,25 ,25 ,25 ,20 ,30 ,20 ,25 ,30 ,22 ,25 ,25 ,25 ,50 ,19 ,50 ,25 ,35 ,20 ,20 ,20 ,20 ,20 ,25 ,25 ,25 ,20 ,20 ,20 ,20 ,25 ,18 ,25 ,22 ,22 ,30 ,30 ,8 ,20 ,25 ,30 ,50 ,22 ,20 ,10 ,25 ,25 ,25 ,25 ,18 ,25 ,20 ,25 ,30 ,18 ,20 ,25 ,22 ,22 ,20 ,20 ,25 ,20 ,20 ,20 ,20 ,25 ,20 ,10 ,20 ,25 ,30 ,25 ,50 ,30 ,30 ,50 ,15 ,25 ,25 ,22 ,20 ,22 ,30 ,25 ,18 ,22 ,22 ,30 ,40 ,25 ,20 ,10 ,20 ,9 ,15 ,20 ,15 ,20 ,30 ,12 ,15 ,12 ,20 ,15 ,12 ,25 ,20 ,25 ,25 ,25 ,30 ,20 ,25 ,15 ,15 ,22 ,10 ,15 ,10 ,20 ,25 ,20 ,20 ,38 ,20 ,20 ,20 ,40 ,25 ,25 ,30 ,25 ,10 ,20 ,25 ,12 ,15 ,25 ,20 ,22 ,22 ,20 ,25 ,25 ,25 ,15 ,40 ,20 ,20 ,16 ,25 ,15 ,20 ,25 ,20 ,30 ,50 ,20 ,25 ,20 ,30 ,30 ,25 ,25 ,12 ,25 ,25 ,25 ,20 ,20 ,20 ,15 ,20 ,25 ,15 ,25 ,50 ,30 ,20 ,20 ,25 ,12 ,15 ,20 ,20 ,35 ,22 ,15 ,18 ,30 ,22 ,12 ,12 ,20 ,20 ,15 ,25 ,15 ,20 ,20 ,25 ,18 ,30 ,20 ,25 ,25 ,25 ,20 ,20 ,25 ,20 ,22 ,15 ,15 ,22 ,20 ,10 ,25 ,20 ,20 ,15 ,12 ,20 ,5 ,20 ,15 ,15 ,25 ,25 ,25 ,15 ,25 ,22 ,25 ,20 ,18 ,22 ,25 ,35 ,25 ,25 ,25 ,35 ,30 ,22 ,30 ,50 ,15 ,25 ,24 ,20 ,25 ,25 ,25 ,12 ,15 ,22 ,25 ,25 ,25 ,25 ,15 ,20 ,20 ,15 ,35 ,30 ,20 ,22 ,65 ,20 ,25 ,22 ,20 ,25 ,25 ,20 ,25 ,15 ,20 ,12 ,15 ,10 ,25 ,15 ,30 ,35 ,25 ,25 ,25 ,25 ,25 ,40 ,40 ,25 ,25 ,20 ,25 ,25 ,22 ,25 ,30 ,25 ,25 ,30 ,25 ,25 ,30 ,25 ,25 ,20 ,22 ,22 ,20 ,25 ,22 ,25 ,22 ,40 ,25 ,25 ,25 ,22 ,20 ,35 ,20 ,35 ,25 ,22 ,25 ,25 ,25 ,25 ,25 ,40 ,25 ,30 ,25 ,20 ,25 ,25 ,30 ,22 ,22 ,20 ,15 ,15 ,25 ,25 ,20 ,20 ,15 ,25 ,15 ,20 ,22 ,25 ,15 ,15 ,18 ,5 ,15 ,25 ,18 ,40 ,25 ,25 ,20 ,30 ,20 ,25 ,25 ,25 ,22 ,22 ,25 ,25 ,30 ,25 ,25 ,25 ,25 ,20 ,20 ,25 ,25 ,25 ,25 ,20 ,30 ,25 ,22 ,30 ,20 ,20 ,30 ,25 ,25 ,30 ,20 ,25 ,25 ,24 ,25 ,30 ,18 ,15 ,22 ,22 ,25 ,22 ,22 ,25 ,15 ,20 ,22 ,18 ,35 ,20 ,20 ,20 ,25 ,25 ,30 ,15 ,25 ,22 ,26 ,25 ,20 ,25 ,25 ,25 ,22 ,25 ,25 ,20 ,22 ,30 ,15 ,30 ,25 ,20 ,25 ,25 ,35 ,22 ,20 ,25 ,20 ,20 ,18 ,20 ,22 ,25 ,10 ,20 ,25 ,20 ,20 ,30 ,25 ,20 ,15 ,20 ,25 ,10 ,20 ,25 ,22 ,22 ,25 ,25 ,15 ,25 ,20 ,10 ,25 ,16 ,25 ,35 ,25 ,15 ,25 ,25 ,30 ,25 ,10 ,22 ,20 ,25 ,20 ,20 ,25 ,22 ,18 ,30 ,19 ,25 ,20 ,25 ,20 ,25 ,20 ,22 ,12 ,30 ,12 ,22 ,25 ,25 ,25 ,25 ,30 ,30 ,10 ,22 ,22 ,25 ,20 ,22 ,20 ,25 ,20 ,15 ,25 ,20 ,25 ,20 ,30 ,15 ,40 ,25 ,20 ,22 ,22 ,30 ,20 ,40 ,20 ,25 ,20 ,25 ,20 ,50 ,50 ,25 ,25 ,40 ,30 ,22 ,30 ,20 ,25 ,25 ,30 ,25 ,25 ,20 ,18 ,18 ,28 ,25 ,22 ,15 ,40 ,40 ,12 ,12 ,18 ,12 ,25 ,26 ,18 ,25 ,22 ,15 ,25 ,15 ,15 ,15 ,25 ,15 ,12 ,22 ,20 ,20 ,25 ,20 ,12 ,9 ,15 ,12 ,15 ,25 ,20 ,20 ,15 ,15 ,30 ,21 ,25 ,22 ,22 ,50 ,15 ,25 ,15 ,25 ,22 ,18 ,50 ,20 ,50 ,20 ,20 ,30 ,25 ,20 ,22 ,25 ,50 ,40 ,25 ,25 ,25 ,25 ,30 ,40 ,25 ,30 ,20) #'GNU S' R Code compiled by R2WASP v. 1.2.291 () #Author: root #To cite this work: Wessa P., (2012), Variability (v1.0.5) in Free Statistics Software (v$_version), Office for Research Development and Education, URL http://www.wessa.net/rwasp_variability.wasp/ #Source of accompanying publication: Office for Research, Development, and Education # num <- 50 res <- array(NA,dim=c(num,3)) 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] } } } } iqd <- function(x,def) { x <-sort(x[!is.na(x)]) n<-length(x) if (def==1) { qvalue1 <- q1(x,n,0.25,i,f) qvalue3 <- q1(x,n,0.75,i,f) } if (def==2) { qvalue1 <- q2(x,n,0.25,i,f) qvalue3 <- q2(x,n,0.75,i,f) } if (def==3) { qvalue1 <- q3(x,n,0.25,i,f) qvalue3 <- q3(x,n,0.75,i,f) } if (def==4) { qvalue1 <- q4(x,n,0.25,i,f) qvalue3 <- q4(x,n,0.75,i,f) } if (def==5) { qvalue1 <- q5(x,n,0.25,i,f) qvalue3 <- q5(x,n,0.75,i,f) } if (def==6) { qvalue1 <- q6(x,n,0.25,i,f) qvalue3 <- q6(x,n,0.75,i,f) } if (def==7) { qvalue1 <- q7(x,n,0.25,i,f) qvalue3 <- q7(x,n,0.75,i,f) } if (def==8) { qvalue1 <- q8(x,n,0.25,i,f) qvalue3 <- q8(x,n,0.75,i,f) } iqdiff <- qvalue3 - qvalue1 return(c(iqdiff,iqdiff/2,iqdiff/(qvalue3 + qvalue1))) } range <- max(x) - min(x) lx <- length(x) biasf <- (lx-1)/lx varx <- var(x) bvarx <- varx*biasf sdx <- sqrt(varx) mx <- mean(x) bsdx <- sqrt(bvarx) x2 <- x*x mse0 <- sum(x2)/lx xmm <- x-mx xmm2 <- xmm*xmm msem <- sum(xmm2)/lx axmm <- abs(x - mx) medx <- median(x) axmmed <- abs(x - medx) xmmed <- x - medx xmmed2 <- xmmed*xmmed msemed <- sum(xmmed2)/lx qarr <- array(NA,dim=c(8,3)) for (j in 1:8) { qarr[j,] <- iqd(x,j) } sdpo <- 0 adpo <- 0 for (i in 1:(lx-1)) { for (j in (i+1):lx) { ldi <- x[i]-x[j] aldi <- abs(ldi) sdpo = sdpo + ldi * ldi adpo = adpo + aldi } } denom <- (lx*(lx-1)/2) sdpo = sdpo / denom adpo = adpo / denom gmd <- 0 for (i in 1:lx) { for (j in 1:lx) { ldi <- abs(x[i]-x[j]) gmd = gmd + ldi } } gmd <- gmd / (lx*(lx-1)) sumx <- sum(x) pk <- x / sumx ck <- cumsum(pk) dk <- array(NA,dim=lx) for (i in 1:lx) { if (ck[i] <= 0.5) dk[i] <- ck[i] else dk[i] <- 1 - ck[i] } bigd <- sum(dk) * 2 / (lx-1) iod <- 1 - sum(pk*pk) res[1,] <- c('Absolute range','http://www.xycoon.com/absolute.htm', range) res[2,] <- c('Relative range (unbiased)','http://www.xycoon.com/relative.htm', range/sd(x)) res[3,] <- c('Relative range (biased)','http://www.xycoon.com/relative.htm', range/sqrt(varx*biasf)) res[4,] <- c('Variance (unbiased)','http://www.xycoon.com/unbiased.htm', varx) res[5,] <- c('Variance (biased)','http://www.xycoon.com/biased.htm', bvarx) res[6,] <- c('Standard Deviation (unbiased)','http://www.xycoon.com/unbiased1.htm', sdx) res[7,] <- c('Standard Deviation (biased)','http://www.xycoon.com/biased1.htm', bsdx) res[8,] <- c('Coefficient of Variation (unbiased)','http://www.xycoon.com/variation.htm', sdx/mx) res[9,] <- c('Coefficient of Variation (biased)','http://www.xycoon.com/variation.htm', bsdx/mx) res[10,] <- c('Mean Squared Error (MSE versus 0)','http://www.xycoon.com/mse.htm', mse0) res[11,] <- c('Mean Squared Error (MSE versus Mean)','http://www.xycoon.com/mse.htm', msem) res[12,] <- c('Mean Absolute Deviation from Mean (MAD Mean)', 'http://www.xycoon.com/mean2.htm', sum(axmm)/lx) res[13,] <- c('Mean Absolute Deviation from Median (MAD Median)', 'http://www.xycoon.com/median1.htm', sum(axmmed)/lx) res[14,] <- c('Median Absolute Deviation from Mean', 'http://www.xycoon.com/mean3.htm', median(axmm)) res[15,] <- c('Median Absolute Deviation from Median', 'http://www.xycoon.com/median2.htm', median(axmmed)) res[16,] <- c('Mean Squared Deviation from Mean', 'http://www.xycoon.com/mean1.htm', msem) res[17,] <- c('Mean Squared Deviation from Median', 'http://www.xycoon.com/median.htm', msemed) #Note: the /var/wessaorg/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab load(file="/var/wessaorg/rcomp/createtable") mylink1 <- hyperlink('http://www.xycoon.com/difference.htm','Interquartile Difference','') mylink2 <- paste(mylink1,hyperlink('http://www.xycoon.com/method_1.htm','(Weighted Average at Xnp)',''),sep=' ') res[18,] <- c('', mylink2, qarr[1,1]) mylink2 <- paste(mylink1,hyperlink('http://www.xycoon.com/method_2.htm','(Weighted Average at X(n+1)p)',''),sep=' ') res[19,] <- c('', mylink2, qarr[2,1]) mylink2 <- paste(mylink1,hyperlink('http://www.xycoon.com/method_3.htm','(Empirical Distribution Function)',''),sep=' ') res[20,] <- c('', mylink2, qarr[3,1]) mylink2 <- paste(mylink1,hyperlink('http://www.xycoon.com/method_4.htm','(Empirical Distribution Function - Averaging)',''),sep=' ') res[21,] <- c('', mylink2, qarr[4,1]) mylink2 <- paste(mylink1,hyperlink('http://www.xycoon.com/method_5.htm','(Empirical Distribution Function - Interpolation)',''),sep=' ') res[22,] <- c('', mylink2, qarr[5,1]) mylink2 <- paste(mylink1,hyperlink('http://www.xycoon.com/method_6.htm','(Closest Observation)',''),sep=' ') res[23,] <- c('', mylink2, qarr[6,1]) mylink2 <- paste(mylink1,hyperlink('http://www.xycoon.com/method_7.htm','(True Basic - Statistics Graphics Toolkit)',''),sep=' ') res[24,] <- c('', mylink2, qarr[7,1]) mylink2 <- paste(mylink1,hyperlink('http://www.xycoon.com/method_8.htm','(MS Excel (old versions))',''),sep=' ') res[25,] <- c('', mylink2, qarr[8,1]) mylink1 <- hyperlink('http://www.xycoon.com/deviation.htm','Semi Interquartile Difference','') mylink2 <- paste(mylink1,hyperlink('http://www.xycoon.com/method_1.htm','(Weighted Average at Xnp)',''),sep=' ') res[26,] <- c('', mylink2, qarr[1,2]) mylink2 <- paste(mylink1,hyperlink('http://www.xycoon.com/method_2.htm','(Weighted Average at X(n+1)p)',''),sep=' ') res[27,] <- c('', mylink2, qarr[2,2]) mylink2 <- paste(mylink1,hyperlink('http://www.xycoon.com/method_3.htm','(Empirical Distribution Function)',''),sep=' ') res[28,] <- c('', mylink2, qarr[3,2]) mylink2 <- paste(mylink1,hyperlink('http://www.xycoon.com/method_4.htm','(Empirical Distribution Function - Averaging)',''),sep=' ') res[29,] <- c('', mylink2, qarr[4,2]) mylink2 <- paste(mylink1,hyperlink('http://www.xycoon.com/method_5.htm','(Empirical Distribution Function - Interpolation)',''),sep=' ') res[30,] <- c('', mylink2, qarr[5,2]) mylink2 <- paste(mylink1,hyperlink('http://www.xycoon.com/method_6.htm','(Closest Observation)',''),sep=' ') res[31,] <- c('', mylink2, qarr[6,2]) mylink2 <- paste(mylink1,hyperlink('http://www.xycoon.com/method_7.htm','(True Basic - Statistics Graphics Toolkit)',''),sep=' ') res[32,] <- c('', mylink2, qarr[7,2]) mylink2 <- paste(mylink1,hyperlink('http://www.xycoon.com/method_8.htm','(MS Excel (old versions))',''),sep=' ') res[33,] <- c('', mylink2, qarr[8,2]) mylink1 <- hyperlink('http://www.xycoon.com/variation1.htm','Coefficient of Quartile Variation','') mylink2 <- paste(mylink1,hyperlink('http://www.xycoon.com/method_1.htm','(Weighted Average at Xnp)',''),sep=' ') res[34,] <- c('', mylink2, qarr[1,3]) mylink2 <- paste(mylink1,hyperlink('http://www.xycoon.com/method_2.htm','(Weighted Average at X(n+1)p)',''),sep=' ') res[35,] <- c('', mylink2, qarr[2,3]) mylink2 <- paste(mylink1,hyperlink('http://www.xycoon.com/method_3.htm','(Empirical Distribution Function)',''),sep=' ') res[36,] <- c('', mylink2, qarr[3,3]) mylink2 <- paste(mylink1,hyperlink('http://www.xycoon.com/method_4.htm','(Empirical Distribution Function - Averaging)',''),sep=' ') res[37,] <- c('', mylink2, qarr[4,3]) mylink2 <- paste(mylink1,hyperlink('http://www.xycoon.com/method_5.htm','(Empirical Distribution Function - Interpolation)',''),sep=' ') res[38,] <- c('', mylink2, qarr[5,3]) mylink2 <- paste(mylink1,hyperlink('http://www.xycoon.com/method_6.htm','(Closest Observation)',''),sep=' ') res[39,] <- c('', mylink2, qarr[6,3]) mylink2 <- paste(mylink1,hyperlink('http://www.xycoon.com/method_7.htm','(True Basic - Statistics Graphics Toolkit)',''),sep=' ') res[40,] <- c('', mylink2, qarr[7,3]) mylink2 <- paste(mylink1,hyperlink('http://www.xycoon.com/method_8.htm','(MS Excel (old versions))',''),sep=' ') res[41,] <- c('', mylink2, qarr[8,3]) res[42,] <- c('Number of all Pairs of Observations', 'http://www.xycoon.com/pair_numbers.htm', lx*(lx-1)/2) res[43,] <- c('Squared Differences between all Pairs of Observations', 'http://www.xycoon.com/squared_differences.htm', sdpo) res[44,] <- c('Mean Absolute Differences between all Pairs of Observations', 'http://www.xycoon.com/mean_abs_differences.htm', adpo) res[45,] <- c('Gini Mean Difference', 'http://www.xycoon.com/gini_mean_difference.htm', gmd) res[46,] <- c('Leik Measure of Dispersion', 'http://www.xycoon.com/leiks_d.htm', bigd) res[47,] <- c('Index of Diversity', 'http://www.xycoon.com/diversity.htm', iod) res[48,] <- c('Index of Qualitative Variation', 'http://www.xycoon.com/qualitative_variation.htm', iod*lx/(lx-1)) res[49,] <- c('Coefficient of Dispersion', 'http://www.xycoon.com/dispersion.htm', sum(axmm)/lx/medx) res[50,] <- c('Observations', '', lx) res a<-table.start() a<-table.row.start(a) a<-table.element(a,'Variability - Ungrouped Data',2,TRUE) a<-table.row.end(a) for (i in 1:num) { a<-table.row.start(a) if (res[i,1] != '') { a<-table.element(a,hyperlink(res[i,2],res[i,1],''),header=TRUE) } else { a<-table.element(a,res[i,2],header=TRUE) } a<-table.element(a,res[i,3]) a<-table.row.end(a) } a<-table.end(a) table.save(a,file="/var/wessaorg/rcomp/tmp/1o5uz1387740498.tab")