Home » date » 2010 » Dec » 21 »

ARIMA forecast

*Unverified author*

R Software Module: /rwasp_arimaforecasting.wasp (opens new window with default values)

Title produced by software: ARIMA Forecasting

Date of computation: Tue, 21 Dec 2010 13:22:00 +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/21/t1292937584rln0dg2mjbnr29b.htm/, Retrieved Thu, 23 May 2013 06:12:36 +0000

Original text written by user:

IsPrivate?

No (this computation is public)

User-defined keywords:

System-generated keywords (parent):

t1291652518es276rasvrbu71c (pk = 105675)

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[48])
36	1.4587	-	-	-	-	-	-	-
37	1.4876	-	-	-	-	-	-	-
38	1.5189	-	-	-	-	-	-	-
39	1.5783	-	-	-	-	-	-	-
40	1.5633	-	-	-	-	-	-	-
41	1.5554	-	-	-	-	-	-	-
42	1.5757	-	-	-	-	-	-	-
43	1.5593	-	-	-	-	-	-	-
44	1.466	-	-	-	-	-	-	-
45	1.4065	-	-	-	-	-	-	-
46	1.2759	-	-	-	-	-	-	-
47	1.2705	-	-	-	-	-	-	-
48	1.3954	-	-	-	-	-	-	-
49	1.2793	1.3885	1.3139	1.4631	0.0021	0.4278	0.0046	0.4278
50	1.2694	1.3765	1.271	1.482	0.0233	0.9645	0.0041	0.3627
51	1.3282	1.3569	1.2277	1.4862	0.3315	0.9079	4e-04	0.2798
52	1.323	1.358	1.2088	1.5072	0.3227	0.6524	0.0035	0.3118
53	1.4135	1.3628	1.196	1.5296	0.2756	0.6799	0.0118	0.3507
54	1.4042	1.3556	1.1729	1.5384	0.3012	0.2674	0.0091	0.3348
55	1.4253	1.3586	1.1612	1.556	0.2539	0.3254	0.0231	0.3574
56	1.4322	1.3879	1.1769	1.5989	0.3404	0.3642	0.2341	0.4723
57	1.4632	1.3987	1.1749	1.6225	0.2861	0.3847	0.4728	0.5116
58	1.4713	1.4361	1.2002	1.672	0.3849	0.4108	0.9084	0.6323
59	1.5016	1.436	1.1885	1.6834	0.3016	0.3898	0.905	0.626
60	1.4318	1.3984	1.1399	1.6568	0.3999	0.2168	0.509	0.509

Univariate ARIMA Extrapolation Forecast Performance
time	% S.E.	PE	MAPE	Sq.E	MSE	RMSE
49	0.0274	-0.0786	0	0.0119	0	0
50	0.0391	-0.0778	0.0782	0.0115	0.0117	0.1081
51	0.0486	-0.0212	0.0592	8e-04	0.0081	0.0898
52	0.0561	-0.0258	0.0509	0.0012	0.0064	0.0798
53	0.0625	0.0372	0.0481	0.0026	0.0056	0.0749
54	0.0688	0.0358	0.0461	0.0024	0.0051	0.0712
55	0.0741	0.0491	0.0465	0.0044	0.005	0.0705
56	0.0776	0.0319	0.0447	0.002	0.0046	0.0678
57	0.0816	0.0461	0.0448	0.0042	0.0045	0.0674
58	0.0838	0.0245	0.0428	0.0012	0.0042	0.0649
59	0.0879	0.0457	0.0431	0.0043	0.0042	0.065
60	0.0943	0.0239	0.0415	0.0011	0.004	0.063

Charts produced by software:

http://www.freestatistics.org/blog/date/2010/Dec/21/t1292937584rln0dg2mjbnr29b/17fr01292937716.png (opens in new window)

http://www.freestatistics.org/blog/date/2010/Dec/21/t1292937584rln0dg2mjbnr29b/17fr01292937716.ps (opens in new window)

Click here to open pdf file.

http://www.freestatistics.org/blog/date/2010/Dec/21/t1292937584rln0dg2mjbnr29b/23op91292937716.png (opens in new window)

http://www.freestatistics.org/blog/date/2010/Dec/21/t1292937584rln0dg2mjbnr29b/23op91292937716.ps (opens in new window)

Click here to open pdf file.

Parameters (Session):

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

Parameters (R input):

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