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 computationSun, 18 Apr 2010 10:20:29 +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/18/t1271586087gtb9plywafn15vv.htm/, Retrieved Fri, 29 Mar 2024 06:58:45 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=74662, Retrieved Fri, 29 Mar 2024 06:58:45 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywordsmissingvalue,B22,steven,coomans,thesis
Estimated Impact222
Family? (F = Feedback message, R = changed R code, M = changed R Module, P = changed Parameters, D = changed Data)
-       [Croston Forecasting] [missingvalue,B22,...] [2010-04-18 10:20:29] [d41d8cd98f00b204e9800998ecf8427e] [Current]
Feedback Forum

Post a new message
Dataseries X:
840,875
1051,8
854,835
849,2
625,1
964,775
887,225
1010,45
1131,25
718,2
1088,5
1271,375
1098,375
1098,375
1195,05
1361,375
1361,375
1100,625
1190,375
1250,485
1087,575
992,05
810
1064,95
937,25
1039
1122,956
1079,5
1079,5
889,5
784,5
793,75
924,5
762,43
811,5
942,94
812,615
911,735
1009,25
1116,01
1116,01
988,16
1067,52
1082,53
1043,215
871,83
904,485
689,56
1082,78
1098,85
713,5
704,5
0
652,25
563
586
538,75
353,6
321,275
388,4
329,6
323
520,25
607,725
803,45
677,25
711
962,5
935,6
722,255
594,25
853,75
766,5
758,05
756,85
685,4
696,525
610,025
708,325
619,1
740,525
730,5
489,75
766,525




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

\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
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=74662&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]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=74662&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=74662&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







Demand Forecast
PointForecast95% LB80% LB80% UB95% UB
85690.881799688875317.257512089300446.582009245998935.1815901317521064.50608728845
86690.881799688875315.394037748312445.363548867194936.4000505105561066.36956162944
87690.881799688875313.539765918483444.151105687009937.612493690741068.22383345927
88690.881799688875311.694561595584442.944591430924938.8190079468261070.06903778217
89690.881799688875309.858293044388441.743919961904940.0196794158461071.90530633336
90690.881799688875308.030831688918440.549007208634941.2145921691151073.73276768883
91690.881799688875306.212052007378439.359771096826942.4038282809241075.55154737037
92690.881799688875304.401831431541438.176131483423943.5874678943271077.36176794621
93690.881799688875302.600050250361436.998010093580944.765589284171079.16354912739
94690.881799688875300.806591517584435.82533046025945.93826891751080.95700786017

\begin{tabular}{lllllllll}
\hline
Demand Forecast \tabularnewline
Point & Forecast & 95% LB & 80% LB & 80% UB & 95% UB \tabularnewline
85 & 690.881799688875 & 317.257512089300 & 446.582009245998 & 935.181590131752 & 1064.50608728845 \tabularnewline
86 & 690.881799688875 & 315.394037748312 & 445.363548867194 & 936.400050510556 & 1066.36956162944 \tabularnewline
87 & 690.881799688875 & 313.539765918483 & 444.151105687009 & 937.61249369074 & 1068.22383345927 \tabularnewline
88 & 690.881799688875 & 311.694561595584 & 442.944591430924 & 938.819007946826 & 1070.06903778217 \tabularnewline
89 & 690.881799688875 & 309.858293044388 & 441.743919961904 & 940.019679415846 & 1071.90530633336 \tabularnewline
90 & 690.881799688875 & 308.030831688918 & 440.549007208634 & 941.214592169115 & 1073.73276768883 \tabularnewline
91 & 690.881799688875 & 306.212052007378 & 439.359771096826 & 942.403828280924 & 1075.55154737037 \tabularnewline
92 & 690.881799688875 & 304.401831431541 & 438.176131483423 & 943.587467894327 & 1077.36176794621 \tabularnewline
93 & 690.881799688875 & 302.600050250361 & 436.998010093580 & 944.76558928417 & 1079.16354912739 \tabularnewline
94 & 690.881799688875 & 300.806591517584 & 435.82533046025 & 945.9382689175 & 1080.95700786017 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=74662&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]85[/C][C]690.881799688875[/C][C]317.257512089300[/C][C]446.582009245998[/C][C]935.181590131752[/C][C]1064.50608728845[/C][/ROW]
[ROW][C]86[/C][C]690.881799688875[/C][C]315.394037748312[/C][C]445.363548867194[/C][C]936.400050510556[/C][C]1066.36956162944[/C][/ROW]
[ROW][C]87[/C][C]690.881799688875[/C][C]313.539765918483[/C][C]444.151105687009[/C][C]937.61249369074[/C][C]1068.22383345927[/C][/ROW]
[ROW][C]88[/C][C]690.881799688875[/C][C]311.694561595584[/C][C]442.944591430924[/C][C]938.819007946826[/C][C]1070.06903778217[/C][/ROW]
[ROW][C]89[/C][C]690.881799688875[/C][C]309.858293044388[/C][C]441.743919961904[/C][C]940.019679415846[/C][C]1071.90530633336[/C][/ROW]
[ROW][C]90[/C][C]690.881799688875[/C][C]308.030831688918[/C][C]440.549007208634[/C][C]941.214592169115[/C][C]1073.73276768883[/C][/ROW]
[ROW][C]91[/C][C]690.881799688875[/C][C]306.212052007378[/C][C]439.359771096826[/C][C]942.403828280924[/C][C]1075.55154737037[/C][/ROW]
[ROW][C]92[/C][C]690.881799688875[/C][C]304.401831431541[/C][C]438.176131483423[/C][C]943.587467894327[/C][C]1077.36176794621[/C][/ROW]
[ROW][C]93[/C][C]690.881799688875[/C][C]302.600050250361[/C][C]436.998010093580[/C][C]944.76558928417[/C][C]1079.16354912739[/C][/ROW]
[ROW][C]94[/C][C]690.881799688875[/C][C]300.806591517584[/C][C]435.82533046025[/C][C]945.9382689175[/C][C]1080.95700786017[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=74662&T=1

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=74662&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
85690.881799688875317.257512089300446.582009245998935.1815901317521064.50608728845
86690.881799688875315.394037748312445.363548867194936.4000505105561066.36956162944
87690.881799688875313.539765918483444.151105687009937.612493690741068.22383345927
88690.881799688875311.694561595584442.944591430924938.8190079468261070.06903778217
89690.881799688875309.858293044388441.743919961904940.0196794158461071.90530633336
90690.881799688875308.030831688918440.549007208634941.2145921691151073.73276768883
91690.881799688875306.212052007378439.359771096826942.4038282809241075.55154737037
92690.881799688875304.401831431541438.176131483423943.5874678943271077.36176794621
93690.881799688875302.600050250361436.998010093580944.765589284171079.16354912739
94690.881799688875300.806591517584435.82533046025945.93826891751080.95700786017







\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=74662&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=74662&T=2

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=74662&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#output',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