R version 2.9.0 (2009-04-17) Copyright (C) 2009 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. 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(11974 + ,10106 + ,12069 + ,11412 + ,11180 + ,10508 + ,11288 + ,10928 + ,10199 + ,11030 + ,11234 + ,13747 + ,13912 + ,12376 + ,12264 + ,11675 + ,11271 + ,10672 + ,10933 + ,10379 + ,10187 + ,10747 + ,10970 + ,12175 + ,14200 + ,11676 + ,11258 + ,10872 + ,11148 + ,10690 + ,10684 + ,11658 + ,10178 + ,10981 + ,10773 + ,11665 + ,11359 + ,10716 + ,12928 + ,12317 + ,11641 + ,10459 + ,10953 + ,10703 + ,10703 + ,11101 + ,11334 + ,13268 + ,13145 + ,12334 + ,13153 + ,11289 + ,11374 + ,10914 + ,11299 + ,11284 + ,10694 + ,11077 + ,11104 + ,12820 + ,14915 + ,11773 + ,11608 + ,11468 + ,11511 + ,11200 + ,11164 + ,10960 + ,10667 + ,11556 + ,11372 + ,12333 + ,13102 + ,11115 + ,12572 + ,11557 + ,12059 + ,11420 + ,11185 + ,11113 + ,10706 + ,11523 + ,11391 + ,12634 + ,13469 + ,11735 + ,13281 + ,11968 + ,11623 + ,11084 + ,11509 + ,11134 + ,10438 + ,11530 + ,11491 + ,13093 + ,13106 + ,11305 + ,13113 + ,12203 + ,11309 + ,11088 + ,11234 + ,11619 + ,10942 + ,11445 + ,11291 + ,13281 + ,13726 + ,11300 + ,11983 + ,11092 + ,11093 + ,10692 + ,10786 + ,11166 + ,10553 + ,11103 + ,10969 + ,12090 + ,12544 + ,12264 + ,13783 + ,11214 + ,11453 + ,10883 + ,10381 + ,10348 + ,10024 + ,10805 + ,10796 + ,11907 + ,12261 + ,11377 + ,12689 + ,11474 + ,10992 + ,10764 + ,12164 + ,10409 + ,10398 + ,10349 + ,10865 + ,11630 + ,12221 + ,10884 + ,12019 + ,11021 + ,10799 + ,10423 + ,10484 + ,10450 + ,9906 + ,11049 + ,11281 + ,12485 + ,12849 + ,11380 + ,12079 + ,11366 + ,11328 + ,10444 + ,10854 + ,10434 + ,10137 + ,10992 + ,10906 + ,12367 + ,14371 + ,11695 + ,11546 + ,10922 + ,10670 + ,10254 + ,10573 + ,10239 + ,10253 + ,11176 + ,10719 + ,11817) > par10 = 'FALSE' > par9 = '1' > par8 = '0' > par7 = '1' > par6 = '0' > par5 = '12' > par4 = '1' > par3 = '0' > par2 = '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: ma1 sma1 0.4452 -1.0000 s.e. 0.0639 0.1093 sigma^2 estimated as 218650: log likelihood = -1196.33, aic = 2398.65 > (forecast <- predict(arima.out,par1)) $pred Time Series: Start = 169 End = 180 Frequency = 1 [1] 13024.76 11452.93 12485.64 11494.86 11341.50 10802.93 11065.57 10898.93 [9] 10409.43 11092.00 11126.93 12517.69 $se Time Series: Start = 169 End = 180 Frequency = 1 [1] 484.2085 529.8076 529.8076 529.8076 529.8076 529.8076 529.8076 529.8076 [9] 529.8076 529.8076 529.8076 529.6136 > (lb <- forecast$pred - 1.96 * forecast$se) Time Series: Start = 169 End = 180 Frequency = 1 [1] 12075.707 10414.504 11447.218 10456.433 10303.075 9764.504 10027.147 [8] 9860.504 9371.004 10053.575 10088.504 11479.651 > (ub <- forecast$pred + 1.96 * forecast$se) Time Series: Start = 169 End = 180 Frequency = 1 [1] 13973.80 12491.35 13524.06 12533.28 12379.92 11841.35 12103.99 11937.35 [9] 11447.85 12130.42 12165.35 13555.74 > 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] 11974.00 10106.00 12069.00 11412.00 11180.00 10508.00 11288.00 10928.00 [9] 10199.00 11030.00 11234.00 13747.00 13912.00 12376.00 12264.00 11675.00 [17] 11271.00 10672.00 10933.00 10379.00 10187.00 10747.00 10970.00 12175.00 [25] 14200.00 11676.00 11258.00 10872.00 11148.00 10690.00 10684.00 11658.00 [33] 10178.00 10981.00 10773.00 11665.00 11359.00 10716.00 12928.00 12317.00 [41] 11641.00 10459.00 10953.00 10703.00 10703.00 11101.00 11334.00 13268.00 [49] 13145.00 12334.00 13153.00 11289.00 11374.00 10914.00 11299.00 11284.00 [57] 10694.00 11077.00 11104.00 12820.00 14915.00 11773.00 11608.00 11468.00 [65] 11511.00 11200.00 11164.00 10960.00 10667.00 11556.00 11372.00 12333.00 [73] 13102.00 11115.00 12572.00 11557.00 12059.00 11420.00 11185.00 11113.00 [81] 10706.00 11523.00 11391.00 12634.00 13469.00 11735.00 13281.00 11968.00 [89] 11623.00 11084.00 11509.00 11134.00 10438.00 11530.00 11491.00 13093.00 [97] 13106.00 11305.00 13113.00 12203.00 11309.00 11088.00 11234.00 11619.00 [105] 10942.00 11445.00 11291.00 13281.00 13726.00 11300.00 11983.00 11092.00 [113] 11093.00 10692.00 10786.00 11166.00 10553.00 11103.00 10969.00 12090.00 [121] 12544.00 12264.00 13783.00 11214.00 11453.00 10883.00 10381.00 10348.00 [129] 10024.00 10805.00 10796.00 11907.00 12261.00 11377.00 12689.00 11474.00 [137] 10992.00 10764.00 12164.00 10409.00 10398.00 10349.00 10865.00 11630.00 [145] 12221.00 10884.00 12019.00 11021.00 10799.00 10423.00 10484.00 10450.00 [153] 9906.00 11049.00 11281.00 12485.00 12849.00 11380.00 12079.00 11366.00 [161] 11328.00 10444.00 10854.00 10434.00 10137.00 10992.00 10906.00 12367.00 [169] 13024.76 11452.93 12485.64 11494.86 11341.50 10802.93 11065.57 10898.93 [177] 10409.43 11092.00 11126.93 12517.69 > (perc.se <- (ub-forecast$pred)/1.96/forecast$pred) Time Series: Start = 169 End = 180 Frequency = 1 [1] 0.03717601 0.04625958 0.04243335 0.04609084 0.04671407 0.04904297 [7] 0.04787893 0.04861099 0.05089690 0.04776485 0.04761491 0.04230920 > postscript(file="/var/www/html/rcomp/tmp/1be951292936606.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/html/rcomp/tmp/2p5ow1292936606.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/html/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab > load(file="/var/www/html/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/html/rcomp/tmp/3w73p1292936606.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/html/rcomp/tmp/4hpkv1292936606.tab") > > try(system("convert tmp/1be951292936606.ps tmp/1be951292936606.png",intern=TRUE)) character(0) > try(system("convert tmp/2p5ow1292936606.ps tmp/2p5ow1292936606.png",intern=TRUE)) character(0) > > > proc.time() user system elapsed 0.789 0.366 2.685