R version 2.12.0 (2010-10-15) Copyright (C) 2010 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i486-pc-linux-gnu (32-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(100.00,100.42,100.50,101.14,101.98,102.31,103.27,103.80,103.46,105.06,106.08,106.74,107.35,108.96,109.85,109.81,109.99,111.60,112.74,112.78,113.66,115.37,116.26,116.24,116.73,118.76,119.78,120.23,121.48,124.07,125.82,126.92,128.48,131.44,133.51,134.58,136.68,140.10,142.45,143.91,146.19,149.84,152.31,153.62,155.79,159.89,163.21,165.32,167.68,171.79,175.38,177.81,181.09,186.48,191.07,194.23,197.82,204.41,209.26,212.24,214.88,218.87,219.86,219.75,220.89,224.02,222.27,217.27,213.23,212.44,207.87,199.46,198.19,199.77,200.10,195.76,191.27,195.79,192.7) > par10 = 'FALSE' > par9 = '1' > par8 = '1' > par7 = '1' > par6 = '3' > par5 = '4' > par4 = '0' > par3 = '2' > par2 = '-1.0' > par1 = '0' > par1 <- 26 > par2 <- as.numeric(par2) #lambda > par3 <- as.numeric(par3) #degree of non-seasonal differencing > par4 <- as.numeric(par4) #degree of seasonal differencing > par5 <- as.numeric(par5) #seasonal period > par6 <- as.numeric(par6) #p > par7 <- as.numeric(par7) #q > par8 <- as.numeric(par8) #P > par9 <- as.numeric(par9) #Q > if (par10 == 'TRUE') par10 <- TRUE > if (par10 == 'FALSE') par10 <- FALSE > if (par2 == 0) x <- log(x) > if (par2 != 0) x <- x^par2 > lx <- length(x) > first <- lx - 2*par1 > nx <- lx - par1 > nx1 <- nx + 1 > fx <- lx - nx > if (fx < 1) { + fx <- par5 + nx1 <- lx + fx - 1 + first <- lx - 2*fx + } > first <- 1 > if (fx < 3) fx <- round(lx/10,0) > (arima.out <- arima(x[1:nx], order=c(par6,par3,par7), seasonal=list(order=c(par8,par4,par9), period=par5), include.mean=par10, method='ML')) Call: arima(x = x[1:nx], order = c(par6, par3, par7), seasonal = list(order = c(par8, par4, par9), period = par5), include.mean = par10, method = "ML") Coefficients: ar1 ar2 ar3 ma1 sar1 sma1 0.1651 -0.2918 0.4201 -0.9367 0.9975 -0.9184 s.e. 0.1583 0.1667 0.1686 0.0684 0.0292 0.4641 sigma^2 estimated as 7.714e-10: log likelihood = 457.69, aic = -901.38 > (forecast <- predict(arima.out,par1)) $pred Time Series: Start = 54 End = 79 Frequency = 1 [1] 0.005350683 0.005222214 0.005137227 0.005026582 0.004848110 0.004714261 [7] 0.004622874 0.004505887 0.004322245 0.004182901 0.004085583 0.003963159 [13] 0.003774322 0.003629421 0.003526559 0.003398778 0.003204630 0.003054302 [19] 0.002945995 0.002812797 0.002613361 0.002457678 0.002343915 0.002205296 [25] 0.002000616 0.001839590 $se Time Series: Start = 54 End = 79 Frequency = 1 [1] 2.817388e-05 4.485264e-05 5.388447e-05 6.765462e-05 8.524615e-05 [6] 9.912321e-05 1.129040e-04 1.286903e-04 1.448795e-04 1.604674e-04 [11] 1.765608e-04 1.930225e-04 2.103906e-04 2.280362e-04 2.456743e-04 [16] 2.636030e-04 2.828577e-04 3.023401e-04 3.217000e-04 3.415441e-04 [21] 3.627294e-04 3.840771e-04 4.053903e-04 4.272502e-04 4.503850e-04 [26] 4.737122e-04 > (lb <- forecast$pred - 1.96 * forecast$se) Time Series: Start = 54 End = 79 Frequency = 1 [1] 0.0052954618 0.0051343026 0.0050316130 0.0048939794 0.0046810275 [6] 0.0045199792 0.0044015817 0.0042536536 0.0040382809 0.0038683848 [11] 0.0037395237 0.0035848345 0.0033619559 0.0031824700 0.0030450375 [16] 0.0028821166 0.0026502285 0.0024617149 0.0023154627 0.0021433703 [21] 0.0019024111 0.0017048867 0.0015493496 0.0013678861 0.0011178610 [26] 0.0009111144 > (ub <- forecast$pred + 1.96 * forecast$se) Time Series: Start = 54 End = 79 Frequency = 1 [1] 0.005405903 0.005310125 0.005242840 0.005159186 0.005015192 0.004908542 [7] 0.004844165 0.004758120 0.004606209 0.004497417 0.004431642 0.004341483 [13] 0.004186687 0.004076372 0.004008081 0.003915440 0.003759031 0.003646888 [19] 0.003576527 0.003482223 0.003324310 0.003210469 0.003138480 0.003042707 [25] 0.002883370 0.002768066 > if (par2 == 0) { + x <- exp(x) + forecast$pred <- exp(forecast$pred) + lb <- exp(lb) + ub <- exp(ub) + } > if (par2 != 0) { + x <- x^(1/par2) + forecast$pred <- forecast$pred^(1/par2) + lb <- lb^(1/par2) + ub <- ub^(1/par2) + } > if (par2 < 0) { + olb <- lb + lb <- ub + ub <- olb + } > (actandfor <- c(x[1:nx], forecast$pred)) [1] 100.0000 100.4200 100.5000 101.1400 101.9800 102.3100 103.2700 103.8000 [9] 103.4600 105.0600 106.0800 106.7400 107.3500 108.9600 109.8500 109.8100 [17] 109.9900 111.6000 112.7400 112.7800 113.6600 115.3700 116.2600 116.2400 [25] 116.7300 118.7600 119.7800 120.2300 121.4800 124.0700 125.8200 126.9200 [33] 128.4800 131.4400 133.5100 134.5800 136.6800 140.1000 142.4500 143.9100 [41] 146.1900 149.8400 152.3100 153.6200 155.7900 159.8900 163.2100 165.3200 [49] 167.6800 171.7900 175.3800 177.8100 181.0900 186.8920 191.4897 194.6576 [57] 198.9423 206.2659 212.1223 216.3157 221.9319 231.3613 239.0685 244.7631 [65] 252.3240 264.9483 275.5260 283.5625 294.2234 312.0485 327.4071 339.4439 [73] 355.5180 382.6490 406.8882 426.6367 453.4538 499.8461 543.5993 > (perc.se <- (ub-forecast$pred)/1.96/forecast$pred) Time Series: Start = 54 End = 79 Frequency = 1 [1] 0.005320383 0.008735877 0.010709185 0.013824050 0.018210991 0.021930016 [7] 0.025650789 0.030254069 0.035876536 0.041481760 0.047214771 0.053844183 [13] 0.062579830 0.071653854 0.080680213 0.091461592 0.106729564 0.122816881 [19] 0.138935491 0.159349082 0.190668267 0.225280128 0.261651941 0.312343424 [25] 0.402898944 0.519926131 > postscript(file="/var/www/rcomp/tmp/10g9n1292679994.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) > opar <- par(mar=c(4,4,2,2),las=1) > ylim <- c( min(x[first:nx],lb), max(x[first:nx],ub)) > plot(x,ylim=ylim,type='n',xlim=c(first,lx)) > usr <- par('usr') > rect(usr[1],usr[3],nx+1,usr[4],border=NA,col='lemonchiffon') > rect(nx1,usr[3],usr[2],usr[4],border=NA,col='lavender') > abline(h= (-3:3)*2 , col ='gray', lty =3) > polygon( c(nx1:lx,lx:nx1), c(lb,rev(ub)), col = 'orange', lty=2,border=NA) > lines(nx1:lx, lb , lty=2) > lines(nx1:lx, ub , lty=2) > lines(x, lwd=2) > lines(nx1:lx, forecast$pred , lwd=2 , col ='white') > box() > par(opar) > dev.off() null device 1 > prob.dec <- array(NA, dim=fx) > prob.sdec <- array(NA, dim=fx) > prob.ldec <- array(NA, dim=fx) > prob.pval <- array(NA, dim=fx) > perf.pe <- array(0, dim=fx) > perf.mape <- array(0, dim=fx) > perf.mape1 <- array(0, dim=fx) > perf.se <- array(0, dim=fx) > perf.mse <- array(0, dim=fx) > perf.mse1 <- array(0, dim=fx) > perf.rmse <- array(0, dim=fx) > for (i in 1:fx) { + locSD <- (ub[i] - forecast$pred[i]) / 1.96 + perf.pe[i] = (x[nx+i] - forecast$pred[i]) / forecast$pred[i] + perf.se[i] = (x[nx+i] - forecast$pred[i])^2 + prob.dec[i] = pnorm((x[nx+i-1] - forecast$pred[i]) / locSD) + prob.sdec[i] = pnorm((x[nx+i-par5] - forecast$pred[i]) / locSD) + prob.ldec[i] = pnorm((x[nx] - forecast$pred[i]) / locSD) + prob.pval[i] = pnorm(abs(x[nx+i] - forecast$pred[i]) / locSD) + } > perf.mape[1] = abs(perf.pe[1]) > perf.mse[1] = abs(perf.se[1]) > for (i in 2:fx) { + perf.mape[i] = perf.mape[i-1] + abs(perf.pe[i]) + perf.mape1[i] = perf.mape[i] / i + perf.mse[i] = perf.mse[i-1] + perf.se[i] + perf.mse1[i] = perf.mse[i] / i + } > perf.rmse = sqrt(perf.mse1) > postscript(file="/var/www/rcomp/tmp/2wppv1292679994.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) > plot(forecast$pred, pch=19, type='b',main='ARIMA Extrapolation Forecast', ylab='Forecast and 95% CI', xlab='time',ylim=c(min(lb),max(ub))) > dum <- forecast$pred > dum[1:par1] <- x[(nx+1):lx] > lines(dum, lty=1) > lines(ub,lty=3) > lines(lb,lty=3) > dev.off() null device 1 > > #Note: the /var/www/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab > load(file="/var/www/rcomp/createtable") > > a<-table.start() > a<-table.row.start(a) > a<-table.element(a,'Univariate ARIMA Extrapolation Forecast',9,TRUE) > a<-table.row.end(a) > a<-table.row.start(a) > a<-table.element(a,'time',1,header=TRUE) > a<-table.element(a,'Y[t]',1,header=TRUE) > a<-table.element(a,'F[t]',1,header=TRUE) > a<-table.element(a,'95% LB',1,header=TRUE) > a<-table.element(a,'95% UB',1,header=TRUE) > a<-table.element(a,'p-value
(H0: Y[t] = F[t])',1,header=TRUE) > a<-table.element(a,'P(F[t]>Y[t-1])',1,header=TRUE) > a<-table.element(a,'P(F[t]>Y[t-s])',1,header=TRUE) > mylab <- paste('P(F[t]>Y[',nx,sep='') > mylab <- paste(mylab,'])',sep='') > a<-table.element(a,mylab,1,header=TRUE) > a<-table.row.end(a) > for (i in (nx-par5):nx) { + a<-table.row.start(a) + a<-table.element(a,i,header=TRUE) + a<-table.element(a,x[i]) + a<-table.element(a,'-') + a<-table.element(a,'-') + a<-table.element(a,'-') + a<-table.element(a,'-') + a<-table.element(a,'-') + a<-table.element(a,'-') + a<-table.element(a,'-') + a<-table.row.end(a) + } > for (i in 1:fx) { + a<-table.row.start(a) + a<-table.element(a,nx+i,header=TRUE) + a<-table.element(a,round(x[nx+i],4)) + a<-table.element(a,round(forecast$pred[i],4)) + a<-table.element(a,round(lb[i],4)) + a<-table.element(a,round(ub[i],4)) + a<-table.element(a,round((1-prob.pval[i]),4)) + a<-table.element(a,round((1-prob.dec[i]),4)) + a<-table.element(a,round((1-prob.sdec[i]),4)) + a<-table.element(a,round((1-prob.ldec[i]),4)) + a<-table.row.end(a) + } > a<-table.end(a) > table.save(a,file="/var/www/rcomp/tmp/3v03s1292679994.tab") > a<-table.start() > a<-table.row.start(a) > a<-table.element(a,'Univariate ARIMA Extrapolation Forecast Performance',7,TRUE) > a<-table.row.end(a) > a<-table.row.start(a) > a<-table.element(a,'time',1,header=TRUE) > a<-table.element(a,'% S.E.',1,header=TRUE) > a<-table.element(a,'PE',1,header=TRUE) > a<-table.element(a,'MAPE',1,header=TRUE) > a<-table.element(a,'Sq.E',1,header=TRUE) > a<-table.element(a,'MSE',1,header=TRUE) > a<-table.element(a,'RMSE',1,header=TRUE) > a<-table.row.end(a) > for (i in 1:fx) { + a<-table.row.start(a) + a<-table.element(a,nx+i,header=TRUE) + a<-table.element(a,round(perc.se[i],4)) + a<-table.element(a,round(perf.pe[i],4)) + a<-table.element(a,round(perf.mape1[i],4)) + a<-table.element(a,round(perf.se[i],4)) + a<-table.element(a,round(perf.mse1[i],4)) + a<-table.element(a,round(perf.rmse[i],4)) + a<-table.row.end(a) + } > a<-table.end(a) > table.save(a,file="/var/www/rcomp/tmp/4h02g1292679994.tab") > > try(system("convert tmp/10g9n1292679994.ps tmp/10g9n1292679994.png",intern=TRUE)) character(0) > try(system("convert tmp/2wppv1292679994.ps tmp/2wppv1292679994.png",intern=TRUE)) character(0) > > > proc.time() user system elapsed 0.840 0.430 1.253