R version 2.12.0 (2010-10-15)
Copyright (C) 2010 The R Foundation for Statistical Computing
ISBN 3-900051-07-0
Platform: i486-pc-linux-gnu (32-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.

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(315.42
+ ,316.32
+ ,316.49
+ ,317.56
+ ,318.13
+ ,318.00
+ ,316.39
+ ,314.66
+ ,313.68
+ ,313.18
+ ,314.66
+ ,315.43
+ ,316.27
+ ,316.81
+ ,317.42
+ ,318.87
+ ,319.87
+ ,319.43
+ ,318.01
+ ,315.75
+ ,314.00
+ ,313.68
+ ,314.84
+ ,316.03
+ ,316.73
+ ,317.54
+ ,318.38
+ ,319.31
+ ,320.42
+ ,319.61
+ ,318.42
+ ,316.64
+ ,314.83
+ ,315.15
+ ,315.95
+ ,316.85
+ ,317.78
+ ,318.40
+ ,319.53
+ ,320.41
+ ,320.85
+ ,320.45
+ ,319.44
+ ,317.25
+ ,316.12
+ ,315.27
+ ,316.53
+ ,317.53
+ ,318.58
+ ,318.92
+ ,319.70
+ ,321.22
+ ,322.08
+ ,321.31
+ ,319.58
+ ,317.61
+ ,316.05
+ ,315.83
+ ,316.91
+ ,318.20
+ ,319.41
+ ,320.07
+ ,320.74
+ ,321.40
+ ,322.06
+ ,321.73
+ ,320.27
+ ,318.54
+ ,316.54
+ ,316.71
+ ,317.53
+ ,318.55
+ ,319.27
+ ,320.28
+ ,320.73
+ ,321.97
+ ,322.00
+ ,321.71
+ ,321.05
+ ,318.71
+ ,317.65
+ ,317.14
+ ,318.71
+ ,319.25
+ ,320.46
+ ,321.43
+ ,322.22
+ ,323.54
+ ,323.91
+ ,323.59
+ ,322.26
+ ,320.21
+ ,318.48
+ ,317.94
+ ,319.63
+ ,320.87
+ ,322.17
+ ,322.34
+ ,322.88
+ ,324.25
+ ,324.83
+ ,323.93
+ ,322.39
+ ,320.76
+ ,319.10
+ ,319.23
+ ,320.56
+ ,321.80
+ ,322.40
+ ,322.99
+ ,323.73
+ ,324.86
+ ,325.41
+ ,325.19
+ ,323.97
+ ,321.92
+ ,320.10
+ ,319.96
+ ,320.97
+ ,322.48
+ ,323.52
+ ,323.89
+ ,325.04
+ ,326.01
+ ,326.67
+ ,325.96
+ ,325.13
+ ,322.90
+ ,321.61
+ ,321.01
+ ,322.08
+ ,323.37
+ ,324.34
+ ,325.30
+ ,326.29
+ ,327.54
+ ,327.54
+ ,327.21
+ ,325.98
+ ,324.42
+ ,322.91
+ ,322.90
+ ,323.85
+ ,324.96
+ ,326.01
+ ,326.51
+ ,327.01
+ ,327.62
+ ,328.76
+ ,328.40
+ ,327.20
+ ,325.28
+ ,323.20
+ ,323.40
+ ,324.64
+ ,325.85
+ ,326.60
+ ,327.47
+ ,327.58
+ ,329.56
+ ,329.90
+ ,328.92
+ ,327.89
+ ,326.17
+ ,324.68
+ ,325.04
+ ,326.34
+ ,327.39
+ ,328.37
+ ,329.40
+ ,330.14
+ ,331.33
+ ,332.31
+ ,331.90
+ ,330.70
+ ,329.15
+ ,327.34
+ ,327.02
+ ,327.99
+ ,328.48
+ ,329.18
+ ,330.55
+ ,331.32
+ ,332.48
+ ,332.92
+ ,332.08
+ ,331.02
+ ,329.24
+ ,327.28
+ ,327.21
+ ,328.29
+ ,329.41
+ ,330.23
+ ,331.24
+ ,331.87
+ ,333.14
+ ,333.80
+ ,333.42
+ ,331.73
+ ,329.90
+ ,328.40
+ ,328.17
+ ,329.32
+ ,330.59
+ ,331.58
+ ,332.39
+ ,333.33
+ ,334.41
+ ,334.71
+ ,334.17
+ ,332.88
+ ,330.77
+ ,329.14
+ ,328.77
+ ,330.14
+ ,331.52
+ ,332.75
+ ,333.25
+ ,334.53
+ ,335.90
+ ,336.57
+ ,336.10
+ ,334.76
+ ,332.59
+ ,331.41
+ ,330.98
+ ,332.24
+ ,333.68
+ ,334.80
+ ,335.22
+ ,336.47
+ ,337.59
+ ,337.84
+ ,337.72
+ ,336.37
+ ,334.51
+ ,332.60
+ ,332.37
+ ,333.75
+ ,334.79
+ ,336.05
+ ,336.59
+ ,337.79
+ ,338.71
+ ,339.30
+ ,339.12
+ ,337.56
+ ,335.92
+ ,333.74
+ ,333.70
+ ,335.13
+ ,336.56
+ ,337.84
+ ,338.19
+ ,339.90
+ ,340.60
+ ,341.29
+ ,341.00
+ ,339.39
+ ,337.43
+ ,335.72
+ ,335.84
+ ,336.93
+ ,338.04
+ ,339.06
+ ,340.30
+ ,341.21
+ ,342.33
+ ,342.74
+ ,342.07
+ ,340.32
+ ,338.27
+ ,336.52
+ ,336.68
+ ,338.19
+ ,339.44
+ ,340.57
+ ,341.44
+ ,342.53
+ ,343.39
+ ,343.96
+ ,343.18
+ ,341.88
+ ,339.65
+ ,337.80
+ ,337.69
+ ,339.09
+ ,340.32
+ ,341.20
+ ,342.35
+ ,342.93
+ ,344.77
+ ,345.58
+ ,345.14
+ ,343.81
+ ,342.22
+ ,339.69
+ ,339.82
+ ,340.98
+ ,342.82
+ ,343.52
+ ,344.33
+ ,345.11
+ ,346.88
+ ,347.25
+ ,346.61
+ ,345.22
+ ,343.11
+ ,340.90
+ ,341.17
+ ,342.80
+ ,344.04
+ ,344.79
+ ,345.82
+ ,347.25
+ ,348.17
+ ,348.75
+ ,348.07
+ ,346.38
+ ,344.52
+ ,342.92
+ ,342.63
+ ,344.06
+ ,345.38
+ ,346.12
+ ,346.79
+ ,347.69
+ ,349.38
+ ,350.04
+ ,349.38
+ ,347.78
+ ,345.75
+ ,344.70
+ ,344.01
+ ,345.50
+ ,346.75
+ ,347.86
+ ,348.32
+ ,349.26
+ ,350.84
+ ,351.70
+ ,351.11
+ ,349.37
+ ,347.97
+ ,346.31
+ ,346.22
+ ,347.68
+ ,348.82
+ ,350.29
+ ,351.58
+ ,352.08
+ ,353.45
+ ,354.08
+ ,353.66
+ ,352.25
+ ,350.30
+ ,348.58
+ ,348.74
+ ,349.93
+ ,351.21
+ ,352.62
+ ,352.93
+ ,353.54
+ ,355.27
+ ,355.52
+ ,354.97
+ ,353.74
+ ,351.51
+ ,349.63
+ ,349.82
+ ,351.12
+ ,352.35
+ ,353.47
+ ,354.51
+ ,355.18
+ ,355.98
+ ,356.94
+ ,355.99
+ ,354.58
+ ,352.68
+ ,350.72
+ ,350.92
+ ,352.55
+ ,353.91)
> par3 = 'additive'
> 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 additive seasonal component.

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

Smoothing parameters:
 alpha:  0.4901239 
 beta :  0.01170166 
 gamma:  0.4846689 

Coefficients:
           [,1]
a   354.6419943
b     0.1265964
s1    0.1711513
s2    0.8268423
s3    1.4509640
s4    2.7045819
s5    3.2915002
s6    2.4880945
s7    0.9205092
s8   -1.1766967
s9   -3.1090614
s10  -3.1819105
s11  -1.9306731
s12  -0.8062440
> myresid <- x - fit$fitted[,'xhat']
> postscript(file="/var/www/rcomp/tmp/1z1v31293636814.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/rcomp/tmp/2rtvo1293636814.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/rcomp/tmp/3rtvo1293636814.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/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/46lsf1293636814.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/5939l1293636814.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/61c851293636814.tab") 
> 
> try(system("convert tmp/1z1v31293636814.ps tmp/1z1v31293636814.png",intern=TRUE))
character(0)
> try(system("convert tmp/2rtvo1293636814.ps tmp/2rtvo1293636814.png",intern=TRUE))
character(0)
> try(system("convert tmp/3rtvo1293636814.ps tmp/3rtvo1293636814.png",intern=TRUE))
character(0)
> 
> 
> proc.time()
   user  system elapsed 
  2.710   0.640   3.347