x <- c(-2.5,4.4,13.7,12.3,13.4,2.2,1.7,-7.2,-4.8,-2.9,-2.4,-2.5,-5.3,-7.1,-8,-8.9,-7.7,-1.1,4,9.6,10.9,13,14.9,20.1,10.8,11,3.8,10.8,7.6,10.2,2.2,-0.1,-1.7,-4.8,-9.9,-13.5,-18.1,-18,-15.7,-15.2,-15.1,-17.9,-14.5,-9.4,-4.2,-2.2,4.5,12.4,15.8,11.5,14.1,18.8,26.1,27.9,25.4,23.4,11.5,9.9,8.1,12.6,8.2,5.4,1,-2.9,-3.7,-7,-7.2,-11.8,-2.1,1.2,2.5,4.8,-6.6,-16,-22.7,-17.7,-18.2,-18.9,-16,-12.2,-17.1,-18.6,-17.5,-24.9) par3 = 'additive' par2 = 'Triple' par1 = '12' par3 <- 'additive' par2 <- 'Triple' par1 <- '12' #'GNU S' R Code compiled by R2WASP v. 1.2.327 () #Author: root #To cite this work: Wessa P., (2013), Exponential Smoothing (v1.0.5) in Free Statistics Software (v$_version), Office for Research Development and Education, URL http://www.wessa.net/rwasp_exponentialsmoothing.wasp/ #Source of accompanying publication: # par1 <- as.numeric(par1) if (par2 == 'Single') K <- 1 if (par2 == 'Double') K <- 2 if (par2 == 'Triple') K <- par1 nx <- length(x) nxmK <- nx - K x <- ts(x, frequency = par1) if (par2 == 'Single') fit <- HoltWinters(x, gamma=F, beta=F) if (par2 == 'Double') fit <- HoltWinters(x, gamma=F) if (par2 == 'Triple') fit <- HoltWinters(x, seasonal=par3) fit myresid <- x - fit$fitted[,'xhat'] postscript(file="/var/wessaorg/rcomp/tmp/19hwa1386847661.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) op <- par(mfrow=c(2,1)) plot(fit,ylab='Observed (black) / Fitted (red)',main='Interpolation Fit of Exponential Smoothing') plot(myresid,ylab='Residuals',main='Interpolation Prediction Errors') par(op) dev.off() postscript(file="/var/wessaorg/rcomp/tmp/2hmoc1386847661.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) p <- predict(fit, par1, prediction.interval=TRUE) np <- length(p[,1]) plot(fit,p,ylab='Observed (black) / Fitted (red)',main='Extrapolation Fit of Exponential Smoothing') dev.off() postscript(file="/var/wessaorg/rcomp/tmp/3na341386847661.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) op <- par(mfrow = c(2,2)) acf(as.numeric(myresid),lag.max = nx/2,main='Residual ACF') spectrum(myresid,main='Residals Periodogram') cpgram(myresid,main='Residal Cumulative Periodogram') qqnorm(myresid,main='Residual Normal QQ Plot') qqline(myresid) par(op) dev.off() #Note: the /var/wessaorg/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab load(file="/var/wessaorg/rcomp/createtable") a<-table.start() a<-table.row.start(a) a<-table.element(a,'Estimated Parameters of Exponential Smoothing',2,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Parameter',header=TRUE) a<-table.element(a,'Value',header=TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'alpha',header=TRUE) a<-table.element(a,fit$alpha) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'beta',header=TRUE) a<-table.element(a,fit$beta) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'gamma',header=TRUE) a<-table.element(a,fit$gamma) a<-table.row.end(a) a<-table.end(a) table.save(a,file="/var/wessaorg/rcomp/tmp/4467o1386847661.tab") a<-table.start() a<-table.row.start(a) a<-table.element(a,'Interpolation Forecasts of Exponential Smoothing',4,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'t',header=TRUE) a<-table.element(a,'Observed',header=TRUE) a<-table.element(a,'Fitted',header=TRUE) a<-table.element(a,'Residuals',header=TRUE) a<-table.row.end(a) for (i in 1:nxmK) { a<-table.row.start(a) a<-table.element(a,i+K,header=TRUE) a<-table.element(a,x[i+K]) a<-table.element(a,fit$fitted[i,'xhat']) a<-table.element(a,myresid[i]) a<-table.row.end(a) } a<-table.end(a) table.save(a,file="/var/wessaorg/rcomp/tmp/56c9p1386847661.tab") a<-table.start() a<-table.row.start(a) a<-table.element(a,'Extrapolation Forecasts of Exponential Smoothing',4,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'t',header=TRUE) a<-table.element(a,'Forecast',header=TRUE) a<-table.element(a,'95% Lower Bound',header=TRUE) a<-table.element(a,'95% Upper Bound',header=TRUE) a<-table.row.end(a) for (i in 1:np) { a<-table.row.start(a) a<-table.element(a,nx+i,header=TRUE) a<-table.element(a,p[i,'fit']) a<-table.element(a,p[i,'lwr']) a<-table.element(a,p[i,'upr']) a<-table.row.end(a) } a<-table.end(a) table.save(a,file="/var/wessaorg/rcomp/tmp/6vuho1386847661.tab") try(system("convert tmp/19hwa1386847661.ps tmp/19hwa1386847661.png",intern=TRUE)) try(system("convert tmp/2hmoc1386847661.ps tmp/2hmoc1386847661.png",intern=TRUE)) try(system("convert tmp/3na341386847661.ps tmp/3na341386847661.png",intern=TRUE))