R version 3.0.2 (2013-09-25) -- "Frisbee Sailing" Copyright (C) 2013 The R Foundation for Statistical Computing Platform: i686-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(85.73,85.73,85.74,86.32,87.59,87.81,87.87,87.94,87.96,88.01,88.01,88.01,88.01,88.01,88.59,89.43,89.63,89.73,89.88,89.89,89.9,89.91,89.86,90.07,90.17,90.17,90.28,90.87,92.05,92.1,92.16,92.22,92.25,92.29,92.29,92.29,92.29,92.29,91.95,91.82,92.16,92.31,92.33,92.4,92.54,92.49,92.54,92.58,92.58,92.39,92.33,93.59,95.51,95.99,96.22,97.2,98.54,99.64,100.23,100.17) > #'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 [,1] [1,] "Absolute range" [2,] "Relative range (unbiased)" [3,] "Relative range (biased)" [4,] "Variance (unbiased)" [5,] "Variance (biased)" [6,] "Standard Deviation (unbiased)" [7,] "Standard Deviation (biased)" [8,] "Coefficient of Variation (unbiased)" [9,] "Coefficient of Variation (biased)" [10,] "Mean Squared Error (MSE versus 0)" [11,] "Mean Squared Error (MSE versus Mean)" [12,] "Mean Absolute Deviation from Mean (MAD Mean)" [13,] "Mean Absolute Deviation from Median (MAD Median)" [14,] "Median Absolute Deviation from Mean" [15,] "Median Absolute Deviation from Median" [16,] "Mean Squared Deviation from Mean" [17,] "Mean Squared Deviation from Median" [18,] "" [19,] "" [20,] "" [21,] "" [22,] "" [23,] "" [24,] "" [25,] "" [26,] "" [27,] "" [28,] "" [29,] "" [30,] "" [31,] "" [32,] "" [33,] "" [34,] "" [35,] "" [36,] "" [37,] "" [38,] "" [39,] "" [40,] "" [41,] "" [42,] "Number of all Pairs of Observations" [43,] "Squared Differences between all Pairs of Observations" [44,] "Mean Absolute Differences between all Pairs of Observations" [45,] "Gini Mean Difference" [46,] "Leik Measure of Dispersion" [47,] "Index of Diversity" [48,] "Index of Qualitative Variation" [49,] "Coefficient of Dispersion" [50,] "Observations" [,2] [1,] "http://www.xycoon.com/absolute.htm" [2,] "http://www.xycoon.com/relative.htm" [3,] "http://www.xycoon.com/relative.htm" [4,] "http://www.xycoon.com/unbiased.htm" [5,] "http://www.xycoon.com/biased.htm" [6,] "http://www.xycoon.com/unbiased1.htm" [7,] "http://www.xycoon.com/biased1.htm" [8,] "http://www.xycoon.com/variation.htm" [9,] "http://www.xycoon.com/variation.htm" [10,] "http://www.xycoon.com/mse.htm" [11,] "http://www.xycoon.com/mse.htm" [12,] "http://www.xycoon.com/mean2.htm" [13,] "http://www.xycoon.com/median1.htm" [14,] "http://www.xycoon.com/mean3.htm" [15,] "http://www.xycoon.com/median2.htm" [16,] "http://www.xycoon.com/mean1.htm" [17,] "http://www.xycoon.com/median.htm" [18,] "Interquartile Difference (Weighted Average at Xnp)" [19,] "Interquartile Difference (Weighted Average at X(n+1)p)" [20,] "Interquartile Difference (Empirical Distribution Function)" [21,] "Interquartile Difference (Empirical Distribution Function - Averaging)" [22,] "Interquartile Difference (Empirical Distribution Function - Interpolation)" [23,] "Interquartile Difference (Closest Observation)" [24,] "Interquartile Difference (True Basic - Statistics Graphics Toolkit)" [25,] "Interquartile Difference (MS Excel (old versions))" [26,] "Semi Interquartile Difference (Weighted Average at Xnp)" [27,] "Semi Interquartile Difference (Weighted Average at X(n+1)p)" [28,] "Semi Interquartile Difference (Empirical Distribution Function)" [29,] "Semi Interquartile Difference (Empirical Distribution Function - Averaging)" [30,] "Semi Interquartile Difference (Empirical Distribution Function - Interpolation)" [31,] "Semi Interquartile Difference (Closest Observation)" [32,] "Semi Interquartile Difference (True Basic - Statistics Graphics Toolkit)" [33,] "Semi Interquartile Difference (MS Excel (old versions))" [34,] "Coefficient of Quartile Variation (Weighted Average at Xnp)" [35,] "Coefficient of Quartile Variation (Weighted Average at X(n+1)p)" [36,] "Coefficient of Quartile Variation (Empirical Distribution Function)" [37,] "Coefficient of Quartile Variation (Empirical Distribution Function - Averaging)" [38,] "Coefficient of Quartile Variation (Empirical Distribution Function - Interpolation)" [39,] "Coefficient of Quartile Variation (Closest Observation)" [40,] "Coefficient of Quartile Variation (True Basic - Statistics Graphics Toolkit)" [41,] "Coefficient of Quartile Variation (MS Excel (old versions))" [42,] "http://www.xycoon.com/pair_numbers.htm" [43,] "http://www.xycoon.com/squared_differences.htm" [44,] "http://www.xycoon.com/mean_abs_differences.htm" [45,] "http://www.xycoon.com/gini_mean_difference.htm" [46,] "http://www.xycoon.com/leiks_d.htm" [47,] "http://www.xycoon.com/diversity.htm" [48,] "http://www.xycoon.com/qualitative_variation.htm" [49,] "http://www.xycoon.com/dispersion.htm" [50,] "" [,3] [1,] "14.5" [2,] "4.29975196730901" [3,] "4.33603743733968" [4,] "11.3723232768362" [5,] "11.1827845555556" [6,] "3.37228754361726" [7,] "3.34406706804088" [8,] "0.036917062763332" [9,] "0.0366081279365744" [10,] "8355.57899" [11,] "11.1827845555556" [12,] "2.55382222222222" [13,] "2.518" [14,] "1.45266666666667" [15,] "2.095" [16,] "11.1827845555556" [17,] "11.6083233333333" [18,] "3.8" [19,] "3.59750000000001" [20,] "3.8" [21,] "3.38500000000001" [22,] "3.1725" [23,] "3.8" [24,] "3.17250000000001" [25,] "3.81" [26,] "1.9" [27,] "1.79875000000001" [28,] "1.9" [29,] "1.6925" [30,] "1.58625" [31,] "1.9" [32,] "1.58625000000001" [33,] "1.905" [34,] "0.0209967952259918" [35,] "0.0198540266835912" [36,] "0.0209967952259918" [37,] "0.0186599046332792" [38,] "0.0174685112533554" [39,] "0.0209967952259918" [40,] "0.0174685112533554" [41,] "0.0210508867893254" [42,] "1770" [43,] "22.7446465536724" [44,] "3.64881355932204" [45,] "3.64881355932204" [46,] "0.508839049568925" [47,] "0.98331099741615" [48,] "0.999977285507949" [49,] "0.0277589371980676" [50,] "60" > 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/1fgf31387742233.tab") > > > > proc.time() user system elapsed 0.952 0.431 1.327