• QR Code (size=2)
• QR Code (size=3)
• QR Code (size=4)
• QR Code (size=5)
• QR Code (size=6)

168.67
164.83
184.38
180.81
190.54
181.41
155.67
135.99
125.88
126.09
114.86
127.98
127.98
125.11
125.93
128.2
125.93
111.94
120.01
124.09
126.02
136.41
143.79
141.67
143.9
155
144.83
141.4
137
141.02
131.11
132.83
136.73
141.18
137.86
133.79
128.53
125.87
124.27
123.96
128.15
126.4
127.86
129.31
132.56
141.28
145.55
146.54
143.14
145.72
148.21
150.4
149.94
146.66
143.37
145.29
140.24
136.12
140.25
140.64
145.58
143.73
141.27
140.66
141.94
141.16
134.31
132.93
133.07
140.48
154.85
196.77
235.3
226.52
237.62
224.07
208.74
174.54
170.63
172.23
198.36
175.91
154.63
134.31
121.75
119.6
102.04
106.3
116.38
103.72
98.56
100.9
110
118.26
124.77
125.22
126.38
137.14
134.74
134.3
136.39
141.83
139.24
128.89
134.83
130.43
132.09
144.95
149.5
137.57
139.38
143.06
138.65
123.21
85.91
77.4
77.84
67.76
70.72
72.55
75.83
84.01
93.96
93.73
92.02
88.26
86.48
94.42
94.92
91.41
84.84
89.89
86.32
89.57
93.72
92.27
87.59
85.5
82.81
81.62
87.45
79.86
78.52
75.1
72.99
67.88
70.14
65.43
60.26
58.38
57.68
52.42
52.73
61.4
67.13
77.46
68.66
67.46
62.77
56.88
61.48
61.99
71.56
76.56
79.82
75.05
77.07
80
77.21
82.16
85.57
89.23
121.98
142.56
217.67
198.07
220.1
198.68
181.64
167.47
172.33
168.71
178.22
172.81
168.83
152.25
143.83
151.41
131.87
125.38
123.23
103.99
109.38
123.79
119.05
122.01
128.56
127.91
120.47
122.49
114.05
120.62
119.61
115.01
131.83
167.2
193.82
204.43
264.5
212.55
186.52
185.17
184.38
161.45
154.15
174.25
175.04
175.87
154.82
147.08
134.35
121.56
113.86
119.89
108.07
107.07
115.14
116.03
111.48
103.24
103.23
99.69
108.91
104.21
90.85
87.64
81.06
92.2
114.02
123.56
109.17
101.65
97.95
92.56
91.76
84.1
84.67
74.52
73.83
75.37
70.47
64.5
64.98
66.94
65.93
65.51
68.94
63.67
58.47
59.68
57.71
56.53
58.96
55.6
57.34
60.51
66.38
65.78
58.43
55.16
53.09
52.02
57.58
64.05
70.18
63.86
65.22
67.6
61.66
65.32
66.18
61.34
62.29
63.6
65.51
62.58
62.36
64.88
73.73
77.51
77.47
74.34
75.81
82.16
73.96
73.17
80.99
79.81
89.51
102.57
107.11
122.23
134.69
128.79
126.16
119.98
108.45
108.43
98.17
106.09
108.81
103.03
124.36
118.52
112.2
114.71
107.96
101.21
102.77
112.13
109.36
110.91
123.57
129.95
124.46
122.34
116.61
114.59
112.52
118.67
116.8
123.63
128.04
134.57
130.33
136.47
139.05
158.21
148.07
137.74
139.74
144.08
145.35
145.77
140.56
121.41
120.44
116.97
128.03
128.51
127.76
134.58
147.64
144.46
137.6
146.87
145.67
151.95
150.23
155.86
154.4
156.36
162.13
171.06
174.01
193.52
205.26
212.8
222.1

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
(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')