Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data:
3650 3530 3800 4130 3440 4000 3690 4210 4240 4260 4510 4260 3420 3660 3790 3270 3250 3570 3410 4270 4410 4450 3990 4000 4140 3800 3060 3270 3040 3750 3330 3840 4060 3830 3880 3820 3640 2880 3710 2980 3190 3090 3190 3410 3310 3480 3750 3200 3150 3250 3290 2900 2940 3460 3890 3040 3000 3520 2850 2730 2820 3240 3160 3010 2720 2650 2790 3090 3240 3690 3490 2790 3060 3210 3080 2640 2890 3330 2970 2870 3140 3150 2940 2910 3060 2900 2980 2890 2920 2940 3300 3050 2740 3080 3090 2830 3390 3210 2970 2810 2690 2800 2920 2870 2860 3090 3180 3090
Sample Range:
(leave blank to include all observations)
From:
To:
Testing Period
(?)
12
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Box-Cox lambda transformation parameter (lambda)
Triple
1
-2.0
-1.9
-1.8
-1.7
-1.6
-1.5
-1.4
-1.3
-1.2
-1.1
-1.0
-0.9
-0.8
-0.7
-0.6
-0.5
-0.4
-0.3
-0.2
-0.1
0.0
0.1
0.2
0.3
0.4
0.5
0.6
0.7
0.8
0.9
1.0
1.1
1.2
1.3
1.4
1.5
1.6
1.7
1.8
1.9
2.0
Degree of non-seasonal differencing (d)
additive
0
1
2
Degree of seasonal differencing (D)
12
0
1
Seasonal period (s)
1
2
3
4
6
12
AR(p) order
0
1
2
3
MA(q) order
0
1
2
SAR(P) order
0
1
2
SMA(Q) order
0
1
Include mean?
FALSE
TRUE
Chart options
R Code
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*2 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.spe <- array(0, dim=fx) perf.scalederr <- array(0, dim=fx) perf.mase <- array(0, dim=fx) perf.mase1 <- array(0, dim=fx) perf.mape <- array(0, dim=fx) perf.smape <- array(0, dim=fx) perf.mape1 <- array(0, dim=fx) perf.smape1 <- 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) perf.scaleddenom <- 0 for (i in 2:fx) { perf.scaleddenom = perf.scaleddenom + abs(x[nx+i] - x[nx+i-1]) } perf.scaleddenom = perf.scaleddenom / (fx-1) for (i in 1:fx) { locSD <- (ub[i] - forecast$pred[i]) / 1.96 perf.scalederr[i] = (x[nx+i] - forecast$pred[i]) / perf.scaleddenom perf.pe[i] = (x[nx+i] - forecast$pred[i]) / x[nx+i] perf.spe[i] = 2*(x[nx+i] - forecast$pred[i]) / (x[nx+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.smape[1] = abs(perf.spe[1]) perf.mape1[1] = perf.mape[1] perf.smape1[1] = perf.smape[1] perf.mse[1] = perf.se[1] perf.mase[1] = abs(perf.scalederr[1]) perf.mase1[1] = perf.mase[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.smape[i] = perf.smape[i-1] + abs(perf.spe[i]) perf.smape1[i] = perf.smape[i] / i perf.mse[i] = perf.mse[i-1] + perf.se[i] perf.mse1[i] = perf.mse[i] / i perf.mase[i] = perf.mase[i-1] + abs(perf.scalederr[i]) perf.mase1[i] = perf.mase[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',10,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,'sMAPE',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.element(a,'ScaledE',1,header=TRUE) a<-table.element(a,'MASE',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.smape1[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.element(a,round(perf.scalederr[i],4)) a<-table.element(a,round(perf.mase1[i],4)) a<-table.row.end(a) } a<-table.end(a) table.save(a,file='mytable1.tab')
Compute
Summary of computational transaction
Raw Input
view raw input (R code)
Raw Output
view raw output of R engine
Computing time
0 seconds
R Server
Big Analytics Cloud Computing Center
Click here to blog (archive) this computation