Home » date » 2009 » Dec » 08 »

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, 08 Dec 2009 13:43:55 -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/t1260305084j0g24iy3ocynlop.htm/, Retrieved Sun, 26 May 2013 01:17:23 +0000

Original text written by user:

IsPrivate?

No (this computation is public)

User-defined keywords:

System-generated keywords (parent):

t12600957286fewvkzh8nlhc90 (pk = 64335)

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	'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[58])
46	7.2	-	-	-	-	-	-	-
47	7.5	-	-	-	-	-	-	-
48	7.3	-	-	-	-	-	-	-
49	7	-	-	-	-	-	-	-
50	7	-	-	-	-	-	-	-
51	7	-	-	-	-	-	-	-
52	7.2	-	-	-	-	-	-	-
53	7.3	-	-	-	-	-	-	-
54	7.1	-	-	-	-	-	-	-
55	6.8	-	-	-	-	-	-	-
56	6.4	-	-	-	-	-	-	-
57	6.1	-	-	-	-	-	-	-
58	6.5	-	-	-	-	-	-	-
59	7.7	7.5323	7.121	7.9436	0.2121	1	0.5612	1
60	7.9	7.5201	6.6892	8.351	0.1851	0.3356	0.6982	0.9919
61	7.5	6.8296	5.6835	7.9757	0.1258	0.0336	0.3854	0.7135
62	6.9	6.1789	4.8823	7.4754	0.1378	0.0229	0.1073	0.3137
63	6.6	5.8145	4.4672	7.1618	0.1266	0.0572	0.0423	0.1593
64	6.9	6.083	4.7115	7.4546	0.1215	0.23	0.0552	0.2756
65	7.7	6.5491	5.1361	7.9621	0.0552	0.3132	0.1488	0.5272
66	8	6.677	5.171	8.1831	0.0426	0.0915	0.291	0.5911
67	8	6.4193	4.7757	8.0629	0.0297	0.0297	0.3249	0.4617
68	7.7	5.8637	4.0886	7.6388	0.0213	0.0092	0.2769	0.2412
69	7.3	5.2794	3.4117	7.1472	0.017	0.0055	0.1946	0.1001
70	7.4	5.3694	3.4411	7.2978	0.0195	0.0249	0.1252	0.1252
71	8.1	6.3131	4.2306	8.3956	0.0463	0.1532	0.0959	0.4302
72	8.3	6.4199	4.0696	8.7703	0.0585	0.0806	0.1086	0.4734
73	8.2	5.9161	3.2635	8.5687	0.0457	0.0391	0.1209	0.3331

Univariate ARIMA Extrapolation Forecast Performance
time	% S.E.	PE	MAPE	Sq.E	MSE	RMSE
59	0.0279	0.0223	0.0015	0.0281	0.0019	0.0433
60	0.0564	0.0505	0.0034	0.1443	0.0096	0.0981
61	0.0856	0.0982	0.0065	0.4494	0.03	0.1731
62	0.1071	0.1167	0.0078	0.52	0.0347	0.1862
63	0.1182	0.1351	0.009	0.617	0.0411	0.2028
64	0.115	0.1343	0.009	0.6674	0.0445	0.2109
65	0.1101	0.1757	0.0117	1.3245	0.0883	0.2972
66	0.1151	0.1981	0.0132	1.7502	0.1167	0.3416
67	0.1306	0.2462	0.0164	2.4985	0.1666	0.4081
68	0.1545	0.3132	0.0209	3.372	0.2248	0.4741
69	0.1805	0.3827	0.0255	4.0826	0.2722	0.5217
70	0.1832	0.3782	0.0252	4.1232	0.2749	0.5243
71	0.1683	0.2831	0.0189	3.1931	0.2129	0.4614
72	0.1868	0.2928	0.0195	3.5346	0.2356	0.4854
73	0.2288	0.386	0.0257	5.2162	0.3477	0.5897

Charts produced by software:

http://www.freestatistics.org/blog/date/2009/Dec/08/t1260305084j0g24iy3ocynlop/1gacd1260305032.png (opens in new window)

http://www.freestatistics.org/blog/date/2009/Dec/08/t1260305084j0g24iy3ocynlop/1gacd1260305032.ps (opens in new window)

Click here to open pdf file.

http://www.freestatistics.org/blog/date/2009/Dec/08/t1260305084j0g24iy3ocynlop/2htp51260305032.png (opens in new window)

http://www.freestatistics.org/blog/date/2009/Dec/08/t1260305084j0g24iy3ocynlop/2htp51260305032.ps (opens in new window)

Click here to open pdf file.

Parameters (Session):

par1 = 1 ; par2 = 1 ; par3 = 0 ; par4 = 12 ; par5 = 1 ; par6 = 1 ; par7 = 0 ; par8 = 1 ;

Parameters (R input):

par1 = 1 ; par2 = 1 ; par3 = 0 ; par4 = 12 ; par5 = 1 ; par6 = 1 ; par7 = 0 ; par8 = 1 ;

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,fx))
(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.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)
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:12] <- 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.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='mytable1.tab')