Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data:
3560 2900 3380 3560 3100 2800 2780 4380 3480 3220 3840 4580 3660 5040 4320 4240 3160 4420 3280 5040 5580 4920 5200 4140 4360 4360 4480 4140 2620 4240 3920 4180 8140 8060 6780 5180 4820 3600 6480 5500 4080 3800 4560 7140 4740 5820 6800 4720 6220 3420 7600 2540 4220 5420 2040 4480 5340 4720 4220 3680 4940 2460 3900 5160 2500 3560 3340 6380 2900 7940 4640 3000 5500 4000 3340 2220 2060 3520 2560 2100 3720 4600 2800 2720 2920 2940 2900 2140 2020 3040 3900 2020 3280 3040 3060 2360 3120 3900 1960 2760 1760 2520 2160 2980 2800 3700 3660 2920
Chart options
Title:
Y-axis minimum
Y-axis maximum
R Code
geomean <- function(x) { return(exp(mean(log(x)))) } harmean <- function(x) { return(1/mean(1/x)) } quamean <- function(x) { return(sqrt(mean(x*x))) } winmean <- function(x) { x <-sort(x[!is.na(x)]) n<-length(x) denom <- 3 nodenom <- n/denom if (nodenom>40) denom <- n/40 sqrtn = sqrt(n) roundnodenom = floor(nodenom) win <- array(NA,dim=c(roundnodenom,2)) for (j in 1:roundnodenom) { win[j,1] <- (j*x[j+1]+sum(x[(j+1):(n-j)])+j*x[n-j])/n win[j,2] <- sd(c(rep(x[j+1],j),x[(j+1):(n-j)],rep(x[n-j],j)))/sqrtn } return(win) } trimean <- function(x) { x <-sort(x[!is.na(x)]) n<-length(x) denom <- 3 nodenom <- n/denom if (nodenom>40) denom <- n/40 sqrtn = sqrt(n) roundnodenom = floor(nodenom) tri <- array(NA,dim=c(roundnodenom,2)) for (j in 1:roundnodenom) { tri[j,1] <- mean(x,trim=j/n) tri[j,2] <- sd(x[(j+1):(n-j)]) / sqrt(n-j*2) } return(tri) } midrange <- function(x) { return((max(x)+min(x))/2) } 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] } } } } midmean <- 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) } midm <- 0 myn <- 0 roundno4 <- round(n/4) round3no4 <- round(3*n/4) for (i in 1:n) { if ((x[i]>=qvalue1) & (x[i]<=qvalue3)){ midm = midm + x[i] myn = myn + 1 } } midm = midm / myn return(midm) } (arm <- mean(x)) sqrtn <- sqrt(length(x)) (armse <- sd(x) / sqrtn) (armose <- arm / armse) (geo <- geomean(x)) (har <- harmean(x)) (qua <- quamean(x)) (win <- winmean(x)) (tri <- trimean(x)) (midr <- midrange(x)) midm <- array(NA,dim=8) for (j in 1:8) midm[j] <- midmean(x,j) midm bitmap(file='test1.png') lb <- win[,1] - 2*win[,2] ub <- win[,1] + 2*win[,2] if ((ylimmin == '') | (ylimmax == '')) plot(win[,1],type='b',main=main, xlab='j', pch=19, ylab='Winsorized Mean(j/n)', ylim=c(min(lb),max(ub))) else plot(win[,1],type='l',main=main, xlab='j', pch=19, ylab='Winsorized Mean(j/n)', ylim=c(ylimmin,ylimmax)) lines(ub,lty=3) lines(lb,lty=3) grid() dev.off() bitmap(file='test2.png') lb <- tri[,1] - 2*tri[,2] ub <- tri[,1] + 2*tri[,2] if ((ylimmin == '') | (ylimmax == '')) plot(tri[,1],type='b',main=main, xlab='j', pch=19, ylab='Trimmed Mean(j/n)', ylim=c(min(lb),max(ub))) else plot(tri[,1],type='l',main=main, xlab='j', pch=19, ylab='Trimmed Mean(j/n)', ylim=c(ylimmin,ylimmax)) lines(ub,lty=3) lines(lb,lty=3) grid() dev.off() load(file='createtable') a<-table.start() a<-table.row.start(a) a<-table.element(a,'Central Tendency - Ungrouped Data',4,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Measure',header=TRUE) a<-table.element(a,'Value',header=TRUE) a<-table.element(a,'S.E.',header=TRUE) a<-table.element(a,'Value/S.E.',header=TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Arithmetic Mean',header=TRUE) a<-table.element(a,signif(arm,6)) a<-table.element(a, signif(armse,6)) a<-table.element(a,signif(armose,6)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'Geometric Mean',header=TRUE) a<-table.element(a,signif(geo,6)) a<-table.element(a,'') a<-table.element(a,'') a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'Harmonic Mean',header=TRUE) a<-table.element(a,signif(har,6)) a<-table.element(a,'') a<-table.element(a,'') a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'Quadratic Mean',header=TRUE) a<-table.element(a,signif(qua,6)) a<-table.element(a,'') a<-table.element(a,'') a<-table.row.end(a) for (j in 1:length(win[,1])) { a<-table.row.start(a) mylabel <- paste('Winsorized Mean (',j) mylabel <- paste(mylabel,'/') mylabel <- paste(mylabel,length(win[,1])) mylabel <- paste(mylabel,')') a<-table.element(a, mylabel,header=TRUE) a<-table.element(a,signif(win[j,1],6)) a<-table.element(a,signif(win[j,2],6)) a<-table.element(a,signif(win[j,1]/win[j,2],6)) a<-table.row.end(a) } for (j in 1:length(tri[,1])) { a<-table.row.start(a) mylabel <- paste('Trimmed Mean (',j) mylabel <- paste(mylabel,'/') mylabel <- paste(mylabel,length(tri[,1])) mylabel <- paste(mylabel,')') a<-table.element(a, mylabel,header=TRUE) a<-table.element(a,signif(tri[j,1],6)) a<-table.element(a,signif(tri[j,2],6)) a<-table.element(a,signif(tri[j,1]/tri[j,2],6)) a<-table.row.end(a) } a<-table.row.start(a) a<-table.element(a, 'Median',header=TRUE) a<-table.element(a,signif(median(x),6)) a<-table.element(a,'') a<-table.element(a,'') a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'Midrange',header=TRUE) a<-table.element(a,signif(midr,6)) a<-table.element(a,'') a<-table.element(a,'') a<-table.row.end(a) a<-table.row.start(a) mymid <- 'Midmean' mylabel <- paste(mymid,'Weighted Average at Xnp',sep=' - ') a<-table.element(a,mylabel,header=TRUE) a<-table.element(a,signif(midm[1],6)) a<-table.element(a,'') a<-table.element(a,'') a<-table.row.end(a) a<-table.row.start(a) mymid <- 'Midmean' mylabel <- paste(mymid,'Weighted Average at X(n+1)p',sep=' - ') a<-table.element(a,mylabel,header=TRUE) a<-table.element(a,signif(midm[2],6)) a<-table.element(a,'') a<-table.element(a,'') a<-table.row.end(a) a<-table.row.start(a) mymid <- 'Midmean' mylabel <- paste(mymid,'Empirical Distribution Function',sep=' - ') a<-table.element(a,mylabel,header=TRUE) a<-table.element(a,signif(midm[3],6)) a<-table.element(a,'') a<-table.element(a,'') a<-table.row.end(a) a<-table.row.start(a) mymid <- 'Midmean' mylabel <- paste(mymid,'Empirical Distribution Function - Averaging',sep=' - ') a<-table.element(a,mylabel,header=TRUE) a<-table.element(a,signif(midm[4],6)) a<-table.element(a,'') a<-table.element(a,'') a<-table.row.end(a) a<-table.row.start(a) mymid <- 'Midmean' mylabel <- paste(mymid,'Empirical Distribution Function - Interpolation',sep=' - ') a<-table.element(a,mylabel,header=TRUE) a<-table.element(a,signif(midm[5],6)) a<-table.element(a,'') a<-table.element(a,'') a<-table.row.end(a) a<-table.row.start(a) mymid <- 'Midmean' mylabel <- paste(mymid,'Closest Observation',sep=' - ') a<-table.element(a,mylabel,header=TRUE) a<-table.element(a,signif(midm[6],6)) a<-table.element(a,'') a<-table.element(a,'') a<-table.row.end(a) a<-table.row.start(a) mymid <- 'Midmean' mylabel <- paste(mymid,'True Basic - Statistics Graphics Toolkit',sep=' - ') a<-table.element(a,mylabel,header=TRUE) a<-table.element(a,signif(midm[7],6)) a<-table.element(a,'') a<-table.element(a,'') a<-table.row.end(a) a<-table.row.start(a) mymid <- 'Midmean' mylabel <- paste(mymid,'MS Excel (old versions)',sep=' - ') a<-table.element(a,mylabel,header=TRUE) a<-table.element(a,signif(midm[8],6)) a<-table.element(a,'') a<-table.element(a,'') a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Number of observations',header=TRUE) a<-table.element(a,signif(length(x),6)) a<-table.element(a,'') a<-table.element(a,'') 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