R version 2.9.0 (2009-04-17) Copyright (C) 2009 The R Foundation for Statistical Computing ISBN 3-900051-07-0 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > x <- c(647.5,174,781,277.1,653,435.75,613.775,509.75,509.75,314.5,486,212,503.825,435,563,457.05,451.25,500.75,437.75,470.5,0,313.25,314,454,570.5,485,243,310,421.752,494.5,253.5,417.5,182.826,339.25,199,412.25,438.25,356,266.25,235.25,323.775,305.25,383.527,515.25,496.15,115.25,170.5,154.25,170,534.05,193.75,564.5,346,308.25,437.05,410.275,149.75,154.75,240.1,127.525,222.25,85.525,427.75,63.5,118.3,99.5,182.25,401,119.5,450.25,147.5,237,80.025,10.5,176.75,234,282.5,320,167.5,163.25,238.15,325.125,126.3,154.875,327.25,336.25,188,277.25) > par10 = '0.1' > par9 = '3' > par8 = 'B28Acrostonm' > par7 = 'dum' > par6 = '12' > par5 = 'ZZZ' > par4 = 'NA' > par3 = 'NA' > par2 = 'Croston' > par1 = 'Input box' > par10 <- '0.1' > par9 <- '3' > par8 <- 'B28Acrostonm' > par7 <- 'dum' > par6 <- '12' > par5 <- 'ZZZ' > par4 <- 'NA' > par3 <- 'NA' > par2 <- 'Croston' > par1 <- 'Input box' > #'GNU S' R Code compiled by R2WASP v. 1.0.44 () > #Author: Dr. Ian E. Holliday > #To cite this work: Ian E. Holliday, 2009, YOUR SOFTWARE TITLE (vNUMBER) in Free Statistics Software (v$_version), Office for Research Development and Education, URL http://www.wessa.net/rwasp_YOURPAGE.wasp/ > #Source of accompanying publication: > #Technical description: > 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) Loading required package: tseries Loading required package: quadprog Loading required package: zoo Attaching package: 'zoo' The following object(s) are masked from package:base : as.Date.numeric This is forecast 2.03 > 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) + } Forecast method: Croston's method Model Information: $demand Point Forecast Lo 80 Hi 80 Lo 95 Hi 95 88 233.2086 57.76485 408.6524 -35.10949 501.5268 89 233.2086 56.88981 409.5275 -36.44774 502.8650 90 233.2086 56.01909 410.3982 -37.77939 504.1967 91 233.2086 55.15264 411.2646 -39.10452 505.5218 92 233.2086 54.29037 412.1269 -40.42323 506.8405 93 233.2086 53.43225 412.9850 -41.73563 508.1529 94 233.2086 52.57820 413.8391 -43.04178 509.4591 95 233.2086 51.72817 414.6891 -44.34179 510.7591 96 233.2086 50.88210 415.5352 -45.63574 512.0530 97 233.2086 50.03994 416.3773 -46.92371 513.3410 $period Point Forecast Lo 80 Hi 80 Lo 95 Hi 95 88 1.000096 0.8574806 1.142710 0.7819849 1.218206 89 1.000096 0.8567693 1.143422 0.7808970 1.219294 90 1.000096 0.8560615 1.144129 0.7798146 1.220376 91 1.000096 0.8553572 1.144834 0.7787374 1.221454 92 1.000096 0.8546563 1.145535 0.7776654 1.222526 93 1.000096 0.8539587 1.146232 0.7765986 1.223592 94 1.000096 0.8532645 1.146926 0.7755369 1.224654 95 1.000096 0.8525735 1.147617 0.7744801 1.225711 96 1.000096 0.8518858 1.148305 0.7734283 1.226763 97 1.000096 0.8512012 1.148990 0.7723813 1.227810 In-sample error measures: ME RMSE MAE MPE MAPE MASE -48.63331 151.39991 118.65254 -Inf Inf 0.76934 Forecasts: Point Forecast 89 233.1864 90 233.1864 91 233.1864 92 233.1864 93 233.1864 94 233.1864 95 233.1864 96 233.1864 97 233.1864 98 233.1864 > postscript(file="/var/www/html/rcomp/tmp/1j24c1272277941.ps",horizontal=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) > 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() null device 1 > postscript(file="/var/www/html/rcomp/tmp/2tclf1272277941.ps",horizontal=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) > 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() null device 1 > > #Note: the /var/www/html/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab > load(file="/var/www/html/rcomp/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="/var/www/html/rcomp/tmp/3xu231272277941.tab") > a<-table.start() > a<-table.row.start(a) > a<-table.element(a,'Actuals and Interpolation',3,TRUE) > a<-table.row.end(a) > a<-table.row.start(a) > a<-table.element(a,'Time',header=TRUE) > a<-table.element(a,'Actual',header=TRUE) > a<-table.element(a,'Forecast',header=TRUE) > a<-table.row.end(a) > for (i in 1:n) { + a<-table.row.start(a) + a<-table.element(a,i,header=TRUE) + a<-table.element(a,x[i]) + a<-table.element(a,x[i] - as.numeric(m$resid[i])) + a<-table.row.end(a) + } > a<-table.end(a) > table.save(a,file="/var/www/html/rcomp/tmp/40di91272277941.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('http://www.wessa.net/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('http://www.wessa.net/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('http://www.wessa.net/Patrick.Wessa/rwasp_demand_forecasting_analysis.wasp',sep=''),'Forecast Analysis','',target='')) > a<-table.row.end(a) > a<-table.end(a) > table.save(a,file="/var/www/html/rcomp/tmp/5bmib1272277941.tab") > try(system("convert tmp/1j24c1272277941.ps tmp/1j24c1272277941.png",intern=TRUE)) character(0) > try(system("convert tmp/2tclf1272277941.ps tmp/2tclf1272277941.png",intern=TRUE)) character(0) > > #-SERVER-wessa.org > > > > proc.time() user system elapsed 3.981 0.375 4.291