## Free Statistics

of Irreproducible Research!

Author's title
Author*Unverified author*
R Software Modulerwasp_arimaforecasting.wasp
Title produced by softwareARIMA Forecasting
Date of computationFri, 19 Jul 2019 12:07:27 +0200
Cite this page as followsStatistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?v=date/2019/Jul/19/t15635314530i7hwhzebu2n3ok.htm/, Retrieved Fri, 25 Sep 2020 03:57:30 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=318850, Retrieved Fri, 25 Sep 2020 03:57:30 +0000
QR Codes:

Original text written by user:1276.16 1273.61 1847.83 1675.77 1370.59
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact23
Family? (F = Feedback message, R = changed R code, M = changed R Module, P = changed Parameters, D = changed Data)
-       [ARIMA Forecasting] [i want to calcula...] [2019-07-19 10:07:27] [d41d8cd98f00b204e9800998ecf8427e] [Current]
Feedback Forum

Post a new message
Dataseries X:
1276.16
1273.61
1847.83
1675.77
1370.59

 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 R Engine error message Error in x[1:nx] : only 0's may be mixed with negative subscripts Calls: arima -> NCOL Execution halted 

\begin{tabular}{lllllllll}
\hline
Summary of computational transaction \tabularnewline
Raw Input view raw input (R code)  \tabularnewline
Raw Outputview raw output of R engine  \tabularnewline
Computing time0 seconds \tabularnewline
R ServerBig Analytics Cloud Computing Center \tabularnewline
R Engine error message & Error in x[1:nx] : only 0's may be mixed with negative subscripts
Calls: arima -> NCOL
Execution halted
\tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=318850&T=0

[TABLE]
[ROW]
 Summary of computational transaction[/C][/ROW] [ROW] Raw Input[/C] view raw input (R code) [/C][/ROW] [ROW] Raw Output[/C] view raw output of R engine [/C][/ROW] [ROW] Computing time[/C] 0 seconds[/C][/ROW] [ROW] R Server[/C] Big Analytics Cloud Computing Center[/C][/ROW] [ROW] R Engine error message[/C][C]Error in x[1:nx] : only 0's may be mixed with negative subscripts Calls: arima -> NCOL Execution halted [/C][/ROW] [/TABLE] Source: https://freestatistics.org/blog/index.php?pk=318850&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=318850&T=0

As an alternative you can also use a QR Code:

The GUIDs for individual cells are displayed in the table below:

 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 R Engine error message Error in x[1:nx] : only 0's may be mixed with negative subscripts Calls: arima -> NCOL Execution halted 

Parameters (Session):
Parameters (R input):
par1 = 1 ; par2 = 1 ; par3 = 0 ; par4 = 1 ; par5 = 1 ; par6 = 1 ; par7 = 0 ; par8 = 0 ; par9 = 0 ; par10 = FALSE ;
R code (references can be found in the software module):
par10 <- 'FALSE'par9 <- '0'par8 <- '0'par7 <- '0'par6 <- '1'par5 <- '1'par4 <- '1'par3 <- '1'par2 <- '1'par1 <- '2'par1 <- as.numeric(par1) #cut off periodspar2 <- as.numeric(par2) #lambdapar3 <- as.numeric(par3) #degree of non-seasonal differencingpar4 <- as.numeric(par4) #degree of seasonal differencingpar5 <- as.numeric(par5) #seasonal periodpar6 <- as.numeric(par6) #ppar7 <- as.numeric(par7) #qpar8 <- as.numeric(par8) #Ppar9 <- as.numeric(par9) #Qif (par10 == 'TRUE') par10 <- TRUEif (par10 == 'FALSE') par10 <- FALSEif (par2 == 0) x <- log(x)if (par2 != 0) x <- x^par2lx <- length(x)first <- lx - 2*par1nx <- lx - par1nx1 <- nx + 1fx <- lx - nxif (fx < 1) {fx <- par5*2nx1 <- lx + fx - 1first <- lx - 2*fx}first <- 1if (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 <- lblb <- ubub <- 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 <- 0for (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.96perf.scalederr[i] = (x[nx+i] - forecast$pred[i]) / perf.scaleddenomperf.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])^2prob.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] / iperf.smape[i] = perf.smape[i-1] + abs(perf.spe[i])perf.smape1[i] = perf.smape[i] / iperf.mse[i] = perf.mse[i-1] + perf.se[i]perf.mse1[i] = perf.mse[i] / iperf.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$preddum[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',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')