Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data:
70200 67600 71500 57200 74100 72800 78000 80600 89700 78000 74100 92300 78000 58500 68900 52000 72800 59800 79300 71500 75400 84500 83200 98800 71500 59800 66300 48100 68900 53300 75400 71500 63700 91000 81900 93600 70200 65000 58500 48100 63700 57200 78000 75400 65000 87100 80600 104000 83200 50700 50700 50700 59800 59800 80600 74100 66300 83200 76700 110500 87100 50700 53300 44200 61100 70200 88400 87100 70200 81900 72800 104000 79300 63700 57200 42900 63700 76700 89700 84500 62400 89700 70200 107900 89700 65000 59800 40300 63700 61100 92300 92300 70200 91000 67600 105300 89700 66300 50700 35100 68900 66300 87100 100100 74100 83200 62400 107900
Sample Range:
(leave blank to include all observations)
From:
To:
R Code
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) load(file='createtable') mylink1 <- 'Interquartile Difference' mylink2 <- paste(mylink1,'(Weighted Average at Xnp)',sep=' ') res[18,] <- c('', mylink2, qarr[1,1]) mylink2 <- paste(mylink1,'(Weighted Average at X(n+1)p)',sep=' ') res[19,] <- c('', mylink2, qarr[2,1]) mylink2 <- paste(mylink1,'(Empirical Distribution Function)',sep=' ') res[20,] <- c('', mylink2, qarr[3,1]) mylink2 <- paste(mylink1,'(Empirical Distribution Function - Averaging)',sep=' ') res[21,] <- c('', mylink2, qarr[4,1]) mylink2 <- paste(mylink1,'(Empirical Distribution Function - Interpolation)',sep=' ') res[22,] <- c('', mylink2, qarr[5,1]) mylink2 <- paste(mylink1,'(Closest Observation)',sep=' ') res[23,] <- c('', mylink2, qarr[6,1]) mylink2 <- paste(mylink1,'(True Basic - Statistics Graphics Toolkit)',sep=' ') res[24,] <- c('', mylink2, qarr[7,1]) mylink2 <- paste(mylink1,'(MS Excel (old versions))',sep=' ') res[25,] <- c('', mylink2, qarr[8,1]) mylink1 <- 'Semi Interquartile Difference' mylink2 <- paste(mylink1,'(Weighted Average at Xnp)',sep=' ') res[26,] <- c('', mylink2, qarr[1,2]) mylink2 <- paste(mylink1,'(Weighted Average at X(n+1)p)',sep=' ') res[27,] <- c('', mylink2, qarr[2,2]) mylink2 <- paste(mylink1,'(Empirical Distribution Function)',sep=' ') res[28,] <- c('', mylink2, qarr[3,2]) mylink2 <- paste(mylink1,'(Empirical Distribution Function - Averaging)',sep=' ') res[29,] <- c('', mylink2, qarr[4,2]) mylink2 <- paste(mylink1,'(Empirical Distribution Function - Interpolation)',sep=' ') res[30,] <- c('', mylink2, qarr[5,2]) mylink2 <- paste(mylink1,'(Closest Observation)',sep=' ') res[31,] <- c('', mylink2, qarr[6,2]) mylink2 <- paste(mylink1,'(True Basic - Statistics Graphics Toolkit)',sep=' ') res[32,] <- c('', mylink2, qarr[7,2]) mylink2 <- paste(mylink1,'(MS Excel (old versions))',sep=' ') res[33,] <- c('', mylink2, qarr[8,2]) mylink1 <- 'Coefficient of Quartile Variation' mylink2 <- paste(mylink1,'(Weighted Average at Xnp)',sep=' ') res[34,] <- c('', mylink2, qarr[1,3]) mylink2 <- paste(mylink1,'(Weighted Average at X(n+1)p)',sep=' ') res[35,] <- c('', mylink2, qarr[2,3]) mylink2 <- paste(mylink1,'(Empirical Distribution Function)',sep=' ') res[36,] <- c('', mylink2, qarr[3,3]) mylink2 <- paste(mylink1,'(Empirical Distribution Function - Averaging)',sep=' ') res[37,] <- c('', mylink2, qarr[4,3]) mylink2 <- paste(mylink1,'(Empirical Distribution Function - Interpolation)',sep=' ') res[38,] <- c('', mylink2, qarr[5,3]) mylink2 <- paste(mylink1,'(Closest Observation)',sep=' ') res[39,] <- c('', mylink2, qarr[6,3]) mylink2 <- paste(mylink1,'(True Basic - Statistics Graphics Toolkit)',sep=' ') res[40,] <- c('', mylink2, qarr[7,3]) mylink2 <- paste(mylink1,'(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) print(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,res[i,1],header=TRUE) } else { a<-table.element(a,res[i,2],header=TRUE) } a<-table.element(a,signif(as.numeric(res[i,3],6))) a<-table.row.end(a) } a<-table.end(a) table.save(a,file='mytable.tab')
Compute
Summary of computational transaction
Raw Input
view raw input (R code)
Raw Output
view raw output of R engine
Computing time
0 seconds
R Server
Big Analytics Cloud Computing Center
Click here to blog (archive) this computation