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

40,7819
39,5915
38,8859
39,9068
41,47
41,5613
41,6005
41,4113
41,84
42,2892
43,1521
43,5998
43,116
42,4185
42,3687
42,2975
42,8528
43,535
44,7265
45,7293
45,7585
46,1685
46,5075
46,527
46,601
46,4607
46,7135
46,4113
45,55
44,6081
44,4395
44,9847
45,7558
45,3942
45,697
45,5664
46,0205
45,9195
45,8005
45,535
45,4977
45,5782
45,7697
45,2445
45,0615
45,2865
44,791
44,7625
44,7644
44,9973
44,7265
45,1465
44,7465
45,1795
45,6515
45,492
45,2775
45,2115
45,411
45,4005
44,7692
44,8913
45,032
44,879
44,833
44,8257
44,7815
44,479
44,6317
44,5043
44,3217
44,1005
44,047
43,6835
43,7864
44,1807
43,9595
43,937
43,991
43,865
43,671
43,93
43,863
43,7095
43,9435
43,736
43,6295
43,598
43,8726
43,8935
43,5957
43,7155
43,528
43,3415
43,3374
43,332
43,3869
43,5016
43,4875
43,6023
43,3886
43,3105
43,4455
43,5185
43,5755
43,6217
43,644
43,5789
43,5215
43,5033
43,632
43,263
43,3717
43,2745
43,2647
43,324
43,4455
43,4098
43,41
43,93
43,8104
43,54
43,858
43,8375
43,881
43,887
43,8009
43,7877
43,811
44,0625
44,125
44,52
45,4005
45,89
45,189
44,9035
44,9351
44,801
43,98
44,11
44,2661
44,361
44,099
43,8435
43,8914
44,217
44,506
44,54
44,4465
44,842
44,8946
44,951
45,445
45,0035
45,769
46,09
45,412
45,12
45,48
45,105
45,056
45,22
45,39
45,041
44,9399
44,9315
45,1935
45,3466
45,4645
45,5685
45,3921
45,34
45,1308
45,1005
45,37
45,2
44,9614
44,8015
44,9152
45,095
44,9271
44,6026
44,5
44,54
44,5532
44,407
44,259
44,1365
44,112
43,8814
43,98
43,7294
43,9119
43,955
43,9
43,7065
43,6939
43,6587
43,5885
43,8885
43,8216
43,751
43,699
43,7425
43,639
43,589
43,606
43,5325
43,385
43,3745
43,236
43,1957
43,01
43,1401
43,0487
43,1972
43,2461
43,0866
43,0865
43,0194
43,08
43,007
42,9278
42,9545
42,7995
42,9048
42,9468
43,08
43,1274
43,1625
43,45
43,831
43,7769
43,98
43,92
44,11
44,03
44,1582
44,14
45,07
44,8737
44,8505
44,373
44,075
43,9725
44,094
44,191
43,9685
43,79
43,6041
43,1707
42,71
42,755
43,3316
43,5
43,154
43,16
43,1
42,85
42,6175
42,5
42,6285
42,6974
43,04
42,673
42,5015
42,538
42,3735
42,014
41,8618
42,1824
42,605
42,7345
42,615
42,465
42,34
42,251
42,0475
41,86
41,685
41,735
41,706
41,764
41,58
41,373
41,088
41,137
41,1587
41,185
40,819
40,633
40,858
40,794
40,69
40,595
40,7305
40,5471
40,5145
40,7
40,7
40,522
40,6165
40,3985
40,2815
40,245
40,3055
40,2696
40,251
40,127
39,95
39,675
39,954
39,8828
39,62
39,5415
39,525
39,8145
39,6675
39,695
39,5985
39,2735
39,1435
39,1742
39,2025
39,3946
39,5025
39,4845
39,33
39,295
39,2675
39,2535
38,9845
38,9285
38,8592
38,77
38,79
38,8205
38,7577
38,839
38,78
38,54
38,511
38,615
38,898
38,8691
38,384
38,0277
37,72
37,7325
37,626
37,603
37,78
38,559
39,0459
38,45
38,505
38,2885
37,795
37,92
38,034
38,029
38,063
37,9828
37,745
37,969
38,007
38,0615
38,0912
38,091
38,431
38,48
38,35
38,214
38,384
38,1375
38,0075
38,0524
38,235
38,31
38,2615
38,13
38,282
38,581
39,0801
39,0387
39,1015
39,1503
39,14
39,0275
38,7665
38,691
38,849
39,1644
39,4907
39,5095
39,2795
39,0437
39,1355
39,143
39,185
39,355
39,297
39,4514
39,4173
39,4305
39,384
39,3261
39,301
39,35
39,64
39,4723
39,3685
39,1906
39,1183
39,1325
39,1144
39,1614
39,0908
38,9199
38,913
38,9655
39,029
39,089
39,07
39,0046
39,1038
39,3572
39,388
39,382
39,4398
39,2537
39,2301
39,2763
39,282
39,3325
39,557
40,1
40,5875
40,485
40,55
40,7955
41,456
41,3557
41,374
41,2235
41,15
41,3725
41,6923
41,8
41,8045
41,64
41,36
41,5745
41,593
41,575
41,68
42,0055
42,3188
42,565
42,3575
42,29
42,695
43,0028
42,4507
42,4705
42,2875
42,3172
42,55
42,7523
42,8993
43,1555
43,1885
43,43
43,31
42,815
42,7017
42,28
41,922
42,17
42,1962
42,3215
42,3173
42,391
42,463
42,4125
42,304
41,813
41,651
41,539
41,1575
40,9545

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 <- 5 #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')