x <- c(98.91,98.15,98.59,98.6,98.7,98.33,98.33,98.6,98.52,99.17,99.49,98.83,98.83,97.39,99.28,98.78,98.75,98.47,98.47,97.82,97.79,97.96,98.21,98.34,98.34,98.49,98.14,98.05,97.77,97.59,97.59,97.67,97.67,97.36,97.31,97.24,97.24,96.89,96.48,96.47,97.13,97.21,97.43,97.98,97.97,98.2,98.67,98.75,98.77,98.72,99.23,99.67,99.76,99.57,99.57,100.21,100.62,101.05,101.42,101.42,101.52,101.87,101.53,101.77,101.76,102.04,102.05,101.9,102.17,102.14,102.09,102.27)
par4 = 'P1 P5 Q1 Q3 P95 P99'
par3 = '5'
par2 = '12'
par1 = '750'
par4 <- 'P1 P5 Q1 Q3 P95 P99'
par3 <- '5'
par2 <- '12'
par1 <- '750'
#'GNU S' R Code compiled by R2WASP v. 1.2.327 (Mon, 05 Oct 2015 17:06:50 +0100)
#Author: root
#To cite this work: Wessa P., (2015), Blocked Bootstrap Plot for Central Tendency (v1.0.5) in Free Statistics Software (v$_version), Office for Research Development and Education, URL http://www.wessa.net/rwasp_bootstrapplot.wasp/
#Source of accompanying publication: Office for Research, Development, and Education
#
par1 <- as.numeric(par1)
par2 <- as.numeric(par2)
par3 <- as.numeric(par3)
if (par1 < 10) par1 = 10
if (par1 > 5000) par1 = 5000
if (par2 < 3) par2 = 3
if (par2 > length(x)) par2 = length(x)
library(modeest)
library(lattice)
library(boot)
boot.stat <- function(s)
{
s.mean <- mean(s)
s.median <- median(s)
s.midrange <- (max(s) + min(s)) / 2
s.mode <- mlv(s,method='mfv')$M
s.kernelmode <- mlv(s, method='kernel')$M
c(s.mean, s.median, s.midrange, s.mode, s.kernelmode)
}
(r <- tsboot(x, boot.stat, R=par1, l=12, sim='fixed'))
postscript(file="/var/wessaorg/rcomp/tmp/19tyg1449071958.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) 
plot(r$t[,1],type='p',ylab='simulated values',main='Simulation of Mean')
grid()
dev.off()
postscript(file="/var/wessaorg/rcomp/tmp/2k1tx1449071958.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) 
plot(r$t[,2],type='p',ylab='simulated values',main='Simulation of Median')
grid()
dev.off()
postscript(file="/var/wessaorg/rcomp/tmp/3bnc21449071958.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) 
plot(r$t[,3],type='p',ylab='simulated values',main='Simulation of Midrange')
grid()
dev.off()
postscript(file="/var/wessaorg/rcomp/tmp/4ow8i1449071958.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) 
plot(r$t[,4],type='p',ylab='simulated values',main='Simulation of Mode')
grid()
dev.off()
postscript(file="/var/wessaorg/rcomp/tmp/5lst21449071958.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) 
plot(r$t[,5],type='p',ylab='simulated values',main='Simulation of Mode of Kernel Density')
grid()
dev.off()
postscript(file="/var/wessaorg/rcomp/tmp/6g1481449071958.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) 
densityplot(~r$t[,1],col='black',main='Density Plot',xlab='mean')
dev.off()
postscript(file="/var/wessaorg/rcomp/tmp/77vh01449071958.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) 
densityplot(~r$t[,2],col='black',main='Density Plot',xlab='median')
dev.off()
postscript(file="/var/wessaorg/rcomp/tmp/859c01449071958.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) 
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],r$t[,4],r$t[,5]) )
colnames(z) <- list('mean','median','midrange','mode','mode.k.dens')
postscript(file="/var/wessaorg/rcomp/tmp/9h1iv1449071958.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) 
boxplot(z,notch=TRUE,ylab='simulated values',main='Bootstrap Simulation - Central Tendency')
grid()
dev.off()
if (par4 == 'P1 P5 Q1 Q3 P95 P99') {
myq.1 <- 0.01
myq.2 <- 0.05
myq.3 <- 0.95
myq.4 <- 0.99
myl.1 <- 'P1'
myl.2 <- 'P5'
myl.3 <- 'P95'
myl.4 <- 'P99'
}
if (par4 == 'P0.5 P2.5 Q1 Q3 P97.5 P99.5') {
myq.1 <- 0.005
myq.2 <- 0.025
myq.3 <- 0.975
myq.4 <- 0.995
myl.1 <- 'P0.5'
myl.2 <- 'P2.5'
myl.3 <- 'P97.5'
myl.4 <- 'P99.5'
}
if (par4 == 'P10 P20 Q1 Q3 P80 P90') {
myq.1 <- 0.10
myq.2 <- 0.20
myq.3 <- 0.80
myq.4 <- 0.90
myl.1 <- 'P10'
myl.2 <- 'P20'
myl.3 <- 'P80'
myl.4 <- 'P90'
}

#Note: the /var/wessaorg/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab
load(file="/var/wessaorg/rcomp/createtable")

a<-table.start()
a<-table.row.start(a)
a<-table.element(a,'Estimation Results of Blocked Bootstrap',10,TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'statistic',header=TRUE)
a<-table.element(a,myl.1,header=TRUE)
a<-table.element(a,myl.2,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,myl.3,header=TRUE)
a<-table.element(a,myl.4,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]]
p01 <- quantile(r$t[,1],myq.1)[[1]]
p05 <- quantile(r$t[,1],myq.2)[[1]]
p95 <- quantile(r$t[,1],myq.3)[[1]]
p99 <- quantile(r$t[,1],myq.4)[[1]]
a<-table.element(a,signif(p01,par3))
a<-table.element(a,signif(p05,par3))
a<-table.element(a,signif(q1,par3))
a<-table.element(a,signif(r$t0[1],par3))
a<-table.element(a,signif(q3,par3))
a<-table.element(a,signif(p95,par3))
a<-table.element(a,signif(p99,par3))
a<-table.element( a,signif( sqrt(var(r$t[,1])),par3 ) )
a<-table.element(a,signif(q3-q1,par3))
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]]
p01 <- quantile(r$t[,2],myq.1)[[1]]
p05 <- quantile(r$t[,2],myq.2)[[1]]
p95 <- quantile(r$t[,2],myq.3)[[1]]
p99 <- quantile(r$t[,2],myq.4)[[1]]
a<-table.element(a,signif(p01,par3))
a<-table.element(a,signif(p05,par3))
a<-table.element(a,signif(q1,par3))
a<-table.element(a,signif(r$t0[2],par3))
a<-table.element(a,signif(q3,par3))
a<-table.element(a,signif(p95,par3))
a<-table.element(a,signif(p99,par3))
a<-table.element(a,signif(sqrt(var(r$t[,2])),par3))
a<-table.element(a,signif(q3-q1,par3))
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]]
p01 <- quantile(r$t[,3],myq.1)[[1]]
p05 <- quantile(r$t[,3],myq.2)[[1]]
p95 <- quantile(r$t[,3],myq.3)[[1]]
p99 <- quantile(r$t[,3],myq.4)[[1]]
a<-table.element(a,signif(p01,par3))
a<-table.element(a,signif(p05,par3))
a<-table.element(a,signif(q1,par3))
a<-table.element(a,signif(r$t0[3],par3))
a<-table.element(a,signif(q3,par3))
a<-table.element(a,signif(p95,par3))
a<-table.element(a,signif(p99,par3))
a<-table.element(a,signif(sqrt(var(r$t[,3])),par3))
a<-table.element(a,signif(q3-q1,par3))
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'mode',header=TRUE)
q1 <- quantile(r$t[,4],0.25)[[1]]
q3 <- quantile(r$t[,4],0.75)[[1]]
p01 <- quantile(r$t[,4],myq.1)[[1]]
p05 <- quantile(r$t[,4],myq.2)[[1]]
p95 <- quantile(r$t[,4],myq.3)[[1]]
p99 <- quantile(r$t[,4],myq.4)[[1]]
a<-table.element(a,signif(p01,par3))
a<-table.element(a,signif(p05,par3))
a<-table.element(a,signif(q1,par3))
a<-table.element(a,signif(r$t0[4],par3))
a<-table.element(a,signif(q3,par3))
a<-table.element(a,signif(p95,par3))
a<-table.element(a,signif(p99,par3))
a<-table.element(a,signif(sqrt(var(r$t[,4])),par3))
a<-table.element(a,signif(q3-q1,par3))
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'mode k.dens',header=TRUE)
q1 <- quantile(r$t[,5],0.25)[[1]]
q3 <- quantile(r$t[,5],0.75)[[1]]
p01 <- quantile(r$t[,5],myq.1)[[1]]
p05 <- quantile(r$t[,5],myq.2)[[1]]
p95 <- quantile(r$t[,5],myq.3)[[1]]
p99 <- quantile(r$t[,5],myq.4)[[1]]
a<-table.element(a,signif(p01,par3))
a<-table.element(a,signif(p05,par3))
a<-table.element(a,signif(q1,par3))
a<-table.element(a,signif(r$t0[5],par3))
a<-table.element(a,signif(q3,par3))
a<-table.element(a,signif(p95,par3))
a<-table.element(a,signif(p99,par3))
a<-table.element(a,signif(sqrt(var(r$t[,5])),par3))
a<-table.element(a,signif(q3-q1,par3))
a<-table.row.end(a)
a<-table.end(a)
table.save(a,file="/var/wessaorg/rcomp/tmp/103do51449071958.tab") 

try(system("convert tmp/19tyg1449071958.ps tmp/19tyg1449071958.png",intern=TRUE))
try(system("convert tmp/2k1tx1449071958.ps tmp/2k1tx1449071958.png",intern=TRUE))
try(system("convert tmp/3bnc21449071958.ps tmp/3bnc21449071958.png",intern=TRUE))
try(system("convert tmp/4ow8i1449071958.ps tmp/4ow8i1449071958.png",intern=TRUE))
try(system("convert tmp/5lst21449071958.ps tmp/5lst21449071958.png",intern=TRUE))
try(system("convert tmp/6g1481449071958.ps tmp/6g1481449071958.png",intern=TRUE))
try(system("convert tmp/77vh01449071958.ps tmp/77vh01449071958.png",intern=TRUE))
try(system("convert tmp/859c01449071958.ps tmp/859c01449071958.png",intern=TRUE))
try(system("convert tmp/9h1iv1449071958.ps tmp/9h1iv1449071958.png",intern=TRUE))

