R version 2.8.0 (2008-10-20)
Copyright (C) 2008 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.

  Natural language support but running in an English locale

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(14.458,13.594,17.814,20.235,21.811,21.439,21.393,19.831,20.468,21.080,21.600,17.390,17.848,19.592,21.092,20.899,25.890,24.965,22.225,20.977,22.897,22.785,22.769,19.637,20.203,20.450,23.083,21.738,26.766,25.280,22.574,22.729,21.378,22.902,24.989,21.116,15.169,15.846,20.927,18.273,22.538,15.596,14.034,11.366,14.861,15.149,13.577,13.026,13.190,13.196,15.826,14.733,16.307,15.703,14.589,12.043,15.057,14.053,12.698,10.888,10.045,11.549,13.767,12.434,13.116,14.211,12.266,12.602,15.714,13.742,12.745,10.491,10.057,10.900,11.771,11.992,11.933,14.504,11.727,11.477,13.578,11.555,11.846,11.397,10.066,10.269,14.279,13.870,13.695,14.420,11.424,9.704,12.464,14.301,13.464,9.893,11.572,12.380,16.692,16.052,16.459,14.761,13.654,13.480,18.068,16.560,14.530,10.650,11.651,13.735,13.360,17.818,20.613,16.231,13.862,12.004,17.734,15.034,12.609,12.320,10.833,11.350,13.648,14.890,16.325,18.045,15.616,11.926,16.855,15.083,12.520,12.355)
> par20 = ''
> par19 = ''
> par18 = ''
> par17 = ''
> par16 = ''
> par15 = ''
> par14 = ''
> par13 = ''
> par12 = ''
> par11 = ''
> par10 = ''
> par9 = ''
> par8 = ''
> par7 = ''
> par6 = ''
> par5 = ''
> par4 = ''
> par3 = 'additive'
> par2 = 'Triple'
> par1 = '12'
> ylab = ''
> xlab = ''
> main = ''
> #'GNU S' R Code compiled by R2WASP v. 1.0.44 ()
> #Author: Prof. Dr. P. Wessa
> #To cite this work: Wessa P., (2010), Exponential Smoothing (v1.0.4) in Free Statistics Software (v$_version), Office for Research Development and Education, URL http://www.wessa.net/rwasp_exponentialsmoothing.wasp/
> #Source of accompanying publication: 
> #Technical description: 
> 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
Holt-Winters exponential smoothing without trend and with additive seasonal component.

Call:
 HoltWinters(x = x, seasonal = par3) 

Smoothing parameters:
 alpha:  0.4472017 
 beta :  0 
 gamma:  0.4749295 

Coefficients:
          [,1]
a   14.2650410
s1  -2.6734472
s2  -1.8049519
s3   0.2698527
s4   1.0899009
s5   2.1226500
s6   1.3915868
s7  -0.7703528
s8  -2.3535660
s9   2.1592891
s10  0.5919630
s11 -0.9547282
s12 -2.1312530
> myresid <- x - fit$fitted[,'xhat']
> postscript(file="/var/www/html/freestat/rcomp/tmp/1jlsi1293206647.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()
null device 
          1 
> postscript(file="/var/www/html/freestat/rcomp/tmp/2jlsi1293206647.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()
null device 
          1 
> postscript(file="/var/www/html/freestat/rcomp/tmp/3tcrl1293206647.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()
null device 
          1 
> 
> #Note: the /var/www/html/freestat/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab
> load(file="/var/www/html/freestat/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/www/html/freestat/rcomp/tmp/4xupr1293206647.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/www/html/freestat/rcomp/tmp/50v6x1293206647.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/www/html/freestat/rcomp/tmp/6t4501293206647.tab") 
> 
> try(system("convert tmp/1jlsi1293206647.ps tmp/1jlsi1293206647.png",intern=TRUE))
character(0)
> try(system("convert tmp/2jlsi1293206647.ps tmp/2jlsi1293206647.png",intern=TRUE))
character(0)
> try(system("convert tmp/3tcrl1293206647.ps tmp/3tcrl1293206647.png",intern=TRUE))
character(0)
> 
> 
> proc.time()
   user  system elapsed 
  1.485   0.770   1.701