R version 3.0.2 (2013-09-25) -- "Frisbee Sailing" Copyright (C) 2013 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > x <- c(350840 + ,354950 + ,342750 + ,318610 + ,303890 + ,293480 + ,286820 + ,283650 + ,276190 + ,268670 + ,275960 + ,287040 + ,291500 + ,287540 + ,272340 + ,256570 + ,246190 + ,237340 + ,235890 + ,232790 + ,226100 + ,221110 + ,221950 + ,222990 + ,232840 + ,231380 + ,221690 + ,210190 + ,202210 + ,195210 + ,194050 + ,192360 + ,187170 + ,185930 + ,188840 + ,189350 + ,194320 + ,195850 + ,188840 + ,182380 + ,177200 + ,169140 + ,171900 + ,167320 + ,164130 + ,162550 + ,166260 + ,166010 + ,177070 + ,180800 + ,179570 + ,178130 + ,178180 + ,179430 + ,179130 + ,182220 + ,183650 + ,187110 + ,197780 + ,204000 + ,221330 + ,232500 + ,237570 + ,241100 + ,244420 + ,247240 + ,254300 + ,258970 + ,262230 + ,268880 + ,277950 + ,286630 + ,299830 + ,308090 + ,311400 + ,313520 + ,310980 + ,314910 + ,310950 + ,310720 + ,310380 + ,310570 + ,314790 + ,323400 + ,335010 + ,341630 + ,340820 + ,336280 + ,325490 + ,323750 + ,317510 + ,313890 + ,308610 + ,303720 + ,303090 + ,305140 + ,304040 + ,307100 + ,304330 + ,294710 + ,286890 + ,279050 + ,271860 + ,266710 + ,259590 + ,253830 + ,250640 + ,249140 + ,250840 + ,247590 + ,237830 + ,226380 + ,217230 + ,211420 + ,207620 + ,204310 + ,197490 + ,193580 + ,192330 + ,191970 + ,196070 + ,191940 + ,185620 + ,179410 + ,173920 + ,169190 + ,166840 + ,165170 + ,161450 + ,160830 + ,163670 + ,170830 + ,182690 + ,190940 + ,197770 + ,205090 + ,210720 + ,220210 + ,229730 + ,237070 + ,241620 + ,250370 + ,258570 + ,269860 + ,283220 + ,289610 + ,281770 + ,274700 + ,267650 + ,261380 + ,260500 + ,260730 + ,254200 + ,250450 + ,253380 + ,263740 + ,276240 + ,273820 + ,265890 + ,258400 + ,253520 + ,250710 + ,252850 + ,255260 + ,251170 + ,252500 + ,257780 + ,269900 + ,291590 + ,298870 + ,295570 + ,292100 + ,290870 + ,290580 + ,297970 + ,304010 + ,304340 + ,309850 + ,322320 + ,340170 + ,369280 + ,376690 + ,379700 + ,379520 + ,377770 + ,381560 + ,394580 + ,399320 + ,400370 + ,408200 + ,419070 + ,437730) > par2 = '12' > par1 = '200' > par2 <- '12' > par1 <- '200' > #'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) Attaching package: 'boot' The following object is masked from 'package:lattice': melanoma > 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')) BLOCK BOOTSTRAP FOR TIME SERIES Fixed Block Length of 12 Call: tsboot(tseries = x, statistic = boot.stat, R = par1, l = 12, sim = "fixed") Bootstrap Statistics : original bias std. error t1* 256950.1 136.7862 14607.21 t2* 254780.0 1768.8500 17691.64 t3* 299280.0 -12406.0500 18712.19 > postscript(file="/var/wessaorg/rcomp/tmp/19u6h1415972096.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() null device 1 > postscript(file="/var/wessaorg/rcomp/tmp/2623c1415972096.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() null device 1 > postscript(file="/var/wessaorg/rcomp/tmp/3t86j1415972096.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() null device 1 > postscript(file="/var/wessaorg/rcomp/tmp/4zy4j1415972096.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() null device 1 > postscript(file="/var/wessaorg/rcomp/tmp/5cpyb1415972096.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() null device 1 > postscript(file="/var/wessaorg/rcomp/tmp/6bftf1415972096.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() null device 1 > 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/7kav51415972096.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') Warning message: In bxp(list(stats = c(220731.510416667, 246256.848958333, 257764.557291667, : some notches went outside hinges ('box'): maybe set notch=FALSE > grid() > dev.off() null device 1 > > #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/80ena1415972096.tab") > > try(system("convert tmp/19u6h1415972096.ps tmp/19u6h1415972096.png",intern=TRUE)) character(0) > try(system("convert tmp/2623c1415972096.ps tmp/2623c1415972096.png",intern=TRUE)) character(0) > try(system("convert tmp/3t86j1415972096.ps tmp/3t86j1415972096.png",intern=TRUE)) character(0) > try(system("convert tmp/4zy4j1415972096.ps tmp/4zy4j1415972096.png",intern=TRUE)) character(0) > try(system("convert tmp/5cpyb1415972096.ps tmp/5cpyb1415972096.png",intern=TRUE)) character(0) > try(system("convert tmp/6bftf1415972096.ps tmp/6bftf1415972096.png",intern=TRUE)) character(0) > try(system("convert tmp/7kav51415972096.ps tmp/7kav51415972096.png",intern=TRUE)) character(0) > > > proc.time() user system elapsed 2.916 0.502 3.453