R version 2.10.1 (2009-12-14)
Copyright (C) 2009 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.

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(1772.2
+ ,1769.5
+ ,1768
+ ,1794.8
+ ,1823.4
+ ,1856.9
+ ,1866.9
+ ,1869.8
+ ,1843.8
+ ,1837.1
+ ,1857.7
+ ,1840.3
+ ,1914.6
+ ,1972.9
+ ,2050.1
+ ,2086.2
+ ,2112.5
+ ,2147.6
+ ,2190.4
+ ,2194.1
+ ,2216.2
+ ,2218.6
+ ,2233.5
+ ,2307.2
+ ,2350.4
+ ,2368.2
+ ,2353.8
+ ,2316.5
+ ,2305.5
+ ,2308.4
+ ,2334.4
+ ,2381.2
+ ,2449.7
+ ,2490.3
+ ,2523.5
+ ,2537.6
+ ,2526.1
+ ,2545.9
+ ,2542.7
+ ,2584.3
+ ,2600.2
+ ,2593.9
+ ,2618.9
+ ,2591.3
+ ,2521.2
+ ,2536.6
+ ,2596.1
+ ,2656.6
+ ,2710.3
+ ,2778.8
+ ,2775.5
+ ,2785.2
+ ,2847.7
+ ,2834.4
+ ,2839
+ ,2802.6
+ ,2819.3
+ ,2872
+ ,2918.4
+ ,2977.8
+ ,3031.2
+ ,3064.7
+ ,3093
+ ,3100.6
+ ,3141.1
+ ,3180.4
+ ,3240.3
+ ,3265
+ ,3338.2
+ ,3376.6
+ ,3422.5
+ ,3432
+ ,3516.3
+ ,3564
+ ,3636.3
+ ,3724
+ ,3815.4
+ ,3828.1
+ ,3853.3
+ ,3884.5
+ ,3918.7
+ ,3919.6
+ ,3950.8
+ ,3981
+ ,4063
+ ,4132
+ ,4160.3
+ ,4178.3
+ ,4244.1
+ ,4256.5
+ ,4283.4
+ ,4263.3
+ ,4256.6
+ ,4264.3
+ ,4302.3
+ ,4256.6
+ ,4374
+ ,4398.8
+ ,4433.9
+ ,4446.3
+ ,4525.8
+ ,4633.1
+ ,4677.5
+ ,4754.5
+ ,4876.2
+ ,4932.6
+ ,4906.3
+ ,4953.1
+ ,4909.6
+ ,4922.2
+ ,4873.5
+ ,4854.3
+ ,4795.3
+ ,4831.9
+ ,4913.3
+ ,4977.5
+ ,5090.7
+ ,5128.9
+ ,5154.1
+ ,5191.5
+ ,5251.8
+ ,5356.1
+ ,5451.9
+ ,5450.8
+ ,5469.4
+ ,5684.6
+ ,5740.3
+ ,5816.2
+ ,5825.9
+ ,5831.4
+ ,5873.3
+ ,5889.5
+ ,5908.5
+ ,5787.4
+ ,5776.6
+ ,5883.5
+ ,6005.7
+ ,5957.8
+ ,6030.2
+ ,5955.1
+ ,5857.3
+ ,5889.1
+ ,5866.4
+ ,5871
+ ,5944
+ ,6077.6
+ ,6197.5
+ ,6325.6
+ ,6448.3
+ ,6559.6
+ ,6623.3
+ ,6677.3
+ ,6740.3
+ ,6797.3
+ ,6903.5
+ ,6955.9
+ ,7022.8
+ ,7051
+ ,7119
+ ,7153.4
+ ,7193
+ ,7269.5
+ ,7332.6
+ ,7458
+ ,7496.6
+ ,7592.9
+ ,7632.1
+ ,7734
+ ,7806.6
+ ,7865
+ ,7927.4
+ ,7944.7
+ ,8027.7
+ ,8059.6
+ ,8059.5
+ ,7988.9
+ ,7950.2
+ ,8003.8
+ ,8037.5
+ ,8069
+ ,8157.6
+ ,8244.3
+ ,8329.4
+ ,8417
+ ,8432.5
+ ,8486.4
+ ,8531.1
+ ,8643.8
+ ,8727.9
+ ,8847.3
+ ,8904.3
+ ,9003.2
+ ,9025.3
+ ,9044.7
+ ,9120.7
+ ,9184.3
+ ,9247.2
+ ,9407.1
+ ,9488.9
+ ,9592.5
+ ,9666.2
+ ,9809.6
+ ,9932.7
+ ,10008.9
+ ,10103.4
+ ,10194.3
+ ,10328.8
+ ,10507.6
+ ,10601.2
+ ,10684
+ ,10819.9
+ ,11014.3
+ ,11043
+ ,11258.5
+ ,11267.9
+ ,11334.5
+ ,11297.2
+ ,11371.3
+ ,11340.1
+ ,11380.1
+ ,11477.9
+ ,11538.8
+ ,11596.4
+ ,11598.8
+ ,11645.8
+ ,11738.7
+ ,11935.5
+ ,12042.8
+ ,12127.6
+ ,12213.8
+ ,12303.5
+ ,12410.3
+ ,12534.1
+ ,12587.5
+ ,12683.2
+ ,12748.7
+ ,12915.9
+ ,12962.5
+ ,12965.9
+ ,13060.7
+ ,13099.9
+ ,13204
+ ,13321.1
+ ,13391.2
+ ,13366.9
+ ,13415.3
+ ,13324.6
+ ,13141.9
+ ,12925.4
+ ,12901.5
+ ,12973
+ ,13155)
> par3 = 'multiplicative'
> par2 = 'Double'
> par1 = '4'
> #'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 without seasonal component.

Call:
 HoltWinters(x = x, gamma = F) 

Smoothing parameters:
 alpha:  1 
 beta :  0.3495989 
 gamma:  FALSE 

Coefficients:
         [,1]
a 13155.00000
b    43.92936
> myresid <- x - fit$fitted[,'xhat']
> postscript(file="/var/www/rcomp/tmp/1hpud1275575812.ps",horizontal=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/rcomp/tmp/2hpud1275575812.ps",horizontal=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/rcomp/tmp/3sgtg1275575812.ps",horizontal=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/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab
> load(file="/var/www/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/rcomp/tmp/4dzr31275575812.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/rcomp/tmp/5zh891275575812.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/rcomp/tmp/6r97c1275575812.tab") 
> 
> try(system("convert tmp/1hpud1275575812.ps tmp/1hpud1275575812.png",intern=TRUE))
character(0)
> try(system("convert tmp/2hpud1275575812.ps tmp/2hpud1275575812.png",intern=TRUE))
character(0)
> try(system("convert tmp/3sgtg1275575812.ps tmp/3sgtg1275575812.png",intern=TRUE))
character(0)
> 
> 
> proc.time()
   user  system elapsed 
  1.430   0.610   1.479