R version 2.13.0 (2011-04-13) Copyright (C) 2011 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(179.257 + ,179.947 + ,179.094 + ,181.624 + ,184.954 + ,187.928 + ,187.151 + ,189.959 + ,192.492 + ,191.103 + ,191.737 + ,192.31 + ,192.013 + ,192.106 + ,192.141 + ,194.58 + ,196.421 + ,199.021 + ,198.136 + ,199.426 + ,200.997 + ,201.277 + ,201.663 + ,202.874 + ,204.256 + ,205.597 + ,205.471 + ,211.064 + ,212.856 + ,217.036 + ,219.302 + ,219.759 + ,221.388 + ,220.834 + ,221.788 + ,222.358 + ,222.972 + ,224.164 + ,224.915 + ,226.294 + ,224.69 + ,227.021 + ,229.284 + ,229.189 + ,230.032 + ,229.389 + ,231.053 + ,232.56 + ,232.681 + ,231.555 + ,231.428 + ,232.141 + ,234.939 + ,235.424 + ,235.471 + ,236.355 + ,238.693 + ,236.958 + ,237.06 + ,239.282 + ,238.252 + ,241.552 + ,236.23 + ,238.909 + ,240.723 + ,242.12 + ,242.1 + ,243.276 + ,244.677 + ,243.494 + ,244.902 + ,245.247 + ,245.578 + ,243.052 + ,238.121 + ,241.863 + ,241.203 + ,243.634 + ,242.351 + ,245.18 + ,246.126 + ,244.424 + ,245.166 + ,247.258 + ,245.094 + ,246.02 + ,243.082 + ,245.555 + ,243.685 + ,247.277 + ,245.029 + ,246.169 + ,246.778 + ,244.577 + ,246.048 + ,245.775 + ,245.328 + ,245.477 + ,241.903 + ,243.219 + ,248.088 + ,248.521 + ,247.389 + ,249.057 + ,248.916 + ,249.193 + ,250.768 + ,253.106 + ,249.829 + ,249.447 + ,246.755 + ,250.785 + ,250.14 + ,255.755 + ,254.671 + ,253.919 + ,253.741 + ,252.729 + ,253.81 + ,256.653 + ,255.231 + ,258.405 + ,251.061 + ,254.811 + ,254.895 + ,258.325 + ,257.608 + ,258.759 + ,258.621 + ,257.852 + ,260.56 + ,262.358 + ,260.812 + ,261.165 + ,257.164 + ,260.72 + ,259.581 + ,264.743 + ,261.845 + ,262.262 + ,261.631 + ,258.953 + ,259.966 + ,262.85 + ,262.204 + ,263.418 + ,262.752 + ,266.433 + ,267.722 + ,266.003 + ,262.971 + ,265.521 + ,264.676 + ,270.223 + ,269.508 + ,268.457 + ,265.814 + ,266.68 + ,263.018 + ,269.285 + ,269.829 + ,270.911 + ,266.844 + ,271.244 + ,269.907 + ,271.296 + ,270.157 + ,271.322 + ,267.179 + ,264.101 + ,265.518 + ,269.419 + ,268.714 + ,272.482 + ,268.351 + ,268.175 + ,270.674 + ,272.764 + ,272.599 + ,270.333 + ,270.846 + ,270.491 + ,269.16 + ,274.027 + ,273.784 + ,276.663 + ,274.525 + ,271.344 + ,271.115 + ,270.798 + ,273.911 + ,273.985 + ,271.917 + ,273.338 + ,270.601 + ,273.547 + ,275.363 + ,281.229 + ,277.793 + ,279.913 + ,282.5 + ,280.041 + ,282.166 + ,290.304 + ,283.519 + ,287.816 + ,285.226 + ,287.595 + ,289.741 + ,289.148 + ,288.301 + ,290.155 + ,289.648 + ,288.225 + ,289.351 + ,294.735 + ,305.333 + ,309.03 + ,310.215 + ,321.935 + ,325.734 + ,320.846 + ,323.023 + ,319.753 + ,321.753 + ,320.757 + ,324.479 + ,324.641 + ,322.767 + ,324.181 + ,321.389 + ,327.897 + ,334.287 + ,332.653 + ,334.819 + ,335.264 + ,339.622 + ,342.44 + ,346.585 + ,335.378 + ,337.01 + ,339.13 + ,341.193 + ,343.507 + ,348.915 + ,346.431 + ,348.322 + ,348.288 + ,346.597 + ,351.076 + ,355.215 + ,350.562 + ,355.266) > par10 = 'FALSE' > par9 = '1' > par8 = '1' > par7 = '0' > par6 = '1' > par5 = '12' > par4 = '0' > par3 = '1' > par2 = '1' > par1 = '24' > #'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 sar1 sma1 -0.1179 0.9762 -0.8395 s.e. 0.0660 0.0263 0.0928 sigma^2 estimated as 5.021: log likelihood = -512.58, aic = 1033.15 > (forecast <- predict(arima.out,par1)) $pred Time Series: Start = 230 End = 253 Frequency = 1 [1] 324.1333 322.6381 326.7237 327.8156 328.8943 327.6908 327.9921 328.6049 [9] 328.2302 329.5294 331.2544 330.8224 331.9914 330.5512 334.5373 335.6034 [17] 336.6564 335.4815 335.7756 336.3738 336.0081 337.2763 338.9602 338.5386 $se Time Series: Start = 230 End = 253 Frequency = 1 [1] 2.240918 2.988122 3.600029 4.120291 4.582043 5.001324 5.388078 [8] 5.748872 6.088322 6.409821 6.715947 7.008720 7.379937 7.722623 [15] 8.051942 8.368175 8.672900 8.967274 9.252287 9.528779 9.797471 [22] 10.058989 10.313877 10.562624 > (lb <- forecast$pred - 1.96 * forecast$se) Time Series: Start = 230 End = 253 Frequency = 1 [1] 319.7412 316.7813 319.6677 319.7398 319.9135 317.8882 317.4314 317.3371 [9] 316.2971 316.9661 318.0911 317.0853 317.5268 315.4149 318.7555 319.2018 [17] 319.6575 317.9057 317.6412 317.6974 316.8051 317.5607 318.7450 317.8358 > (ub <- forecast$pred + 1.96 * forecast$se) Time Series: Start = 230 End = 253 Frequency = 1 [1] 328.5255 328.4948 333.7798 335.8914 337.8751 337.4934 338.5527 339.8727 [9] 340.1633 342.0926 344.4176 344.5595 346.4561 345.6875 350.3191 352.0050 [17] 353.6553 353.0574 353.9101 355.0503 355.2112 356.9919 359.1754 359.2413 > 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] 179.2570 179.9470 179.0940 181.6240 184.9540 187.9280 187.1510 189.9590 [9] 192.4920 191.1030 191.7370 192.3100 192.0130 192.1060 192.1410 194.5800 [17] 196.4210 199.0210 198.1360 199.4260 200.9970 201.2770 201.6630 202.8740 [25] 204.2560 205.5970 205.4710 211.0640 212.8560 217.0360 219.3020 219.7590 [33] 221.3880 220.8340 221.7880 222.3580 222.9720 224.1640 224.9150 226.2940 [41] 224.6900 227.0210 229.2840 229.1890 230.0320 229.3890 231.0530 232.5600 [49] 232.6810 231.5550 231.4280 232.1410 234.9390 235.4240 235.4710 236.3550 [57] 238.6930 236.9580 237.0600 239.2820 238.2520 241.5520 236.2300 238.9090 [65] 240.7230 242.1200 242.1000 243.2760 244.6770 243.4940 244.9020 245.2470 [73] 245.5780 243.0520 238.1210 241.8630 241.2030 243.6340 242.3510 245.1800 [81] 246.1260 244.4240 245.1660 247.2580 245.0940 246.0200 243.0820 245.5550 [89] 243.6850 247.2770 245.0290 246.1690 246.7780 244.5770 246.0480 245.7750 [97] 245.3280 245.4770 241.9030 243.2190 248.0880 248.5210 247.3890 249.0570 [105] 248.9160 249.1930 250.7680 253.1060 249.8290 249.4470 246.7550 250.7850 [113] 250.1400 255.7550 254.6710 253.9190 253.7410 252.7290 253.8100 256.6530 [121] 255.2310 258.4050 251.0610 254.8110 254.8950 258.3250 257.6080 258.7590 [129] 258.6210 257.8520 260.5600 262.3580 260.8120 261.1650 257.1640 260.7200 [137] 259.5810 264.7430 261.8450 262.2620 261.6310 258.9530 259.9660 262.8500 [145] 262.2040 263.4180 262.7520 266.4330 267.7220 266.0030 262.9710 265.5210 [153] 264.6760 270.2230 269.5080 268.4570 265.8140 266.6800 263.0180 269.2850 [161] 269.8290 270.9110 266.8440 271.2440 269.9070 271.2960 270.1570 271.3220 [169] 267.1790 264.1010 265.5180 269.4190 268.7140 272.4820 268.3510 268.1750 [177] 270.6740 272.7640 272.5990 270.3330 270.8460 270.4910 269.1600 274.0270 [185] 273.7840 276.6630 274.5250 271.3440 271.1150 270.7980 273.9110 273.9850 [193] 271.9170 273.3380 270.6010 273.5470 275.3630 281.2290 277.7930 279.9130 [201] 282.5000 280.0410 282.1660 290.3040 283.5190 287.8160 285.2260 287.5950 [209] 289.7410 289.1480 288.3010 290.1550 289.6480 288.2250 289.3510 294.7350 [217] 305.3330 309.0300 310.2150 321.9350 325.7340 320.8460 323.0230 319.7530 [225] 321.7530 320.7570 324.4790 324.6410 322.7670 324.1333 322.6381 326.7237 [233] 327.8156 328.8943 327.6908 327.9921 328.6049 328.2302 329.5294 331.2544 [241] 330.8224 331.9914 330.5512 334.5373 335.6034 336.6564 335.4815 335.7756 [249] 336.3738 336.0081 337.2763 338.9602 338.5386 > (perc.se <- (ub-forecast$pred)/1.96/forecast$pred) Time Series: Start = 230 End = 253 Frequency = 1 [1] 0.006913569 0.009261530 0.011018571 0.012568928 0.013931658 0.015262328 [7] 0.016427464 0.017494785 0.018548939 0.019451442 0.020274289 0.021185748 [13] 0.022229298 0.023362865 0.024068893 0.024934714 0.025761874 0.026729562 [19] 0.027554968 0.028327943 0.029158437 0.029824178 0.030427984 0.031200650 > postscript(file="/var/wessaorg/rcomp/tmp/177zx1324290843.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/wessaorg/rcomp/tmp/2z6y11324290843.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/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,'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/wessaorg/rcomp/tmp/3ivjv1324290843.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/wessaorg/rcomp/tmp/4qnr71324290844.tab") > > try(system("convert tmp/177zx1324290843.ps tmp/177zx1324290843.png",intern=TRUE)) character(0) > try(system("convert tmp/2z6y11324290843.ps tmp/2z6y11324290843.png",intern=TRUE)) character(0) > > > proc.time() user system elapsed 1.113 0.143 1.314