x <- c(64800,62400,66000,52800,68400,67200,72000,74400,82800,72000,68400,85200,72000,54000,63600,48000,67200,55200,73200,66000,69600,78000,76800,91200,66000,55200,61200,44400,63600,49200,69600,66000,58800,84000,75600,86400,64800,60000,54000,44400,58800,52800,72000,69600,60000,80400,74400,96000,76800,46800,46800,46800,55200,55200,74400,68400,61200,76800,70800,102000,80400,46800,49200,40800,56400,64800,81600,80400,64800,75600,67200,96000,73200,58800,52800,39600,58800,70800,82800,78000,57600,82800,64800,99600,82800,60000,55200,37200,58800,56400,85200,85200,64800,84000,62400,97200,82800,61200,46800,32400,63600,61200,80400,92400,68400,76800,57600,99600)
par3 = 'multiplicative'
par2 = 'Single'
par1 = '12'
par3 <- 'multiplicative'
par2 <- 'Single'
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/1z2121437479769.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/2ut8v1437479769.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/32bth1437479769.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/4m8ka1437479769.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/511841437479769.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/6qhqy1437479769.tab") 

try(system("convert tmp/1z2121437479769.ps tmp/1z2121437479769.png",intern=TRUE))
try(system("convert tmp/2ut8v1437479769.ps tmp/2ut8v1437479769.png",intern=TRUE))
try(system("convert tmp/32bth1437479769.ps tmp/32bth1437479769.png",intern=TRUE))

