R version 3.2.2 (2015-08-14) -- "Fire Safety" Copyright (C) 2015 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-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(83.36,83.61,83.41,83.64,84.06,83.93,84.1,84.37,84.18,84.11,84.56,84.2,84.45,84.28,84.28,84.7,85.04,85.31,85.18,85.02,86.31,86.56,86.4,86.84,87.42,87.28,87.27,87.73,87.32,87.15,87.5,87.43,88.81,89.38,88.83,88.91,89.34,89.56,89.32,89.31,89.45,88.92,89.35,88.89,90.1,90.49,89.96,89.93,90.32,90.24,90.61,91.06,90.81,91.09,91.17,90.87,91.92,92.67,92.03,92.09,92.61,92.19,92.68,92.66,92.77,92.21,92.58,91.9,93.81,94.05,94.51,94.49,94.36,94.72,95.57,95.87,95.93,96.09,95.82,96.06,97.09,97.67,98.53,98.12,98.84,98.98,100.04,99.47,99.84,99.52,99.81,99.55,100.21,101.44,101,101.32,101.84,101.81,101.83,102.18,101.97,101.8,101.69,101.91,102.27,102.73,102.61,102.89) > #'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,] "19.53" [2,] "3.24316124226675" [3,] "3.25828095706127" [4,] "36.2633067757009" [5,] "35.9275354166667" [6,] "6.02190225557514" [7,] "5.99395824281974" [8,] "0.0653353227913363" [9,] "0.0650321410032611" [10,] "8531.08281944444" [11,] "35.9275354166667" [12,] "5.08314814814815" [13,] "5.03101851851852" [14,] "4.89416666666667" [15,] "4.70999999999999" [16,] "35.9275354166667" [17,] "37.1247361111111" [18,] "9.81" [19,] "10.235" [20,] "9.81" [21,] "10.08" [22,] "9.925" [23,] "9.81" [24,] "9.925" [25,] "10.39" [26,] "4.905" [27,] "5.1175" [28,] "4.905" [29,] "5.04" [30,] "4.9625" [31,] "4.905" [32,] "4.9625" [33,] "5.195" [34,] "0.053208222595867" [35,] "0.0553797040283527" [36,] "0.053208222595867" [37,] "0.0545808966861598" [38,] "0.0537809206426617" [39,] "0.053208222595867" [40,] "0.0537809206426617" [41,] "0.0561773452284401" [42,] "5778" [43,] "72.5266135514019" [44,] "6.913314295604" [45,] "6.91331429560404" [46,] "0.505352472182393" [47,] "0.990701581672561" [48,] "0.99996047495922" [49,] "0.055812771321967" [50,] "108" > 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/1c2tg1447856187.tab") > > > > proc.time() user system elapsed 0.223 0.043 0.259