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(10.81,9.12,11.03,12.74,9.98,11.62,9.40,9.27,7.76,8.78,10.65,10.95,12.36,10.85,11.84,12.14,11.65,8.86,7.63,7.38,7.25,8.03,7.75,7.16,7.18,7.51,7.07,7.11,8.98,9.53,10.54,11.31,10.36,11.44,10.45,10.69,11.28,11.96,13.52,12.89,14.03,16.27,16.17,17.25,19.38,26.20,33.53,32.20,38.45,44.86,41.67,36.06,39.76,36.81,42.65,46.89,53.61,57.59,67.82,71.89,75.51,68.49,62.72,70.39,59.77,57.27,67.96,67.85,76.98,81.08,91.66,84.84,85.73,84.61,92.91,99.80,121.19,122.04,131.76,138.48,153.47,189.95,182.22,198.08,135.36,125.02,143.50,173.95,188.75,167.44,158.95,169.53,113.66,107.59,92.67,85.35,90.13,89.31,105.12,125.83,135.81,142.43,163.39,168.21,185.35,188.50,199.91,210.73,192.06,204.62,235.00,261.09,256.88,251.53,257.25,243.10,283.75) > par10 = 'FALSE' > par9 = '0' > par8 = '0' > par7 = '1' > par6 = '1' > par5 = '12' > par4 = '0' > par3 = '1' > par2 = '-0.1' > par1 = '12' > #'GNU S' R Code compiled by R2WASP v. 1.0.44 () > #Author: Prof. Dr. P. Wessa > #To cite this work: Wessa P., (2009), ARIMA Forecasting (v1.0.5) in Free Statistics Software (v$_version), Office for Research Development and Education, URL http://www.wessa.net/rwasp_arimaforecasting.wasp/ > #Source of accompanying publication: > #Technical description: > par1 <- as.numeric(par1) #cut off periods > 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 ma1 0.7087 -0.5974 s.e. 0.4311 0.4927 sigma^2 estimated as 8.075e-05: log likelihood = 342.47, aic = -678.93 > (forecast <- predict(arima.out,par1)) $pred Time Series: Start = 106 End = 117 Frequency = 1 [1] 0.5918421 0.5908801 0.5901984 0.5897153 0.5893729 0.5891302 0.5889583 [8] 0.5888364 0.5887501 0.5886889 0.5886455 0.5886148 $se Time Series: Start = 106 End = 117 Frequency = 1 [1] 0.008986281 0.013433940 0.017170837 0.020498633 0.023529628 0.026324542 [7] 0.028923517 0.031356160 0.033645640 0.035810684 0.037866718 0.039826610 > (lb <- forecast$pred - 1.96 * forecast$se) Time Series: Start = 106 End = 117 Frequency = 1 [1] 0.5742289 0.5645496 0.5565435 0.5495379 0.5432548 0.5375341 0.5322682 [8] 0.5273784 0.5228046 0.5184999 0.5144267 0.5105546 > (ub <- forecast$pred + 1.96 * forecast$se) Time Series: Start = 106 End = 117 Frequency = 1 [1] 0.6094552 0.6172106 0.6238532 0.6298926 0.6354909 0.6407263 0.6456484 [8] 0.6502945 0.6546955 0.6588778 0.6628643 0.6666749 > 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] 10.8100 9.1200 11.0300 12.7400 9.9800 11.6200 9.4000 9.2700 [9] 7.7600 8.7800 10.6500 10.9500 12.3600 10.8500 11.8400 12.1400 [17] 11.6500 8.8600 7.6300 7.3800 7.2500 8.0300 7.7500 7.1600 [25] 7.1800 7.5100 7.0700 7.1100 8.9800 9.5300 10.5400 11.3100 [33] 10.3600 11.4400 10.4500 10.6900 11.2800 11.9600 13.5200 12.8900 [41] 14.0300 16.2700 16.1700 17.2500 19.3800 26.2000 33.5300 32.2000 [49] 38.4500 44.8600 41.6700 36.0600 39.7600 36.8100 42.6500 46.8900 [57] 53.6100 57.5900 67.8200 71.8900 75.5100 68.4900 62.7200 70.3900 [65] 59.7700 57.2700 67.9600 67.8500 76.9800 81.0800 91.6600 84.8400 [73] 85.7300 84.6100 92.9100 99.8000 121.1900 122.0400 131.7600 138.4800 [81] 153.4700 189.9500 182.2200 198.0800 135.3600 125.0200 143.5000 173.9500 [89] 188.7500 167.4400 158.9500 169.5300 113.6600 107.5900 92.6700 85.3500 [97] 90.1300 89.3100 105.1200 125.8300 135.8100 142.4300 163.3900 168.2100 [105] 185.3500 189.6452 192.7553 194.9934 196.5968 197.7418 198.5577 199.1382 [113] 199.5507 199.8436 200.0515 200.1989 200.3035 > (perc.se <- (ub-forecast$pred)/1.96/forecast$pred) Time Series: Start = 106 End = 117 Frequency = 1 [1] 0.1799584 0.2946492 0.4075633 0.5230111 0.6422128 0.7656370 0.8935277 [8] 1.0260662 1.1634262 1.3057930 1.4533683 1.6063698 > postscript(file="/var/www/rcomp/tmp/17ez01292345259.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/2lox81292345259.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/3spck1292345259.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/4d8tq1292345259.tab") > > try(system("convert tmp/17ez01292345259.ps tmp/17ez01292345259.png",intern=TRUE)) character(0) > try(system("convert tmp/2lox81292345259.ps tmp/2lox81292345259.png",intern=TRUE)) character(0) > > > proc.time() user system elapsed 0.700 0.440 1.125