x <- c(0.43,0.45,0.44,0.44,0.44,0.48,0.47,0.47,0.47,0.49,0.49,0.46,0.45,0.44,0.42,0.43,0.43,0.47,0.47,0.47,0.47,0.48,0.48,0.48,0.49,0.49,0.47,0.5,0.51,0.5,0.49,0.5,0.51,0.51,0.5,0.53,0.5,0.49,0.46,0.46,0.47,0.49,0.5,0.5,0.51,0.5,0.52,0.5,0.48,0.47,0.43,0.42,0.45,0.5,0.52,0.52,0.51,0.52,0.52,0.51,0.51,0.51,0.48,0.49,0.47,0.51,0.5,0.51,0.51,0.52,0.51,0.52,0.48,0.49,0.47,0.44,0.44,0.47,0.51,0.51,0.52,0.52,0.52,0.52) par2 = '12' par1 = '750' par2 <- '12' par1 <- '750' #'GNU S' R Code compiled by R2WASP v. 1.2.291 () #Author: root #To cite this work: Wessa P., (2012), Blocked Bootstrap Plot for Central Tendency (v1.0.4) 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) 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')) postscript(file="/var/wessaorg/rcomp/tmp/1xl5s1387718184.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/2gsfa1387718184.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/3l0zk1387718184.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/43o2j1387718184.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/5l17n1387718184.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/6qmbx1387718184.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])) colnames(z) <- list('mean','median','midrange') postscript(file="/var/wessaorg/rcomp/tmp/7q0531387718184.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() #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',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="/var/wessaorg/rcomp/tmp/8hk8l1387718184.tab") try(system("convert tmp/1xl5s1387718184.ps tmp/1xl5s1387718184.png",intern=TRUE)) try(system("convert tmp/2gsfa1387718184.ps tmp/2gsfa1387718184.png",intern=TRUE)) try(system("convert tmp/3l0zk1387718184.ps tmp/3l0zk1387718184.png",intern=TRUE)) try(system("convert tmp/43o2j1387718184.ps tmp/43o2j1387718184.png",intern=TRUE)) try(system("convert tmp/5l17n1387718184.ps tmp/5l17n1387718184.png",intern=TRUE)) try(system("convert tmp/6qmbx1387718184.ps tmp/6qmbx1387718184.png",intern=TRUE)) try(system("convert tmp/7q0531387718184.ps tmp/7q0531387718184.png",intern=TRUE))