Home » date » 2009 » Dec » 12 »

workshop 10 review

*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: Sat, 12 Dec 2009 12:25:39 -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/12/t1260646035oi7vorf8l9d05ec.htm/, Retrieved Sat, 25 May 2013 15:33:46 +0000

Original text written by user:

IsPrivate?

No (this computation is public)

User-defined keywords:

workshop 10 review

System-generated keywords (parent):

t1260384125tl6liipdotaet4b (pk = 65133)

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	1 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[168])
156	8.3	-	-	-	-	-	-	-
157	8.5	-	-	-	-	-	-	-
158	8.6	-	-	-	-	-	-	-
159	8.5	-	-	-	-	-	-	-
160	8.2	-	-	-	-	-	-	-
161	8.1	-	-	-	-	-	-	-
162	7.9	-	-	-	-	-	-	-
163	8.6	-	-	-	-	-	-	-
164	8.7	-	-	-	-	-	-	-
165	8.7	-	-	-	-	-	-	-
166	8.5	-	-	-	-	-	-	-
167	8.4	-	-	-	-	-	-	-
168	8.5	-	-	-	-	-	-	-
169	8.7	8.5	7.9411	9.0589	0.2415	0.5	0.5	0.5
170	8.7	8.5	7.7096	9.2904	0.31	0.31	0.4021	0.5
171	8.6	8.5	7.5319	9.4681	0.4198	0.3428	0.5	0.5
172	8.5	8.5	7.3822	9.6178	0.5	0.4304	0.7006	0.5
173	8.3	8.5	7.2502	9.7498	0.3769	0.5	0.7348	0.5
174	8	8.5	7.1309	9.8691	0.2371	0.6127	0.8048	0.5
175	8.2	8.5	7.0212	9.9788	0.3455	0.7462	0.4473	0.5
176	8.1	8.5	6.9191	10.0809	0.31	0.645	0.4021	0.5
177	8.1	8.5	6.8232	10.1768	0.32	0.68	0.4076	0.5
178	8	8.5	6.7325	10.2675	0.2896	0.6713	0.5	0.5
179	7.9	8.5	6.6463	10.3537	0.2629	0.7015	0.5421	0.5
180	7.9	8.5	6.5639	10.4361	0.2718	0.7282	0.5	0.5

Univariate ARIMA Extrapolation Forecast Performance
time	% S.E.	PE	MAPE	Sq.E	MSE	RMSE
169	0.0335	0.0235	0	0.04	0	0
170	0.0474	0.0235	0.0235	0.04	0.04	0.2
171	0.0581	0.0118	0.0196	0.01	0.03	0.1732
172	0.0671	0	0.0147	0	0.0225	0.15
173	0.075	-0.0235	0.0165	0.04	0.026	0.1612
174	0.0822	-0.0588	0.0235	0.25	0.0633	0.2517
175	0.0888	-0.0353	0.0252	0.09	0.0671	0.2591
176	0.0949	-0.0471	0.0279	0.16	0.0787	0.2806
177	0.1006	-0.0471	0.0301	0.16	0.0878	0.2963
178	0.1061	-0.0588	0.0329	0.25	0.104	0.3225
179	0.1113	-0.0706	0.0364	0.36	0.1273	0.3568
180	0.1162	-0.0706	0.0392	0.36	0.1467	0.383

Charts produced by software:

http://www.freestatistics.org/blog/date/2009/Dec/12/t1260646035oi7vorf8l9d05ec/1um911260645937.png (opens in new window)

http://www.freestatistics.org/blog/date/2009/Dec/12/t1260646035oi7vorf8l9d05ec/1um911260645937.ps (opens in new window)

Click here to open pdf file.

http://www.freestatistics.org/blog/date/2009/Dec/12/t1260646035oi7vorf8l9d05ec/20szv1260645937.png (opens in new window)

http://www.freestatistics.org/blog/date/2009/Dec/12/t1260646035oi7vorf8l9d05ec/20szv1260645937.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 = 0 ; par9 = 0 ; par10 = FALSE ;

Parameters (R input):

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