R version 2.9.0 (2009-04-17)
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(423.4,404.1,500,472.6,496.1,562,434.8,538.2,577.6,518.1,625.2,561.2,523.3,536.1,607.3,637.3,606.9,652.9,617.2,670.4,729.9,677.2,710,844.3,748.2,653.9,742.6,854.2,808.4,1819,1936.5,1966.1,2083.1,1620.1,1527.6,1795,1685.1,1851.8,2164.4,1981.8,1726.5,2144.6,1758.2,1672.9,1837.3,1596.1,1446,1898.4,1964.1,1755.9,2255.3,1881.2,2117.9,1656.5,1544.1,2098.9,2133.3,1963.5,1801.2,2365.4,1936.5,1667.6,1983.5,2058.6,2448.3,1858.1,1625.4,2130.6,2515.7,2230.2,2086.9,2235,2100.2,2288.6,2490,2573.7,2543.8,2004.7,2390,2338.4,2724.5,2292.5,2386,2477.9,2337,2605.1,2560.8,2839.3,2407.2,2085.2,2735.6,2798.7,3053.2,2405,2471.9,2727.3,2790.7,2385.4,3206.6,2705.6,3518.4,1954.9,2584.3,2535.8,2685.9,2866,2236.6,2934.9,2668.6,2371.2,3165.9,2887.2,3112.2,2671.2,2432.6,2812.3,3095.7,2862.9,2607.3,2862.5)
> 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: AUTHOR(S), (YEAR), YOUR SOFTWARE TITLE (vNUMBER) in Free Statistics Software (v$_version), Office for Research Development and Education, URL http://www.wessa.net/rwasp_YOURPAGE.wasp/
> #Source of accompanying publication: Office for Research, Development, and Education
> #Technical description: Write here your technical program description (don't use hard returns!)
> 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=0, beta=0)
> if (par2 == 'Double') fit <- HoltWinters(x, gamma=0)
> 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.3462136 
 beta :  0 
 gamma:  0.383243 

Coefficients:
            [,1]
a   2701.7881527
b     11.3407488
s1     1.0265382
s2     0.9575606
s3     1.1453193
s4     1.0700066
s5     1.1171688
s6     0.8993888
s7     0.9654789
s8     1.0485207
s9     1.1470801
s10    1.0329269
s11    0.9491497
s12    1.0883018
> myresid <- x - fit$fitted[,'xhat']
> postscript(file="/var/www/html/rcomp/tmp/1gpsp1259786961.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/html/rcomp/tmp/22e9v1259786961.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/html/rcomp/tmp/33ki01259786961.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/html/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab
> load(file="/var/www/html/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/rcomp/tmp/43o2r1259786961.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/rcomp/tmp/5oyis1259786961.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/rcomp/tmp/6ctlt1259786961.tab") 
> system("convert tmp/1gpsp1259786961.ps tmp/1gpsp1259786961.png")
> system("convert tmp/22e9v1259786961.ps tmp/22e9v1259786961.png")
> system("convert tmp/33ki01259786961.ps tmp/33ki01259786961.png")
> 
> 
> proc.time()
   user  system elapsed 
  0.944   0.528   1.149