Home » date » 2009 » Dec » 15 »

Paper ARIMA F ICP

*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, 15 Dec 2009 13:21:11 -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/15/t1260908526g4od8fhirl6q7r1.htm/, Retrieved Tue, 21 May 2013 09:10:50 +0000

Original text written by user:

IsPrivate?

No (this computation is public)

User-defined keywords:

System-generated keywords (parent):

t126082566524w41yoqbjkdmdf (pk = 67691)

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[105])
93	118.85	-	-	-	-	-	-	-
94	119.41	-	-	-	-	-	-	-
95	120.43	-	-	-	-	-	-	-
96	120.87	-	-	-	-	-	-	-
97	119.31	-	-	-	-	-	-	-
98	122.24	-	-	-	-	-	-	-
99	123.14	-	-	-	-	-	-	-
100	123.39	-	-	-	-	-	-	-
101	124.46	-	-	-	-	-	-	-
102	125.33	-	-	-	-	-	-	-
103	124.17	-	-	-	-	-	-	-
104	125.48	-	-	-	-	-	-	-
105	125.35	-	-	-	-	-	-	-
106	125.15	125.4255	124.7158	126.1351	0.2234	0.5826	1	0.5826
107	124.31	125.8314	124.7854	126.8775	0.0022	0.8992	1	0.8165
108	124.14	126.0147	124.7125	127.3168	0.0024	0.9949	1	0.8415
109	121.81	124.3431	122.8271	125.8591	5e-04	0.6036	1	0.0965
110	124.62	127.0452	125.342	128.7484	0.0026	1	1	0.9745
111	123.93	127.3978	125.5261	129.2696	1e-04	0.9982	1	0.984
112	124.29	127.8336	125.8072	129.86	3e-04	0.9999	1	0.9919
113	124.16	128.2415	126.0714	130.4115	1e-04	0.9998	0.9997	0.9955
114	124.02	128.6142	126.3094	130.9189	0	0.9999	0.9974	0.9972
115	122	127.403	124.971	129.835	0	0.9968	0.9954	0.951
116	124.58	129.096	126.5431	131.6489	3e-04	1	0.9973	0.998
117	124.06	128.8838	126.2155	131.5522	2e-04	0.9992	0.9953	0.9953

Univariate ARIMA Extrapolation Forecast Performance
time	% S.E.	PE	MAPE	Sq.E	MSE	RMSE
106	0.0029	-0.0022	2e-04	0.0759	0.0063	0.0795
107	0.0042	-0.0121	0.001	2.3147	0.1929	0.4392
108	0.0053	-0.0149	0.0012	3.5144	0.2929	0.5412
109	0.0062	-0.0204	0.0017	6.4166	0.5347	0.7312
110	0.0068	-0.0191	0.0016	5.8817	0.4901	0.7001
111	0.0075	-0.0272	0.0023	12.0259	1.0022	1.0011
112	0.0081	-0.0277	0.0023	12.557	1.0464	1.0229
113	0.0086	-0.0318	0.0027	16.6585	1.3882	1.1782
114	0.0091	-0.0357	0.003	21.1062	1.7589	1.3262
115	0.0097	-0.0424	0.0035	29.1923	2.4327	1.5597
116	0.0101	-0.035	0.0029	20.3941	1.6995	1.3037
117	0.0106	-0.0374	0.0031	23.2694	1.9391	1.3925

Charts produced by software:

http://www.freestatistics.org/blog/date/2009/Dec/15/t1260908526g4od8fhirl6q7r1/167c21260908469.png (opens in new window)

http://www.freestatistics.org/blog/date/2009/Dec/15/t1260908526g4od8fhirl6q7r1/167c21260908469.ps (opens in new window)

Click here to open pdf file.

http://www.freestatistics.org/blog/date/2009/Dec/15/t1260908526g4od8fhirl6q7r1/2j8mf1260908469.png (opens in new window)

http://www.freestatistics.org/blog/date/2009/Dec/15/t1260908526g4od8fhirl6q7r1/2j8mf1260908469.ps (opens in new window)

Click here to open pdf file.

Parameters (Session):

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

Parameters (R input):

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