Free Statistics

of Irreproducible Research!

Author's title

Author*Unverified author*
R Software ModulePatrick.Wessarwasp_demand_forecasting_croston.wasp
Title produced by softwareCroston Forecasting
Date of computationTue, 06 Apr 2010 14:32:31 +0000
Cite this page as followsStatistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?v=date/2010/Apr/06/t12705644698qljfu1fg6o8nhw.htm/, Retrieved Wed, 24 Apr 2024 13:28:29 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=74612, Retrieved Wed, 24 Apr 2024 13:28:29 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywordsforecast, missing value, b511, steven, coomans, thesis
Estimated Impact247
Family? (F = Feedback message, R = changed R code, M = changed R Module, P = changed Parameters, D = changed Data)
-       [Croston Forecasting] [forecast, missing...] [2010-04-06 14:32:31] [d41d8cd98f00b204e9800998ecf8427e] [Current]
Feedback Forum

Post a new message
Dataseries X:
51.2
53.6
22.205
59
4.8
65.6
37
22.7
35.2
49
62
42
59
59
59.6
57.2
57.2
23.2
76.8
45.8
70.2
2
45.8
22.6
51.8
44
61
32
32
44
44
44
22.6
44.6
45.2
69
66
47
67.8
22.6
22.6
44.5
44.6
47
45.2
40.5
66
24.4
2.3
0
0
48
0
0
0
0
8
6
0
0

0.02
2
0
22
46.5
66
44
66
44
66
66
66
76
34
66
66
66
66
66
44
44
66
87.5




\begin{tabular}{lllllllll}
\hline
Summary of computational transaction \tabularnewline
Raw Input & view raw input (R code)  \tabularnewline
Raw Output & view raw output of R engine  \tabularnewline
Computing time & 5 seconds \tabularnewline
R Server & wessa.org @ wessa.org \tabularnewline
R Framework error message & 
Warning: there are blank lines in the 'Data' field.
Please, use NA for missing data - blank lines are simply
 deleted and are NOT treated as missing values.
\tabularnewline \hline \end{tabular} %Source: https://freestatistics.org/blog/index.php?pk=74612&T=0

[TABLE]
[ROW][C]Summary of computational transaction[/C][/ROW]
[ROW][C]Raw Input[/C][C]view raw input (R code) [/C][/ROW]
[ROW][C]Raw Output[/C][C]view raw output of R engine [/C][/ROW]
[ROW][C]Computing time[/C][C]5 seconds[/C][/ROW]
[ROW][C]R Server[/C][C]wessa.org @ wessa.org[/C][/ROW]
[ROW][C]R Framework error message[/C][C]
Warning: there are blank lines in the 'Data' field.
Please, use NA for missing data - blank lines are simply
 deleted and are NOT treated as missing values.
[/C][/ROW] [/TABLE] Source: https://freestatistics.org/blog/index.php?pk=74612&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=74612&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 Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time5 seconds
R Serverwessa.org @ wessa.org
R Framework error message
Warning: there are blank lines in the 'Data' field.
Please, use NA for missing data - blank lines are simply
 deleted and are NOT treated as missing values.







Demand Forecast
PointForecast95% LB80% LB80% UB95% UB
8457.458027984364817.558359428702031.36903701026883.547018958461697.3576965400275
8557.458027984364817.359357353528931.238916547342983.677139421386697.5566986152006
8657.458027984364817.161338022672231.109438666387483.806617302342297.7547179460574
8757.458027984364816.964287018910730.980593940487083.935462028242697.9517689498189
8857.458027984364816.768190274123030.852373170991784.063682797737998.1478656946065
8957.458027984364816.573034057566530.724767379851484.191288588878298.343021911163
9057.458027984364816.378804964657530.597767802279984.318288166449798.537251004072
9157.458027984364816.185489906226630.471365879729584.444690089000198.730566062503
9257.458027984364815.993076098225130.345553253159984.570502715569798.9229798705045
9357.458027984364815.801551051858930.220321756587684.69573421214299.1145049168707

\begin{tabular}{lllllllll}
\hline
Demand Forecast \tabularnewline
Point & Forecast & 95% LB & 80% LB & 80% UB & 95% UB \tabularnewline
84 & 57.4580279843648 & 17.5583594287020 & 31.369037010268 & 83.5470189584616 & 97.3576965400275 \tabularnewline
85 & 57.4580279843648 & 17.3593573535289 & 31.2389165473429 & 83.6771394213866 & 97.5566986152006 \tabularnewline
86 & 57.4580279843648 & 17.1613380226722 & 31.1094386663874 & 83.8066173023422 & 97.7547179460574 \tabularnewline
87 & 57.4580279843648 & 16.9642870189107 & 30.9805939404870 & 83.9354620282426 & 97.9517689498189 \tabularnewline
88 & 57.4580279843648 & 16.7681902741230 & 30.8523731709917 & 84.0636827977379 & 98.1478656946065 \tabularnewline
89 & 57.4580279843648 & 16.5730340575665 & 30.7247673798514 & 84.1912885888782 & 98.343021911163 \tabularnewline
90 & 57.4580279843648 & 16.3788049646575 & 30.5977678022799 & 84.3182881664497 & 98.537251004072 \tabularnewline
91 & 57.4580279843648 & 16.1854899062266 & 30.4713658797295 & 84.4446900890001 & 98.730566062503 \tabularnewline
92 & 57.4580279843648 & 15.9930760982251 & 30.3455532531599 & 84.5705027155697 & 98.9229798705045 \tabularnewline
93 & 57.4580279843648 & 15.8015510518589 & 30.2203217565876 & 84.695734212142 & 99.1145049168707 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=74612&T=1

[TABLE]
[ROW][C]Demand Forecast[/C][/ROW]
[ROW][C]Point[/C][C]Forecast[/C][C]95% LB[/C][C]80% LB[/C][C]80% UB[/C][C]95% UB[/C][/ROW]
[ROW][C]84[/C][C]57.4580279843648[/C][C]17.5583594287020[/C][C]31.369037010268[/C][C]83.5470189584616[/C][C]97.3576965400275[/C][/ROW]
[ROW][C]85[/C][C]57.4580279843648[/C][C]17.3593573535289[/C][C]31.2389165473429[/C][C]83.6771394213866[/C][C]97.5566986152006[/C][/ROW]
[ROW][C]86[/C][C]57.4580279843648[/C][C]17.1613380226722[/C][C]31.1094386663874[/C][C]83.8066173023422[/C][C]97.7547179460574[/C][/ROW]
[ROW][C]87[/C][C]57.4580279843648[/C][C]16.9642870189107[/C][C]30.9805939404870[/C][C]83.9354620282426[/C][C]97.9517689498189[/C][/ROW]
[ROW][C]88[/C][C]57.4580279843648[/C][C]16.7681902741230[/C][C]30.8523731709917[/C][C]84.0636827977379[/C][C]98.1478656946065[/C][/ROW]
[ROW][C]89[/C][C]57.4580279843648[/C][C]16.5730340575665[/C][C]30.7247673798514[/C][C]84.1912885888782[/C][C]98.343021911163[/C][/ROW]
[ROW][C]90[/C][C]57.4580279843648[/C][C]16.3788049646575[/C][C]30.5977678022799[/C][C]84.3182881664497[/C][C]98.537251004072[/C][/ROW]
[ROW][C]91[/C][C]57.4580279843648[/C][C]16.1854899062266[/C][C]30.4713658797295[/C][C]84.4446900890001[/C][C]98.730566062503[/C][/ROW]
[ROW][C]92[/C][C]57.4580279843648[/C][C]15.9930760982251[/C][C]30.3455532531599[/C][C]84.5705027155697[/C][C]98.9229798705045[/C][/ROW]
[ROW][C]93[/C][C]57.4580279843648[/C][C]15.8015510518589[/C][C]30.2203217565876[/C][C]84.695734212142[/C][C]99.1145049168707[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=74612&T=1

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

As an alternative you can also use a QR Code:  

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

Demand Forecast
PointForecast95% LB80% LB80% UB95% UB
8457.458027984364817.558359428702031.36903701026883.547018958461697.3576965400275
8557.458027984364817.359357353528931.238916547342983.677139421386697.5566986152006
8657.458027984364817.161338022672231.109438666387483.806617302342297.7547179460574
8757.458027984364816.964287018910730.980593940487083.935462028242697.9517689498189
8857.458027984364816.768190274123030.852373170991784.063682797737998.1478656946065
8957.458027984364816.573034057566530.724767379851484.191288588878298.343021911163
9057.458027984364816.378804964657530.597767802279984.318288166449798.537251004072
9157.458027984364816.185489906226630.471365879729584.444690089000198.730566062503
9257.458027984364815.993076098225130.345553253159984.570502715569798.9229798705045
9357.458027984364815.801551051858930.220321756587684.69573421214299.1145049168707







\begin{tabular}{lllllllll}
\hline
What is next? \tabularnewline
Simulate Time Series \tabularnewline
Generate Forecasts \tabularnewline
Forecast Analysis \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=74612&T=2

[TABLE]
[ROW][C]What is next?[/C][/ROW]
[ROW][C]Simulate Time Series[/C][/ROW]
[ROW][C]Generate Forecasts[/C][/ROW]
[ROW][C]Forecast Analysis[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=74612&T=2

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

As an alternative you can also use a QR Code:  

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

What is next?
Simulate Time Series
Generate Forecasts
Forecast Analysis



Parameters (Session):
par1 = Input box ; par2 = Croston ; par3 = NA ; par4 = NA ; par5 = ZZZ ; par6 = 12 ; par7 = dum ; par8 = dumresult ; par9 = 1 ; par10 = 0.1 ;
Parameters (R input):
par1 = Input box ; par2 = Croston ; par3 = NA ; par4 = NA ; par5 = ZZZ ; par6 = 12 ; par7 = dum ; par8 = dumresult ; par9 = 1 ; par10 = 0.1 ;
R code (references can be found in the software module):
if(par3!='NA') par3 <- as.numeric(par3) else par3 <- NA
if(par4!='NA') par4 <- as.numeric(par4) else par4 <- NA
par6 <- as.numeric(par6) #Seasonal Period
par9 <- as.numeric(par9) #Forecast Horizon
par10 <- as.numeric(par10) #Alpha
library(forecast)
if (par1 == 'CSV') {
xarr <- read.csv(file=paste('tmp/',par7,'.csv',sep=''),header=T)
numseries <- length(xarr[1,])-1
n <- length(xarr[,1])
nmh <- n - par9
nmhp1 <- nmh + 1
rarr <- array(NA,dim=c(n,numseries))
farr <- array(NA,dim=c(n,numseries))
parr <- array(NA,dim=c(numseries,8))
colnames(parr) = list('ME','RMSE','MAE','MPE','MAPE','MASE','ACF1','TheilU')
for(i in 1:numseries) {
sindex <- i+1
x <- xarr[,sindex]
if(par2=='Croston') {
if (i==1) m <- croston(x,alpha=par10)
if (i==1) mydemand <- m$model$demand[]
fit <- croston(x[1:nmh],h=par9,alpha=par10)
}
if(par2=='ARIMA') {
m <- auto.arima(ts(x,freq=par6),d=par3,D=par4)
mydemand <- forecast(m)
fit <- auto.arima(ts(x[1:nmh],freq=par6),d=par3,D=par4)
}
if(par2=='ETS') {
m <- ets(ts(x,freq=par6),model=par5)
mydemand <- forecast(m)
fit <- ets(ts(x[1:nmh],freq=par6),model=par5)
}
try(rarr[,i] <- mydemand$resid,silent=T)
try(farr[,i] <- mydemand$mean,silent=T)
if (par2!='Croston') parr[i,] <- accuracy(forecast(fit,par9),x[nmhp1:n])
if (par2=='Croston') parr[i,] <- accuracy(fit,x[nmhp1:n])
}
write.csv(farr,file=paste('tmp/',par8,'_f.csv',sep=''))
write.csv(rarr,file=paste('tmp/',par8,'_r.csv',sep=''))
write.csv(parr,file=paste('tmp/',par8,'_p.csv',sep=''))
}
if (par1 == 'Input box') {
numseries <- 1
n <- length(x)
if(par2=='Croston') {
m <- croston(x)
mydemand <- m$model$demand[]
}
if(par2=='ARIMA') {
m <- auto.arima(ts(x,freq=par6),d=par3,D=par4)
mydemand <- forecast(m)
}
if(par2=='ETS') {
m <- ets(ts(x,freq=par6),model=par5)
mydemand <- forecast(m)
}
summary(m)
}
bitmap(file='test1.png')
op <- par(mfrow=c(2,1))
if (par2=='Croston') plot(m)
if ((par2=='ARIMA') | par2=='ETS') plot(forecast(m))
plot(mydemand$resid,type='l',main='Residuals', ylab='residual value', xlab='time')
par(op)
dev.off()
bitmap(file='pic2.png')
op <- par(mfrow=c(2,2))
acf(mydemand$resid, lag.max=n/3, main='Residual ACF', ylab='autocorrelation', xlab='time lag')
pacf(mydemand$resid,lag.max=n/3, main='Residual PACF', ylab='partial autocorrelation', xlab='time lag')
cpgram(mydemand$resid, main='Cumulative Periodogram of Residuals')
qqnorm(mydemand$resid); qqline(mydemand$resid, col=2)
par(op)
dev.off()
load(file='createtable')
a<-table.start()
a<-table.row.start(a)
a<-table.element(a,'Demand Forecast',6,TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'Point',header=TRUE)
a<-table.element(a,'Forecast',header=TRUE)
a<-table.element(a,'95% LB',header=TRUE)
a<-table.element(a,'80% LB',header=TRUE)
a<-table.element(a,'80% UB',header=TRUE)
a<-table.element(a,'95% UB',header=TRUE)
a<-table.row.end(a)
for (i in 1:length(mydemand$mean)) {
a<-table.row.start(a)
a<-table.element(a,i+n,header=TRUE)
a<-table.element(a,as.numeric(mydemand$mean[i]))
a<-table.element(a,as.numeric(mydemand$lower[i,2]))
a<-table.element(a,as.numeric(mydemand$lower[i,1]))
a<-table.element(a,as.numeric(mydemand$upper[i,1]))
a<-table.element(a,as.numeric(mydemand$upper[i,2]))
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,'What is next?',1,TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,hyperlink(paste('https://automated.biganalytics.eu/Patrick.Wessa/rwasp_demand_forecasting_simulate.wasp',sep=''),'Simulate Time Series','',target=''))
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,hyperlink(paste('https://automated.biganalytics.eu/Patrick.Wessa/rwasp_demand_forecasting_croston.wasp',sep=''),'Generate Forecasts','',target=''))
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,hyperlink(paste('https://automated.biganalytics.eu/Patrick.Wessa/rwasp_demand_forecasting_analysis.wasp',sep=''),'Forecast Analysis','',target=''))
a<-table.row.end(a)
a<-table.end(a)
table.save(a,file='mytable0.tab')
-SERVER-wessa.org