FreeStatistics.org

Free Statistics

of Irreproducible Research!

Description of Statistical Computation

Author's title

Author*The author of this computation has been verified*
R Software Modulerwasp_bootstrapplot.wasp
Title produced by softwareBlocked Bootstrap Plot - Central Tendency
Date of computationMon, 03 Nov 2008 11:33:24 -0700
Cite this page as followsStatistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?v=date/2008/Nov/03/t1225737245of1zr6t7zcuij5c.htm/, Retrieved Mon, 20 May 2024 09:47:57 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=20946, Retrieved Mon, 20 May 2024 09:47:57 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact166

Tree of Dependent Computations

Family? (F = Feedback message, R = changed R code, M = changed R Module, P = changed Parameters, D = changed Data)
F     [Blocked Bootstrap Plot - Central Tendency] [workshop 3] [2007-10-26 12:36:24] [e9ffc5de6f8a7be62f22b142b5b6b1a8]
F    D    [Blocked Bootstrap Plot - Central Tendency] [Task 1 Q4] [2008-11-03 18:33:24] [1fa440a634ec541bd583650ead0404df] [Current]
Feedback Forum
2008-11-06 19:04:27 [Peter Melgers] [reply] 
Bij bootstrapping gaan we het gemiddelde 500x opnieuw berekenen, maar telkens wordt er 1 random observatie uitgenomen, in onze datareeks is het dus zeker mogelijk en het geval geweest dat 2 keer dezelfde observatie eruit genomen is. Deze observatie wordt natuurlijk daarna wel teruggelegd.

Het resultaat hiervan kan je zien in de grafieken: Simultation of Mean, Simultation of Median en Simultation of Midrange.

In de grafiek simultation of mean kunnen we zien dat er een enorme spreiding is en dat we dus met een normaalverdeling te maken hebben. (Het Density Plot van het gemiddelde geeft hierover bevestiging).

In de grafiek simultation of median kunnen we zien dat er bepaalde patronen zijn. In de grafiek simultation of midrange komen deze patronen nog duidelijker voor (veel observaties op een lijn).

Hoe groter de spreiding, hoe minder nauwkeurig het resultaat. Aan het Density Plot en de Bootstrap Simulation – Central Tendency kunnen we duidelijk zien dat de midrange de kleinste spreiding heeft en dus het meest betrouwbaar is. Het probleem hierbij is wel dat indien we te maken hebben met een outlier, deze serieus zal afwijken. (En outliers zijn eigen aan de midrange).

Daarom zal men meestal het rekenkundig gemiddelde nemen en hieruit de outliers filteren.

Conclusie: zowel midrange als rekenkundig gemiddelde zijn goed.
2008-11-11 09:57:39 [Jens Peeters] [reply] 
Midrange geeft een zeer nauwkeurig resultaat aangezien het betrouwbaarheidsinterval zeer klein fluctueert maar er is wel het gevaar van de outliers. Het rekenkundige gemiddelde kan je ook gebruiken maar daar fluctueert het betrouwbaarheidsinterval harder wat een onnauwkeuriger resultaat oplevert maar het gevaar van outliers is kleiner.
2008-11-11 20:14:35 [Koen Van den Heuvel] [reply] 
Als het resultaat bij de Blocked Bootstrap methode bekeken wordt kunnen we zowel uit de tabel, het density plot en de bootstrap simulation afleiden dat de midrange de beste factor zou zijn om een schatting te maken van de kledingproductie aangezien daar de kleinste variante is.
In de tabel lezen we af dat de variatie van tussen de onderste en bovenste 25% het kleinste is bij de midrange, de spreiding van het density plot is hier duidelijk kleiner en op de bootstrapsimulation-grafiek is het blok ook duidelijk minder hoog dan bij de rest.
Men zal wel een afweging moet maken: neemt men de midrange als estimator voor een nauwkeuriger resultaat dan zijn er soms outliers, die voor een totaal verkeerd resultaat kunnen zorgen, of neemt men toch het gemiddelde voor een iets minder nauwkeurig maar betrouwbaarder resultaat.

Post a new message

Dataset

Dataseries X:
Download CSV
Histogram
Boxplots 
109.20
88.60
94.30
98.30
86.40
80.60
104.10
108.20
93.40
71.90
94.10
94.90
96.40
91.10
84.40
86.40
88.00
75.10
109.70
103.00
82.10
68.00
96.40
94.30
90.00
88.00
76.10
82.50
81.40
66.50
97.20
94.10
80.70
70.50
87.80
89.50
99.60
84.20
75.10
92.00
80.80
73.10
99.80
90.00
83.10
72.40
78.80
87.30
91.00
80.10
73.60
86.40
74.50
71.20
92.40
81.50
85.30
69.90
84.20
90.70
100.30

Tables (Output of Computation)





Summary of computational transaction
Raw Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time3 seconds
R Server'George Udny Yule' @ 72.249.76.132

\begin{tabular}{lllllllll}
\hline
Summary of computational transaction \tabularnewline
Raw Input & view raw input (R code)  \tabularnewline
Raw Output & view raw output of R engine  \tabularnewline
Computing time & 3 seconds \tabularnewline
R Server & 'George Udny Yule' @ 72.249.76.132 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=20946&T=0

[TABLE]
[ROW][C]Summary of computational transaction[/C][/ROW]
[ROW][C]Raw Input[/C][C]view raw input (R code) [/C][/ROW]
[ROW][C]Raw Output[/C][C]view raw output of R engine [/C][/ROW]
[ROW][C]Computing time[/C][C]3 seconds[/C][/ROW]
[ROW][C]R Server[/C][C]'George Udny Yule' @ 72.249.76.132[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=20946&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=20946&T=0

As an alternative you can also use a QR Code:  
QR Code


The GUIDs for individual cells are displayed in the table below:

Summary of computational transaction
Raw Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time3 seconds
R Server'George Udny Yule' @ 72.249.76.132






Estimation Results of Blocked Bootstrap
statisticQ1EstimateQ3S.D.IQR
mean85.707786885245986.893442622950888.04057377049181.673859928116842.33278688524591
median86.487.3881.896531545692721.59999999999999
midrange87.8588.188.851.198201938644541

\begin{tabular}{lllllllll}
\hline
Estimation Results of Blocked Bootstrap \tabularnewline
statistic & Q1 & Estimate & Q3 & S.D. & IQR \tabularnewline
mean & 85.7077868852459 & 86.8934426229508 & 88.0405737704918 & 1.67385992811684 & 2.33278688524591 \tabularnewline
median & 86.4 & 87.3 & 88 & 1.89653154569272 & 1.59999999999999 \tabularnewline
midrange & 87.85 & 88.1 & 88.85 & 1.19820193864454 & 1 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=20946&T=1

[TABLE]
[ROW][C]Estimation Results of Blocked Bootstrap[/C][/ROW]
[ROW][C]statistic[/C][C]Q1[/C][C]Estimate[/C][C]Q3[/C][C]S.D.[/C][C]IQR[/C][/ROW]
[ROW][C]mean[/C][C]85.7077868852459[/C][C]86.8934426229508[/C][C]88.0405737704918[/C][C]1.67385992811684[/C][C]2.33278688524591[/C][/ROW]
[ROW][C]median[/C][C]86.4[/C][C]87.3[/C][C]88[/C][C]1.89653154569272[/C][C]1.59999999999999[/C][/ROW]
[ROW][C]midrange[/C][C]87.85[/C][C]88.1[/C][C]88.85[/C][C]1.19820193864454[/C][C]1[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=20946&T=1

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=20946&T=1

As an alternative you can also use a QR Code:  
QR Code


The GUIDs for individual cells are displayed in the table below:

Estimation Results of Blocked Bootstrap
statisticQ1EstimateQ3S.D.IQR
mean85.707786885245986.893442622950888.04057377049181.673859928116842.33278688524591
median86.487.3881.896531545692721.59999999999999
midrange87.8588.188.851.198201938644541


Figures (Output of Computation)

Input Parameters & R Code

Parameters (Session):
par1 = 500 ; par2 = 12 ;
Parameters (R input):
par1 = 500 ; par2 = 12 ;
R code (references can be found in the software module):
par1 <- as.numeric(par1)
par2 <- as.numeric(par2)
if (par1 < 10) par1 = 10
if (par1 > 5000) par1 = 5000
if (par2 < 3) par2 = 3
if (par2 > length(x)) par2 = length(x)
library(lattice)
library(boot)
boot.stat <- function(s)
{
s.mean <- mean(s)
s.median <- median(s)
s.midrange <- (max(s) + min(s)) / 2
c(s.mean, s.median, s.midrange)
}
(r <- tsboot(x, boot.stat, R=par1, l=12, sim='fixed'))
bitmap(file='plot1.png')
plot(r$t[,1],type='p',ylab='simulated values',main='Simulation of Mean')
grid()
dev.off()
bitmap(file='plot2.png')
plot(r$t[,2],type='p',ylab='simulated values',main='Simulation of Median')
grid()
dev.off()
bitmap(file='plot3.png')
plot(r$t[,3],type='p',ylab='simulated values',main='Simulation of Midrange')
grid()
dev.off()
bitmap(file='plot4.png')
densityplot(~r$t[,1],col='black',main='Density Plot',xlab='mean')
dev.off()
bitmap(file='plot5.png')
densityplot(~r$t[,2],col='black',main='Density Plot',xlab='median')
dev.off()
bitmap(file='plot6.png')
densityplot(~r$t[,3],col='black',main='Density Plot',xlab='midrange')
dev.off()
z <- data.frame(cbind(r$t[,1],r$t[,2],r$t[,3]))
colnames(z) <- list('mean','median','midrange')
bitmap(file='plot7.png')
boxplot(z,notch=TRUE,ylab='simulated values',main='Bootstrap Simulation - Central Tendency')
grid()
dev.off()
load(file='createtable')
a<-table.start()
a<-table.row.start(a)
a<-table.element(a,'Estimation Results of Blocked Bootstrap',6,TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'statistic',header=TRUE)
a<-table.element(a,'Q1',header=TRUE)
a<-table.element(a,'Estimate',header=TRUE)
a<-table.element(a,'Q3',header=TRUE)
a<-table.element(a,'S.D.',header=TRUE)
a<-table.element(a,'IQR',header=TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'mean',header=TRUE)
q1 <- quantile(r$t[,1],0.25)[[1]]
q3 <- quantile(r$t[,1],0.75)[[1]]
a<-table.element(a,q1)
a<-table.element(a,r$t0[1])
a<-table.element(a,q3)
a<-table.element(a,sqrt(var(r$t[,1])))
a<-table.element(a,q3-q1)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'median',header=TRUE)
q1 <- quantile(r$t[,2],0.25)[[1]]
q3 <- quantile(r$t[,2],0.75)[[1]]
a<-table.element(a,q1)
a<-table.element(a,r$t0[2])
a<-table.element(a,q3)
a<-table.element(a,sqrt(var(r$t[,2])))
a<-table.element(a,q3-q1)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'midrange',header=TRUE)
q1 <- quantile(r$t[,3],0.25)[[1]]
q3 <- quantile(r$t[,3],0.75)[[1]]
a<-table.element(a,q1)
a<-table.element(a,r$t0[3])
a<-table.element(a,q3)
a<-table.element(a,sqrt(var(r$t[,3])))
a<-table.element(a,q3-q1)
a<-table.row.end(a)
a<-table.end(a)
table.save(a,file='mytable.tab')