R version 2.15.2 (2012-10-26) -- "Trick or Treat"
Copyright (C) 2012 The R Foundation for Statistical Computing
ISBN 3-900051-07-0
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(39.28,39.36,39.55,39.64,39.8,39.79,39.79,39.86,39.91,40,40.01,40.01,40.01,39.96,40,39.76,39.68,39.7,39.7,39.73,39.64,39.56,39.67,39.66,39.66,40.05,39.99,40.06,40.08,40.1,40.1,40.12,40.07,40.24,40.58,40.72,40.72,40.89,40.9,41.04,41.27,41.29,41.29,41.33,41.34,41.37,41.33,41.37,41.37,41.42,41.61,41.58,41.75,41.75,41.75,41.85,41.84,41.97,42.01,42.04,42.04,42.06,41.93,41.93,41.99,42.03,42.03,42.12,42.22,42.21,42.23,42.22)
> #'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,] "2.95"
[2,] "3.04664013339419"
[3,] "3.06802032645953"
[4,] "0.937565708137715"
[5,] "0.924543962191358"
[6,] "0.968279767493732"
[7,] "0.961532091087634"
[8,] "0.0237458465493212"
[9,] "0.0235803682507109"
[10,] "1663.67241527778"
[11,] "0.924543962191358"
[12,] "0.893939043209877"
[13,] "0.892361111111111"
[14,] "0.973194444444445"
[15,] "0.925000000000001"
[16,] "0.924543962191358"
[17,] "0.927770833333334"
[18,] "1.89"
[19,] "1.8775"
[20,] "1.89"
[21,] "1.865"
[22,] "1.85250000000001"
[23,] "1.89"
[24,] "1.85250000000001"
[25,] "1.89"
[26,] "0.945"
[27,] "0.938749999999999"
[28,] "0.945"
[29,] "0.932500000000001"
[30,] "0.926250000000003"
[31,] "0.945"
[32,] "0.926250000000003"
[33,] "0.945"
[34,] "0.0231589266021321"
[35,] "0.0230022359030904"
[36,] "0.0231589266021321"
[37,] "0.0228455931891958"
[38,] "0.0226889984384091"
[39,] "0.0231589266021321"
[40,] "0.0226889984384091"
[41,] "0.0231589266021321"
[42,] "2556"
[43,] "1.87513141627543"
[44,] "1.10244522691706"
[45,] "1.10244522691707"
[46,] "0.507500010913834"
[47,] "0.986103388419905"
[48,] "0.999992168538495"
[49,] "0.0219533163853113"
[50,] "72"
> 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/1cogl1354985054.tab")
>
>
>
> proc.time()
user system elapsed
0.358 0.099 0.432