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. 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(205597 + ,205471 + ,211064 + ,212856 + ,217036 + ,219302 + ,219759 + ,221388 + ,220834 + ,221788 + ,222358 + ,222972 + ,224164 + ,224915 + ,226294 + ,224690 + ,227021 + ,229284 + ,229189 + ,230032 + ,229389 + ,231053 + ,232560 + ,232681 + ,231555 + ,231428 + ,232141 + ,234939 + ,235424 + ,235471 + ,236355 + ,238693 + ,236958 + ,237060 + ,239282 + ,238252 + ,241552 + ,236230 + ,238909 + ,240723 + ,242120 + ,242100 + ,243276 + ,244677 + ,243494 + ,244902 + ,245247 + ,245578 + ,243052 + ,238121 + ,241863 + ,241203 + ,243634 + ,242351 + ,245180 + ,246126 + ,244424 + ,245166 + ,247258 + ,245094 + ,246020 + ,243082 + ,245555 + ,243685 + ,247277 + ,245029 + ,246169 + ,246778 + ,244577 + ,246048 + ,245775 + ,245328 + ,245477 + ,241903 + ,243219 + ,248088 + ,248521 + ,247389 + ,249057 + ,248916 + ,249193 + ,250768 + ,253106 + ,249829 + ,249447 + ,246755 + ,250785 + ,250140 + ,255755 + ,254671 + ,253919 + ,253741 + ,252729 + ,253810 + ,256653 + ,255231 + ,258405 + ,251061 + ,254811 + ,254895 + ,258325 + ,257608 + ,258759 + ,258621 + ,257852 + ,260560 + ,262358 + ,260812 + ,261165 + ,257164 + ,260720 + ,259581 + ,264743 + ,261845 + ,262262 + ,261631 + ,258953 + ,259966 + ,262850 + ,262204 + ,263418 + ,262752 + ,266433 + ,267722 + ,266003 + ,262971 + ,265521 + ,264676 + ,270223 + ,269508 + ,268457 + ,265814 + ,266680 + ,263018 + ,269285 + ,269829 + ,270911 + ,266844 + ,271244 + ,269907 + ,271296 + ,270157 + ,271322 + ,267179 + ,264101 + ,265518 + ,269419 + ,268714 + ,272482 + ,268351 + ,268175 + ,270674 + ,272764 + ,272599 + ,270333 + ,270846 + ,270491 + ,269160 + ,274027 + ,273784 + ,276663 + ,274525 + ,271344 + ,271115 + ,270798 + ,273911 + ,273985 + ,271917 + ,273338 + ,270601 + ,273547 + ,275363 + ,281229 + ,277793 + ,279913 + ,282500 + ,280041 + ,282166 + ,290304 + ,283519 + ,287816 + ,285226 + ,287595 + ,289741 + ,289148 + ,288301 + ,290155 + ,289648 + ,288225 + ,289351 + ,294735 + ,305333) > par10 = 'FALSE' > par9 = '1' > par8 = '0' > par7 = '1' > par6 = '0' > par5 = '12' > par4 = '1' > par3 = '1' > par2 = '1' > par1 = '12' > #'GNU S' R Code compiled by R2WASP v. 1.0.44 () > #Author: Prof. Dr. P. Wessa > #To cite this work: AUTHOR(S), (YEAR), YOUR SOFTWARE TITLE (vNUMBER) in Free Statistics Software (v$_version), Office for Research Development and Education, URL http://www.wessa.net/rwasp_YOURPAGE.wasp/ > #Source of accompanying publication: Office for Research, Development, and Education > #Technical description: Write here your technical program description (don't use hard returns!) > 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.3185 -0.7804 s.e. 0.0822 0.0792 sigma^2 estimated as 3741605: log likelihood = -1506.42, aic = 3018.84 > (forecast <- predict(arima.out,fx)) $pred Time Series: Start = 181 End = 192 Frequency = 1 [1] 284578.9 282396.4 286259.3 286755.4 290009.0 287331.7 288128.9 288848.0 [9] 288741.0 289946.9 292043.2 289280.0 $se Time Series: Start = 181 End = 192 Frequency = 1 [1] 1934.674 2341.141 2686.805 2992.807 3270.302 3526.025 3764.416 3988.584 [9] 4200.807 4402.813 4595.948 4781.288 > (lb <- forecast$pred - 1.96 * forecast$se) Time Series: Start = 181 End = 192 Frequency = 1 [1] 280786.9 277807.7 280993.2 280889.5 283599.2 280420.7 280750.6 281030.3 [9] 280507.4 281317.4 283035.1 279908.7 > (ub <- forecast$pred + 1.96 * forecast$se) Time Series: Start = 181 End = 192 Frequency = 1 [1] 288370.8 286985.0 291525.5 292621.3 296418.8 294242.8 295507.1 296665.6 [9] 296974.6 298576.4 301051.2 298651.3 > 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] 205597.0 205471.0 211064.0 212856.0 217036.0 219302.0 219759.0 221388.0 [9] 220834.0 221788.0 222358.0 222972.0 224164.0 224915.0 226294.0 224690.0 [17] 227021.0 229284.0 229189.0 230032.0 229389.0 231053.0 232560.0 232681.0 [25] 231555.0 231428.0 232141.0 234939.0 235424.0 235471.0 236355.0 238693.0 [33] 236958.0 237060.0 239282.0 238252.0 241552.0 236230.0 238909.0 240723.0 [41] 242120.0 242100.0 243276.0 244677.0 243494.0 244902.0 245247.0 245578.0 [49] 243052.0 238121.0 241863.0 241203.0 243634.0 242351.0 245180.0 246126.0 [57] 244424.0 245166.0 247258.0 245094.0 246020.0 243082.0 245555.0 243685.0 [65] 247277.0 245029.0 246169.0 246778.0 244577.0 246048.0 245775.0 245328.0 [73] 245477.0 241903.0 243219.0 248088.0 248521.0 247389.0 249057.0 248916.0 [81] 249193.0 250768.0 253106.0 249829.0 249447.0 246755.0 250785.0 250140.0 [89] 255755.0 254671.0 253919.0 253741.0 252729.0 253810.0 256653.0 255231.0 [97] 258405.0 251061.0 254811.0 254895.0 258325.0 257608.0 258759.0 258621.0 [105] 257852.0 260560.0 262358.0 260812.0 261165.0 257164.0 260720.0 259581.0 [113] 264743.0 261845.0 262262.0 261631.0 258953.0 259966.0 262850.0 262204.0 [121] 263418.0 262752.0 266433.0 267722.0 266003.0 262971.0 265521.0 264676.0 [129] 270223.0 269508.0 268457.0 265814.0 266680.0 263018.0 269285.0 269829.0 [137] 270911.0 266844.0 271244.0 269907.0 271296.0 270157.0 271322.0 267179.0 [145] 264101.0 265518.0 269419.0 268714.0 272482.0 268351.0 268175.0 270674.0 [153] 272764.0 272599.0 270333.0 270846.0 270491.0 269160.0 274027.0 273784.0 [161] 276663.0 274525.0 271344.0 271115.0 270798.0 273911.0 273985.0 271917.0 [169] 273338.0 270601.0 273547.0 275363.0 281229.0 277793.0 279913.0 282500.0 [177] 280041.0 282166.0 290304.0 283519.0 284578.9 282396.4 286259.3 286755.4 [185] 290009.0 287331.7 288128.9 288848.0 288741.0 289946.9 292043.2 289280.0 > (perc.se <- (ub-forecast$pred)/1.96/forecast$pred) Time Series: Start = 181 End = 192 Frequency = 1 [1] 0.006798376 0.008290266 0.009385911 0.010436797 0.011276551 0.012271616 [7] 0.013065044 0.013808595 0.014548704 0.015184893 0.015737222 0.016528236 > postscript(file="/var/www/html/rcomp/tmp/1cma21229420939.ps",horizontal=F,pagecentre=F,paper="special",width=13.888888888889,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.se <- array(0, dim=fx) > perf.mse <- 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.mape[i] = perf.mape[i] + abs(perf.pe[i]) + perf.se[i] = (x[nx+i] - forecast$pred[i])^2 + perf.mse[i] = perf.mse[i] + perf.se[i] + 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 = perf.mape / fx > perf.mse = perf.mse / fx > perf.rmse = sqrt(perf.mse) > postscript(file="/var/www/html/rcomp/tmp/2fmjl1229420939.ps",horizontal=F,pagecentre=F,paper="special",width=13.888888888889,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:12] <- 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/386vg1229420939.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.mape[i],4)) + a<-table.element(a,round(perf.se[i],4)) + a<-table.element(a,round(perf.mse[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/4741j1229420939.tab") > > system("convert tmp/1cma21229420939.ps tmp/1cma21229420939.png") > system("convert tmp/2fmjl1229420939.ps tmp/2fmjl1229420939.png") > > > proc.time() user system elapsed 0.744 0.345 0.935