Home » date » 2009 » Oct » 20 »

question 3

*The author of this computation has been verified*

R Software Module: rwasp_centraltendency.wasp (opens new window with default values)

Title produced by software: Central Tendency

Date of computation: Tue, 20 Oct 2009 13:16:01 -0600

Cite this page as follows:

Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL http://www.freestatistics.org/blog/date/2009/Oct/20/t1256066360bxjm4h35w5dzhno.htm/, Retrieved Thu, 23 May 2013 01:49:12 +0000

Original text written by user:

IsPrivate?

No (this computation is public)

User-defined keywords:

System-generated keywords (parent):

t1255509090iv1ijspnf5sojst (pk = 46388)

Estimated Impact

Dataseries X:

» Textfile « » CSV « » Stem and Leaf « » Histogram « » Kernel Density « » Harrell-Davis Quantiles « » Central Tendency « » Variability «

Output produced by software:

Summary of computational transaction
Raw Input	view raw input (R code)
Raw Output	view raw output of R engine
Computing time	2 seconds
R Server	'Sir Ronald Aylmer Fisher' @ 193.190.124.24

Central Tendency - Ungrouped Data
Measure	Value	S.E.	Value/S.E.
Arithmetic Mean	13.3619100506557	0.189472464491874	70.5216459103419
Geometric Mean	13.2842843476132
Harmonic Mean	13.2096831567914
Quadratic Mean	13.4422702357099
Winsorized Mean ( 1 / 20 )	13.3509164313115	0.185658629994951	71.9111006672546
Winsorized Mean ( 2 / 20 )	13.3503575588525	0.179243440078072	74.4817079667602
Winsorized Mean ( 3 / 20 )	13.3408343863934	0.171933017128160	77.5932081529699
Winsorized Mean ( 4 / 20 )	13.3287311398361	0.168599641911146	79.0555127445674
Winsorized Mean ( 5 / 20 )	13.3292363332787	0.168083255398922	79.3013932389853
Winsorized Mean ( 6 / 20 )	13.3315379106557	0.167731518919709	79.4814117019795
Winsorized Mean ( 7 / 20 )	13.3195658370492	0.163270494755959	81.5797481165107
Winsorized Mean ( 8 / 20 )	13.2954572901639	0.158203333787845	84.0403104778656
Winsorized Mean ( 9 / 20 )	13.2919904842623	0.157416353387384	84.4384347511355
Winsorized Mean ( 10 / 20 )	13.3004796990164	0.151257721294727	87.9325669140574
Winsorized Mean ( 11 / 20 )	13.2706453709836	0.145446636190479	91.2406482443788
Winsorized Mean ( 12 / 20 )	13.2811700870492	0.143656977457149	92.450574431797
Winsorized Mean ( 13 / 20 )	13.2643184065574	0.139554364657988	95.0476786524363
Winsorized Mean ( 14 / 20 )	13.2307857350820	0.124688243414454	106.110932135790
Winsorized Mean ( 15 / 20 )	13.2213532162295	0.121963097035594	108.404538238079
Winsorized Mean ( 16 / 20 )	13.1608514378689	0.107825497696156	122.056950527185
Winsorized Mean ( 17 / 20 )	13.0616679560656	0.0905246476595049	144.288525763670
Winsorized Mean ( 18 / 20 )	13.0633643675410	0.089676964573046	145.671348598115
Winsorized Mean ( 19 / 20 )	13.0171495181967	0.0824375878701716	157.903085892045
Winsorized Mean ( 20 / 20 )	13.0385978722951	0.0788770440185808	165.302820795663
Trimmed Mean ( 1 / 20 )	13.3338115389831	0.179526595257270	74.2720682686323
Trimmed Mean ( 2 / 20 )	13.3155063033333	0.171958704485497	77.4343255444588
Trimmed Mean ( 3 / 20 )	13.296179698	0.166896779142563	79.6670838485293
Trimmed Mean ( 4 / 20 )	13.2790480250943	0.164064267732913	80.938087303153
Trimmed Mean ( 5 / 20 )	13.2641917996078	0.161695443470621	82.0319454581161
Trimmed Mean ( 6 / 20 )	13.2479970381633	0.158731227797526	83.4618192146926
Trimmed Mean ( 7 / 20 )	13.2299261402128	0.154920491547073	85.3981678478785
Trimmed Mean ( 8 / 20 )	13.2125673417778	0.151223863067106	87.3709153687914
Trimmed Mean ( 9 / 20 )	13.1978688334884	0.147755088750139	89.3226009684619
Trimmed Mean ( 10 / 20 )	13.1823094278049	0.143266645714191	92.012410579521
Trimmed Mean ( 11 / 20 )	13.1638263853846	0.138810049849600	94.8333812980223
Trimmed Mean ( 12 / 20 )	13.1478166602703	0.134342913254039	97.8675863267014
Trimmed Mean ( 13 / 20 )	13.1284486625714	0.128486270699975	102.177832627949
Trimmed Mean ( 14 / 20 )	13.1091291884848	0.121443894326091	107.943913205594
Trimmed Mean ( 15 / 20 )	13.0920299964516	0.116161674491083	112.705245114701
Trimmed Mean ( 16 / 20 )	13.0738950162069	0.109175913722866	119.750726789371
Trimmed Mean ( 17 / 20 )	13.0616164474074	0.103987602590750	125.607438983013
Trimmed Mean ( 18 / 20 )	13.0616090544	0.102251970824802	127.739435719823
Trimmed Mean ( 19 / 20 )	13.0613504213043	0.0992719021221375	131.571473318145
Trimmed Mean ( 20 / 20 )	13.0681079528571	0.0967654187912412	135.04936077474
Median	13.12345679
Midrange	14.190816145
Midmean - Weighted Average at Xnp	13.0443730253333
Midmean - Weighted Average at X(n+1)p	13.0920299964516
Midmean - Empirical Distribution Function	13.0920299964516
Midmean - Empirical Distribution Function - Averaging	13.0920299964516
Midmean - Empirical Distribution Function - Interpolation	13.0920299964516
Midmean - Closest Observation	13.0633728090625
Midmean - True Basic - Statistics Graphics Toolkit	13.0920299964516
Midmean - MS Excel (old versions)	13.0920299964516
Number of observations	61

Charts produced by software:

http://www.freestatistics.org/blog/date/2009/Oct/20/t1256066360bxjm4h35w5dzhno/1kalb1256066157.png (opens in new window)

http://www.freestatistics.org/blog/date/2009/Oct/20/t1256066360bxjm4h35w5dzhno/1kalb1256066157.ps (opens in new window)

Click here to open pdf file.

http://www.freestatistics.org/blog/date/2009/Oct/20/t1256066360bxjm4h35w5dzhno/2d6eu1256066157.png (opens in new window)

http://www.freestatistics.org/blog/date/2009/Oct/20/t1256066360bxjm4h35w5dzhno/2d6eu1256066157.ps (opens in new window)

Click here to open pdf file.

Parameters (Session):

par1 = werkloosheid laatste 5 jaar ; par2 = belgostat ; par3 = werkloosheid laatste 5 jaar ;

Parameters (R input):

par1 = werkloosheid laatste 5 jaar ; par2 = belgostat ; par3 = werkloosheid laatste 5 jaar ;

R code (references can be found in the software module):

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,hyperlink('http://www.xycoon.com/arithmetic_mean.htm', 'Arithmetic Mean', 'click to view the definition of the Arithmetic Mean'),header=TRUE)
a<-table.element(a,arm)
a<-table.element(a,hyperlink('http://www.xycoon.com/arithmetic_mean_standard_error.htm', armse, 'click to view the definition of the Standard Error of the Arithmetic Mean'))
a<-table.element(a,armose)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,hyperlink('http://www.xycoon.com/geometric_mean.htm', 'Geometric Mean', 'click to view the definition of the Geometric Mean'),header=TRUE)
a<-table.element(a,geo)
a<-table.element(a,'')
a<-table.element(a,'')
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,hyperlink('http://www.xycoon.com/harmonic_mean.htm', 'Harmonic Mean', 'click to view the definition of the Harmonic Mean'),header=TRUE)
a<-table.element(a,har)
a<-table.element(a,'')
a<-table.element(a,'')
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,hyperlink('http://www.xycoon.com/quadratic_mean.htm', 'Quadratic Mean', 'click to view the definition of the Quadratic Mean'),header=TRUE)
a<-table.element(a,qua)
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,hyperlink('http://www.xycoon.com/winsorized_mean.htm', mylabel, 'click to view the definition of the Winsorized Mean'),header=TRUE)
a<-table.element(a,win[j,1])
a<-table.element(a,win[j,2])
a<-table.element(a,win[j,1]/win[j,2])
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,hyperlink('http://www.xycoon.com/arithmetic_mean.htm', mylabel, 'click to view the definition of the Trimmed Mean'),header=TRUE)
a<-table.element(a,tri[j,1])
a<-table.element(a,tri[j,2])
a<-table.element(a,tri[j,1]/tri[j,2])
a<-table.row.end(a)
}
a<-table.row.start(a)
a<-table.element(a,hyperlink('http://www.xycoon.com/median_1.htm', 'Median', 'click to view the definition of the Median'),header=TRUE)
a<-table.element(a,median(x))
a<-table.element(a,'')
a<-table.element(a,'')
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,hyperlink('http://www.xycoon.com/midrange.htm', 'Midrange', 'click to view the definition of the Midrange'),header=TRUE)
a<-table.element(a,midr)
a<-table.element(a,'')
a<-table.element(a,'')
a<-table.row.end(a)
a<-table.row.start(a)
mymid <- hyperlink('http://www.xycoon.com/midmean.htm', 'Midmean', 'click to view the definition of the Midmean')
mylabel <- paste(mymid,hyperlink('http://www.xycoon.com/method_1.htm','Weighted Average at Xnp',''),sep=' - ')
a<-table.element(a,mylabel,header=TRUE)
a<-table.element(a,midm[1])
a<-table.element(a,'')
a<-table.element(a,'')
a<-table.row.end(a)
a<-table.row.start(a)
mymid <- hyperlink('http://www.xycoon.com/midmean.htm', 'Midmean', 'click to view the definition of the Midmean')
mylabel <- paste(mymid,hyperlink('http://www.xycoon.com/method_2.htm','Weighted Average at X(n+1)p',''),sep=' - ')
a<-table.element(a,mylabel,header=TRUE)
a<-table.element(a,midm[2])
a<-table.element(a,'')
a<-table.element(a,'')
a<-table.row.end(a)
a<-table.row.start(a)
mymid <- hyperlink('http://www.xycoon.com/midmean.htm', 'Midmean', 'click to view the definition of the Midmean')
mylabel <- paste(mymid,hyperlink('http://www.xycoon.com/method_3.htm','Empirical Distribution Function',''),sep=' - ')
a<-table.element(a,mylabel,header=TRUE)
a<-table.element(a,midm[3])
a<-table.element(a,'')
a<-table.element(a,'')
a<-table.row.end(a)
a<-table.row.start(a)
mymid <- hyperlink('http://www.xycoon.com/midmean.htm', 'Midmean', 'click to view the definition of the Midmean')
mylabel <- paste(mymid,hyperlink('http://www.xycoon.com/method_4.htm','Empirical Distribution Function - Averaging',''),sep=' - ')
a<-table.element(a,mylabel,header=TRUE)
a<-table.element(a,midm[4])
a<-table.element(a,'')
a<-table.element(a,'')
a<-table.row.end(a)
a<-table.row.start(a)
mymid <- hyperlink('http://www.xycoon.com/midmean.htm', 'Midmean', 'click to view the definition of the Midmean')
mylabel <- paste(mymid,hyperlink('http://www.xycoon.com/method_5.htm','Empirical Distribution Function - Interpolation',''),sep=' - ')
a<-table.element(a,mylabel,header=TRUE)
a<-table.element(a,midm[5])
a<-table.element(a,'')
a<-table.element(a,'')
a<-table.row.end(a)
a<-table.row.start(a)
mymid <- hyperlink('http://www.xycoon.com/midmean.htm', 'Midmean', 'click to view the definition of the Midmean')
mylabel <- paste(mymid,hyperlink('http://www.xycoon.com/method_6.htm','Closest Observation',''),sep=' - ')
a<-table.element(a,mylabel,header=TRUE)
a<-table.element(a,midm[6])
a<-table.element(a,'')
a<-table.element(a,'')
a<-table.row.end(a)
a<-table.row.start(a)
mymid <- hyperlink('http://www.xycoon.com/midmean.htm', 'Midmean', 'click to view the definition of the Midmean')
mylabel <- paste(mymid,hyperlink('http://www.xycoon.com/method_7.htm','True Basic - Statistics Graphics Toolkit',''),sep=' - ')
a<-table.element(a,mylabel,header=TRUE)
a<-table.element(a,midm[7])
a<-table.element(a,'')
a<-table.element(a,'')
a<-table.row.end(a)
a<-table.row.start(a)
mymid <- hyperlink('http://www.xycoon.com/midmean.htm', 'Midmean', 'click to view the definition of the Midmean')
mylabel <- paste(mymid,hyperlink('http://www.xycoon.com/method_8.htm','MS Excel (old versions)',''),sep=' - ')
a<-table.element(a,mylabel,header=TRUE)
a<-table.element(a,midm[8])
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,length(x))
a<-table.element(a,'')
a<-table.element(a,'')
a<-table.row.end(a)
a<-table.end(a)
table.save(a,file='mytable.tab')