Home » date » 2009 » Dec » 08 »

*The author of this computation has been verified* R Software Module: /rwasp_arimaforecasting.wasp (opens new window with default values) Title produced by software: ARIMA Forecasting Date of computation: Tue, 08 Dec 2009 10:38:30 -0700   Cite this page as follows: Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL http://www.freestatistics.org/blog/date/2009/Dec/08/t1260294423rfvpfxesvgzx0xj.htm/, Retrieved Mon, 20 May 2013 13:55:00 +0000   Original text written by user:   IsPrivate? No (this computation is public)   User-defined keywords:   System-generated keywords (parent): (pk = 0) Estimated Impact 56   Dataseries X: » Textfile « » CSV « » Stem and Leaf « » Histogram « » Kernel Density « » Harrell-Davis Quantiles « » Central Tendency « » Variability « 15836,8 17570,4 18252,1 16196,7 16643 17729 16446,1 15993,8 16373,5 17842,2 22321,5 22786,7 18274,1 22392,9 23899,3 21343,5 22952,3 21374,4 21164,1 20906,5 17877,4 20664,3 22160 19813,6 17735,4 19640,2 20844,4 19823,1 18594,6 21350,6 18574,1 18924,2 17343,4 19961,2 19932,1 19464,6 16165,4 17574,9 19795,4 19439,5 17170 21072,4 17751,8 17515,5 18040,3 19090,1 17746,5 19202,1 15141,6 16258,1 18586,5 17209,4 17838,7 19123,5 16583,6 15991,2 16704,4 17420,4 17872 17823,2   Output produced by software: Summary of computational transaction Raw Input view raw input (R code) Raw Output view raw output of R engine Computing time 2 seconds R Server 'Gwilym Jenkins' @ 72.249.127.135 Univariate ARIMA Extrapolation Forecast time Y[t] F[t] 95% LB 95% UB p-value (H0: Y[t] = F[t]) P(F[t]>Y[t-1]) P(F[t]>Y[t-s]) P(F[t]>Y[48]) 36 19464.6 - - - - - - - 37 16165.4 - - - - - - - 38 17574.9 - - - - - - - 39 19795.4 - - - - - - - 40 19439.5 - - - - - - - 41 17170 - - - - - - - 42 21072.4 - - - - - - - 43 17751.8 - - - - - - - 44 17515.5 - - - - - - - 45 18040.3 - - - - - - - 46 19090.1 - - - - - - - 47 17746.5 - - - - - - - 48 19202.1 - - - - - - - 49 15141.6 14165.2682 12212.8708 16293.8667 0.1843 0 0.0328 0 50 16258.1 15764.5458 13436.3454 18319.3879 0.3525 0.6836 0.0824 0.0042 51 18586.5 18703.3819 15448.6553 22338.2262 0.4749 0.9063 0.278 0.394 52 17209.4 16977.6011 13052.1574 21537.4666 0.4603 0.2446 0.145 0.1695 53 17838.7 15638.462 11627.2985 20382.3584 0.1817 0.2582 0.2634 0.0705 54 19123.5 19399.7742 14166.9738 25647.9041 0.4655 0.6878 0.2999 0.5247 55 16583.6 15550.7918 10554.5502 21749.0947 0.372 0.1293 0.2432 0.1241 56 15991.2 16049.9498 10674.3022 22788.8138 0.4932 0.4383 0.335 0.1796 57 16704.4 16236.2102 10381.3531 23723.8372 0.4512 0.5256 0.3184 0.2188 58 17420.4 16996.1861 10646.246 25201.0634 0.4596 0.5278 0.3085 0.2991 59 17872 16221.7385 9798.8201 24671.7029 0.3509 0.3905 0.3618 0.2447 60 17823.2 17201.2015 10176.9642 26536.8478 0.4481 0.444 0.3372 0.3372 Univariate ARIMA Extrapolation Forecast Performance time % S.E. PE MAPE Sq.E MSE RMSE 49 0.0767 0.0689 0 953223.7722 0 0 50 0.0827 0.0313 0.0501 243595.7537 598409.7629 773.5695 51 0.0992 -0.0062 0.0355 13661.3864 403493.6374 635.2115 52 0.137 0.0137 0.03 53730.7244 316052.9092 562.1858 53 0.1548 0.1407 0.0522 4841047.3353 1221051.7944 1105.0121 54 0.1643 -0.0142 0.0458 76327.4555 1030264.4046 1015.0194 55 0.2034 0.0664 0.0488 1066692.8643 1035468.4702 1017.5797 56 0.2142 -0.0037 0.0431 3451.5345 906466.3533 952.0853 57 0.2353 0.0288 0.0416 219201.7231 830103.6166 911.1002 58 0.2463 0.025 0.0399 179957.4752 765089.0025 874.6937 59 0.2658 0.1017 0.0455 2723363.133 943113.9234 971.1405 60 0.2769 0.0362 0.0447 386882.1955 896761.2794 946.9748   Charts produced by software: http://www.freestatistics.org/blog/date/2009/Dec/08/t1260294423rfvpfxesvgzx0xj/15y151260293908.png (opens in new window) http://www.freestatistics.org/blog/date/2009/Dec/08/t1260294423rfvpfxesvgzx0xj/15y151260293908.ps (opens in new window) Click here to open pdf file. http://www.freestatistics.org/blog/date/2009/Dec/08/t1260294423rfvpfxesvgzx0xj/2xgsr1260293908.png (opens in new window) http://www.freestatistics.org/blog/date/2009/Dec/08/t1260294423rfvpfxesvgzx0xj/2xgsr1260293908.ps (opens in new window) Click here to open pdf file.   Parameters (Session): par1 = 12 ; par2 = 0.4 ; par3 = 1 ; par4 = 1 ; par5 = 12 ; par6 = 3 ; par7 = 2 ; par8 = 0 ; par9 = 0 ; par10 = FALSE ;   Parameters (R input): par1 = 12 ; par2 = 0.4 ; par3 = 1 ; par4 = 1 ; par5 = 12 ; par6 = 3 ; par7 = 2 ; par8 = 0 ; par9 = 0 ; par10 = FALSE ;   R code (references can be found in the software module): 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')) (forecast <- predict(arima.out,par1)) (lb <- forecast$pred - 1.96 * forecast$se) (ub <- forecast$pred + 1.96 * forecast$se) 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)) (perc.se <- (ub-forecast$pred)/1.96/forecast$pred) bitmap(file='test1.png') 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() 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) bitmap(file='test2.png') 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() load(file='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<br />(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='mytable.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='mytable1.tab')