R version 2.8.0 (2008-10-20) Copyright (C) 2008 The R Foundation for Statistical Computing ISBN 3-900051-07-0 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. Natural language support but running in an English locale 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(255 + ,280.2 + ,299.9 + ,339.2 + ,374.2 + ,393.5 + ,389.2 + ,381.7 + ,375.2 + ,369 + ,357.4 + ,352.1 + ,346.5 + ,342.9 + ,340.3 + ,328.3 + ,322.9 + ,314.3 + ,308.9 + ,294 + ,285.6 + ,281.2 + ,280.3 + ,278.8 + ,274.5 + ,270.4 + ,263.4 + ,259.9 + ,258 + ,262.7 + ,284.7 + ,311.3 + ,322.1 + ,327 + ,331.3 + ,333.3 + ,321.4 + ,327 + ,320 + ,314.7 + ,316.7 + ,314.4 + ,321.3 + ,318.2 + ,307.2 + ,301.3 + ,287.5 + ,277.7 + ,274.4 + ,258.8 + ,253.3 + ,251 + ,248.4 + ,249.5 + ,246.1 + ,244.5 + ,243.6 + ,244 + ,240.8 + ,249.8 + ,248 + ,259.4 + ,260.5 + ,260.8 + ,261.3 + ,259.5 + ,256.6 + ,257.9 + ,256.5 + ,254.2 + ,253.3 + ,253.8 + ,255.5 + ,257.1 + ,257.3 + ,253.2 + ,252.8 + ,252 + ,250.7 + ,252.2 + ,250 + ,251 + ,253.4 + ,251.2 + ,255.6 + ,261.1 + ,258.9 + ,259.9 + ,261.2 + ,264.7 + ,267.1 + ,266.4 + ,267.7 + ,268.6 + ,267.5 + ,268.5 + ,268.5 + ,270.5 + ,270.9 + ,270.1 + ,269.3 + ,269.8 + ,270.1 + ,264.9 + ,263.7 + ,264.8 + ,263.7 + ,255.9 + ,276.2 + ,360.1 + ,380.5 + ,373.7 + ,369.8 + ,366.6 + ,359.3 + ,345.8 + ,326.2 + ,324.5 + ,328.1 + ,327.5 + ,324.4 + ,316.5 + ,310.9 + ,301.5 + ,291.7 + ,290.4 + ,287.4 + ,277.7 + ,281.6 + ,288 + ,276 + ,272.9 + ,283 + ,283.3 + ,276.8 + ,284.5 + ,282.7 + ,281.2 + ,287.4 + ,283.1 + ,284 + ,285.5 + ,289.2 + ,292.5 + ,296.4 + ,305.2 + ,303.9 + ,311.5 + ,316.3 + ,316.7 + ,322.5 + ,317.1 + ,309.8 + ,303.8 + ,290.3 + ,293.7 + ,291.7 + ,296.5 + ,289.1 + ,288.5 + ,293.8 + ,297.7 + ,305.4 + ,302.7 + ,302.5 + ,303 + ,294.5 + ,294.1 + ,294.5 + ,297.1 + ,289.4 + ,292.4 + ,287.9 + ,286.6 + ,280.5 + ,272.4 + ,269.2 + ,270.6 + ,267.3 + ,262.5 + ,266.8 + ,268.8 + ,263.1 + ,261.2 + ,266 + ,262.5 + ,265.2 + ,261.3 + ,253.7 + ,249.2 + ,239.1 + ,236.4 + ,235.2 + ,245.2 + ,246.2 + ,247.7 + ,251.4 + ,253.3 + ,254.8 + ,250 + ,249.3 + ,241.5 + ,243.3 + ,248 + ,253 + ,252.9 + ,251.5 + ,251.6 + ,253.5 + ,259.8 + ,334.1 + ,448 + ,445.8 + ,445 + ,448.2 + ,438.2 + ,439.8 + ,423.4 + ,410.8 + ,408.4 + ,406.7 + ,405.9 + ,402.7 + ,405.1 + ,399.6 + ,386.5 + ,381.4 + ,375.2 + ,357.7 + ,359 + ,355 + ,352.7 + ,344.4 + ,343.8 + ,338 + ,339 + ,333.3 + ,334.4 + ,328.3 + ,330.7 + ,330 + ,331.6 + ,351.2 + ,389.4 + ,410.9 + ,442.8 + ,462.8 + ,466.9 + ,461.7 + ,439.2 + ,430.3 + ,416.1 + ,402.5 + ,397.3 + ,403.3 + ,395.9 + ,387.8 + ,378.6 + ,377.1 + ,370.4 + ,362 + ,350.3 + ,348.2 + ,344.6 + ,343.5 + ,342.8 + ,347.6 + ,346.6 + ,349.5 + ,342.1 + ,342 + ,342.8 + ,339.3 + ,348.2 + ,333.7 + ,334.7 + ,354 + ,367.7 + ,363.3 + ,358.4 + ,353.1 + ,343.1 + ,344.6 + ,344.4 + ,333.9 + ,331.7 + ,324.3 + ,321.2 + ,322.4 + ,321.7 + ,320.5 + ,312.8 + ,309.7 + ,315.6 + ,309.7 + ,304.6 + ,302.5 + ,301.5 + ,298.8 + ,291.3 + ,293.6 + ,294.6 + ,285.9 + ,297.6 + ,301.1 + ,293.8 + ,297.7 + ,292.9 + ,292.1 + ,287.2 + ,288.2 + ,283.8 + ,299.9 + ,292.4 + ,293.3 + ,300.8 + ,293.7 + ,293.1 + ,294.4 + ,292.1 + ,291.9 + ,282.5 + ,277.9 + ,287.5 + ,289.2 + ,285.6 + ,293.2 + ,290.8 + ,283.1 + ,275 + ,287.8 + ,287.8 + ,287.4 + ,284 + ,277.8 + ,277.6 + ,304.9 + ,294 + ,300.9 + ,324 + ,332.9 + ,341.6 + ,333.4 + ,348.2 + ,344.7 + ,344.7 + ,329.3 + ,323.5 + ,323.2 + ,317.4 + ,330.1 + ,329.2 + ,334.9 + ,315.8 + ,315.4 + ,319.6 + ,317.3 + ,313.8 + ,315.8 + ,311.3) > par2 = '12' > par1 = '500' > 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(s) are masked from package:lattice : melanoma > boot.stat <- function(s) + { + s.mean <- mean(s) + s.median <- median(s) + c(s.mean, s.median) + } > (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* 308.3508 -0.2437383 7.812634 t2* 296.4500 2.1328000 9.616387 > z <- data.frame(cbind(r$t[,1],r$t[,2])) Warning message: In data.row.names(row.names, rowsi, i) : some row.names duplicated: 2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,127,128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255,256,257,258,259,260,261,262,263,264,265,266,267,268,269,270,271 [... truncated] > colnames(z) <- list('mean','median') > postscript(file="/var/www/html/freestat/rcomp/tmp/1qdvm1289938275.ps",horizontal=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) > b <- boxplot(z,notch=TRUE,ylab='simulated values',main='Bootstrap Simulation - Central Tendency') > grid() > dev.off() null device 1 > b $stats [,1] [,2] [1,] 287.3306 277.700 [2,] 302.9319 292.575 [3,] 307.8176 296.450 [4,] 313.3525 303.625 [5,] 328.8339 319.350 $n [1] 500 500 $conf [,1] [,2] [1,] 307.0813 295.6692 [2,] 308.5540 297.2308 $out [1] 279.7356 330.4753 287.0553 283.5153 329.7203 332.6950 339.1500 330.7000 [9] 320.2500 321.4500 323.2000 270.9000 275.5000 320.5000 327.0000 323.2000 [17] 328.7500 329.6500 322.4500 323.5000 322.6500 321.9000 324.3000 $group [1] 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 $names [1] "mean" "median" > > #Note: the /var/www/html/freestat/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab > load(file="/var/www/html/freestat/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.end(a) > table.save(a,file="/var/www/html/freestat/rcomp/tmp/2m5bd1289938275.tab") > > a<-table.start() > a<-table.row.start(a) > a<-table.element(a,'95% Confidence Intervals',3,TRUE) > a<-table.row.end(a) > a<-table.row.start(a) > a<-table.element(a,'',1,TRUE) > a<-table.element(a,'Mean',1,TRUE) > a<-table.element(a,'Median',1,TRUE) > a<-table.row.end(a) > a<-table.row.start(a) > a<-table.element(a,'Lower Bound',1,TRUE) > a<-table.element(a,b$conf[1,1]) > a<-table.element(a,b$conf[1,2]) > a<-table.row.end(a) > a<-table.row.start(a) > a<-table.element(a,'Upper Bound',1,TRUE) > a<-table.element(a,b$conf[2,1]) > a<-table.element(a,b$conf[2,2]) > a<-table.row.end(a) > a<-table.end(a) > table.save(a,file="/var/www/html/freestat/rcomp/tmp/375r11289938275.tab") > > try(system("convert tmp/1qdvm1289938275.ps tmp/1qdvm1289938275.png",intern=TRUE)) character(0) > > > proc.time() user system elapsed 1.681 0.285 1.769