x <- c(106,105,104,102,122,121,106,96,97,97,98,100,106,104,107,112,140,140,134,128,133,139,140,143,152,146,146,155,180,182,177,165,174,174,175,180,184,186,186,192,215,221,222,207,215,212,206,219,222,217,218,225,251,264,264,258,267,258,253,272,275,268,286,293,314,328,326,325,333,332,320,338,344,338,363,375,403,414,411,405,410,416,396,412,422,418,444,453,491,498,489,494,497,500,481,499,509,499,528,537,576,582,584,594,594,598,580,589,595,584,616,622,662,669,679,688,689,690,672,690)
par3 = 'multiplicative'
par2 = 'Triple'
par1 = '12'
par3 <- 'multiplicative'
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/10qed1407943051.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/235871407943051.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/3xfzd1407943051.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/4zk0i1407943051.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/5ebwr1407943051.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/6a2sl1407943051.tab") 

try(system("convert tmp/10qed1407943051.ps tmp/10qed1407943051.png",intern=TRUE))
try(system("convert tmp/235871407943051.ps tmp/235871407943051.png",intern=TRUE))
try(system("convert tmp/3xfzd1407943051.ps tmp/3xfzd1407943051.png",intern=TRUE))

