Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data:
3500 3400 3600 3650 3950 3850 3450 3650 3900 3900 4100 3900 3700 3600 3750 3800 4050 3950 3600 3650 3800 4050 4100 4000 3700 3650 3750 4050 4300 4150 3750 3900 4100 4300 4500 4400 4050 4050 4300 4450 4650 4600 4150 4350 4550 4700 5050 4900 4250 4400 4600 4650 4800 4750 4300 4350 4750 4900 5100 4950 4450 4600 4700 4850 4800 4900 4400 4550 4950 5050 5250 4950 4500 4600 4800 4950 5150 5250 4550 4800 5200 5350 5750 5200 4950 5150 5200 5300 5800 5500 5000 5100 5500 5800 6000 5600 5400 5350 5300 5550 5750 5800
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)
1
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)
1
0
1
2
Degree of seasonal differencing (D)
1
0
1
Seasonal period (s)
12
1
2
3
4
6
12
AR(p) order
1
0
1
2
3
MA(q) order
0
0
1
2
SAR(P) order
0
0
1
2
SMA(Q) order
0
0
1
Include mean?
FALSE
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