Home » date » 2010 » Dec » 14 »

Paper - ARIMA Forecasting

*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, 14 Dec 2010 16:47:42 +0000

Cite this page as follows:

Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL http://www.freestatistics.org/blog/date/2010/Dec/14/t1292345204p5xe3hdtrcigwbg.htm/, Retrieved Sat, 25 May 2013 05:50:51 +0000

Original text written by user:

IsPrivate?

No (this computation is public)

User-defined keywords:

System-generated keywords (parent):

t1291721539tjsairkz9yxesbb (pk = 106189)

Estimated Impact

Dataseries X:

» Textfile « » CSV « » Stem and Leaf « » Histogram « » Kernel Density « » Harrell-Davis Quantiles « » Central Tendency « » Variability «

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	'RServer@AstonUniversity' @ vre.aston.ac.uk

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[105])
93	113.66	-	-	-	-	-	-	-
94	107.59	-	-	-	-	-	-	-
95	92.67	-	-	-	-	-	-	-
96	85.35	-	-	-	-	-	-	-
97	90.13	-	-	-	-	-	-	-
98	89.31	-	-	-	-	-	-	-
99	105.12	-	-	-	-	-	-	-
100	125.83	-	-	-	-	-	-	-
101	135.81	-	-	-	-	-	-	-
102	142.43	-	-	-	-	-	-	-
103	163.39	-	-	-	-	-	-	-
104	168.21	-	-	-	-	-	-	-
105	185.35	-	-	-	-	-	-	-
106	188.5	189.6452	141.4433	256.5365	0.4866	0.5501	0.9919	0.5501
107	199.91	192.7553	124.6425	304.0739	0.4499	0.5299	0.961	0.5519
108	210.73	194.9934	111.9891	350.7588	0.4215	0.4753	0.9162	0.5483
109	192.06	196.5968	101.7033	398.1285	0.4824	0.4453	0.8498	0.5435
110	204.62	197.7418	93.0907	446.6468	0.4784	0.5178	0.8034	0.5389
111	235	198.5577	85.7579	496.5231	0.4053	0.4841	0.7306	0.5346
112	261.09	199.1382	79.44	547.8918	0.3639	0.4201	0.6598	0.5309
113	256.88	199.5507	73.9434	600.8651	0.3897	0.3819	0.6222	0.5276
114	251.53	199.8436	69.1204	655.55	0.412	0.4031	0.5975	0.5249
115	257.25	200.0515	64.8562	712.054	0.4133	0.4219	0.5558	0.5224
116	243.1	200.1989	61.0596	770.4859	0.4414	0.4223	0.5438	0.5204
117	283.75	200.3035	57.6579	830.9559	0.3977	0.4471	0.5185	0.5185

Univariate ARIMA Extrapolation Forecast Performance
time	% S.E.	PE	MAPE	Sq.E	MSE	RMSE
106	0.18	-0.006	0	1.3114	0	0
107	0.2946	0.0371	0.0216	51.1893	26.2504	5.1235
108	0.4076	0.0807	0.0413	247.6407	100.0471	10.0024
109	0.523	-0.0231	0.0367	20.5823	80.1809	8.9544
110	0.6422	0.0348	0.0363	47.3092	73.6066	8.5794
111	0.7656	0.1835	0.0609	1328.0377	282.6784	16.813
112	0.8935	0.3111	0.0966	3838.0236	790.5849	28.1173
113	1.0261	0.2873	0.1205	3286.6474	1102.5927	33.2053
114	1.1634	0.2586	0.1358	2671.4833	1276.9139	35.7339
115	1.3058	0.2859	0.1508	3271.6728	1476.3898	38.4238
116	1.4534	0.2143	0.1566	1840.5037	1509.491	38.8522
117	1.6064	0.4166	0.1783	6963.3229	1963.977	44.3168

Charts produced by software:

http://www.freestatistics.org/blog/date/2010/Dec/14/t1292345204p5xe3hdtrcigwbg/17ez01292345259.png (opens in new window)

http://www.freestatistics.org/blog/date/2010/Dec/14/t1292345204p5xe3hdtrcigwbg/17ez01292345259.ps (opens in new window)

Click here to open pdf file.

http://www.freestatistics.org/blog/date/2010/Dec/14/t1292345204p5xe3hdtrcigwbg/2lox81292345259.png (opens in new window)

http://www.freestatistics.org/blog/date/2010/Dec/14/t1292345204p5xe3hdtrcigwbg/2lox81292345259.ps (opens in new window)

Click here to open pdf file.

Parameters (Session):

par1 = 12 ; par2 = -0.1 ; par3 = 1 ; par4 = 0 ; par5 = 12 ; par6 = 1 ; par7 = 1 ; par8 = 0 ; par9 = 0 ; par10 = FALSE ;

Parameters (R input):

par1 = 12 ; par2 = -0.1 ; par3 = 1 ; par4 = 0 ; par5 = 12 ; par6 = 1 ; par7 = 1 ; 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')