R version 2.12.2 (2011-02-25)
Copyright (C) 2011 The R Foundation for Statistical Computing
ISBN 3-900051-07-0
Platform: x86_64-redhat-linux-gnu (64-bit)

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(1686,1591,2304,1712,1471,1377,1966,2453,1984,2596,4087,5179,1530,1523,1633,1976,1170,1480,1781,2472,1981,2273,3857,4551,1510,1329,1518,1790,1537,1449,1954,1897,1706,2514,3593,4524,1609,1638,2030,1375,1320,1245,1600,2298,2191,2511,3440,4923,1609,1435,2061,1789,1567,1404,1597,3159,1759,2504,4273,5274,1771,1682,1846,1589,1896,1379,1645,2512,1771,3727,4388,5434,1606,1523,1577,1605,1765,1403,2584,3318,1562,2349,3987,5891,1389,1442,1548,1935,1518,1250,1847,1930,2638,3114,4405,7242,1853,1779,2108,2336,1728,1661,2230,1645,2421,3740,4988,6757,1757,1394,1982,1650,1654,1406,1971,1968,2608,3845,4514,6694,1720,1321,1859,1628,1615,1457,1899,1605,2424,3116,4286,6047,1902,2049,1874,1279,1432,1540,2214,1857,2408,3252,3627,6153,1577,1667,1993,1997,1783,1625,2076,1773,2377,3088,4096,6119,1494,1564,1898,2121,1831,1515,2048,2795,1749,3339,4227,6410,1197,1968,1720,1725,1674,1693,2031,1495,2968,3385,3729,5999,1070,1402,1897,1862,1670,1688,2031)
> par3 = 'multiplicative'
> par2 = 'Triple'
> par1 = '12'
> #'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 with trend and multiplicative seasonal component.

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

Smoothing parameters:
 alpha:  0.05132263 
 beta :  0.09667565 
 gamma:  0.2890214 

Coefficients:
            [,1]
a   2415.6631641
b     -3.0317941
s1     0.8037111
s2     0.9766764
s3     1.3295366
s4     1.6410895
s5     2.5065521
s6     0.5671589
s7     0.6676439
s8     0.7644929
s9     0.7501331
s10    0.6882362
s11    0.6543232
s12    0.8336252
> myresid <- x - fit$fitted[,'xhat']
> postscript(file="/var/www/wessaorg/rcomp/tmp/1wiw21305722472.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/wessaorg/rcomp/tmp/2htys1305722472.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/wessaorg/rcomp/tmp/31c641305722472.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/wessaorg/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab
> load(file="/var/www/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/www/wessaorg/rcomp/tmp/4uezp1305722472.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/wessaorg/rcomp/tmp/5qbd41305722472.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/wessaorg/rcomp/tmp/6t7j81305722472.tab") 
> 
> try(system("convert tmp/1wiw21305722472.ps tmp/1wiw21305722472.png",intern=TRUE))
character(0)
> try(system("convert tmp/2htys1305722472.ps tmp/2htys1305722472.png",intern=TRUE))
character(0)
> try(system("convert tmp/31c641305722472.ps tmp/31c641305722472.png",intern=TRUE))
character(0)
> 
> 
> proc.time()
   user  system elapsed 
  2.910   0.280   3.267