R version 2.13.0 (2011-04-13)
Copyright (C) 2011 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(117
+ ,116
+ ,166
+ ,180
+ ,202
+ ,290
+ ,298
+ ,441
+ ,388
+ ,260
+ ,175
+ ,105
+ ,137
+ ,142
+ ,176
+ ,231
+ ,240
+ ,316
+ ,363
+ ,537
+ ,487
+ ,324
+ ,185
+ ,133
+ ,169
+ ,157
+ ,206
+ ,244
+ ,243
+ ,393
+ ,405
+ ,579
+ ,525
+ ,373
+ ,198
+ ,148
+ ,201
+ ,177
+ ,222
+ ,275
+ ,290
+ ,402
+ ,534
+ ,614
+ ,578
+ ,419
+ ,203
+ ,173
+ ,229
+ ,192
+ ,294
+ ,310
+ ,365
+ ,509
+ ,537
+ ,655
+ ,643
+ ,444
+ ,259
+ ,229
+ ,276
+ ,245
+ ,324
+ ,323
+ ,349
+ ,480
+ ,530
+ ,676
+ ,670
+ ,476
+ ,281
+ ,240
+ ,259
+ ,237
+ ,400
+ ,367
+ ,497
+ ,593
+ ,696
+ ,969
+ ,878
+ ,581
+ ,373
+ ,232
+ ,358
+ ,318
+ ,410
+ ,480
+ ,604
+ ,713
+ ,844
+ ,1134
+ ,1013
+ ,755
+ ,371
+ ,280
+ ,417
+ ,417
+ ,514
+ ,548
+ ,583
+ ,839
+ ,924
+ ,1179
+ ,1109
+ ,896
+ ,452
+ ,337
+ ,484
+ ,524
+ ,575
+ ,622
+ ,664
+ ,926
+ ,1028
+ ,1361
+ ,1304
+ ,937
+ ,505
+ ,427
+ ,580
+ ,483
+ ,625
+ ,695
+ ,729
+ ,1099
+ ,1090
+ ,1393
+ ,1261
+ ,988
+ ,525
+ ,416
+ ,516
+ ,454
+ ,629
+ ,755
+ ,706
+ ,951
+ ,1099
+ ,1444
+ ,1316
+ ,1066
+ ,585
+ ,430
+ ,669
+ ,598
+ ,714
+ ,835
+ ,912
+ ,1031
+ ,1210
+ ,1581
+ ,1416
+ ,1120
+ ,652
+ ,505
+ ,741
+ ,675
+ ,782
+ ,956
+ ,996
+ ,1259
+ ,1389
+ ,1868
+ ,1609
+ ,1385
+ ,735
+ ,577
+ ,815
+ ,798
+ ,940
+ ,1007
+ ,1094
+ ,1413
+ ,1552
+ ,2038
+ ,1762
+ ,1411
+ ,805
+ ,729
+ ,912
+ ,753
+ ,989
+ ,1137
+ ,1256
+ ,1554
+ ,1629
+ ,2024
+ ,1900
+ ,1563
+ ,905
+ ,766
+ ,952
+ ,915
+ ,1197
+ ,1242
+ ,1197
+ ,1522
+ ,1591
+ ,2128
+ ,1962
+ ,1653
+ ,987
+ ,877
+ ,990
+ ,880
+ ,1258
+ ,1240
+ ,1312
+ ,1713
+ ,1683
+ ,2220
+ ,1996
+ ,1628
+ ,1119
+ ,890
+ ,1118
+ ,1164
+ ,1364
+ ,1412
+ ,1721
+ ,1752
+ ,1794
+ ,2434
+ ,2390
+ ,1929
+ ,1352
+ ,1060
+ ,1435
+ ,1196
+ ,1478
+ ,1648
+ ,1812
+ ,2118
+ ,2211
+ ,2826
+ ,2534
+ ,2290
+ ,1367
+ ,1105
+ ,1463
+ ,1299
+ ,1576
+ ,1850
+ ,1929
+ ,2367
+ ,2508
+ ,3073
+ ,2922
+ ,2377
+ ,1627
+ ,1259
+ ,1547
+ ,1436
+ ,1905
+ ,2079
+ ,1994
+ ,2501
+ ,2569
+ ,3467
+ ,2885
+ ,2211
+ ,1597
+ ,1141
+ ,1533
+ ,1546
+ ,1967
+ ,2171
+ ,2021
+ ,2753
+ ,2626
+ ,3532
+ ,3096
+ ,2639
+ ,1653
+ ,1425
+ ,1802
+ ,1674
+ ,1970
+ ,2092
+ ,2280
+ ,2715
+ ,2971
+ ,3937
+ ,3110
+ ,2662
+ ,1728
+ ,1609
+ ,1922
+ ,1863
+ ,1945
+ ,2365
+ ,2275
+ ,2962
+ ,2930
+ ,4062
+ ,3445
+ ,2943
+ ,1879
+ ,1694
+ ,2147
+ ,1999
+ ,2266
+ ,2562
+ ,2583
+ ,2965
+ ,3142
+ ,4115
+ ,3654
+ ,2992
+ ,2031
+ ,1699
+ ,2313
+ ,1970
+ ,2382
+ ,2830
+ ,2614
+ ,3321
+ ,3418
+ ,4468
+ ,3657
+ ,3250
+ ,2174
+ ,2014
+ ,2118
+ ,2227
+ ,2563
+ ,2817
+ ,2680
+ ,3337
+ ,3559
+ ,4608
+ ,3930
+ ,3133
+ ,2042
+ ,1999
+ ,2679
+ ,2425
+ ,2693
+ ,2760
+ ,2941
+ ,3611
+ ,3779
+ ,4945
+ ,4034
+ ,2906
+ ,2132
+ ,1932
+ ,2268
+ ,2178
+ ,2317
+ ,2552
+ ,2582
+ ,2886
+ ,3283
+ ,4125
+ ,3536
+ ,2568
+ ,1802
+ ,1598
+ ,2013
+ ,1872
+ ,2227
+ ,2497
+ ,2530
+ ,3119
+ ,3411
+ ,4511
+ ,3528
+ ,2833
+ ,1760
+ ,1517
+ ,1968
+ ,1809
+ ,2104
+ ,2391
+ ,2691
+ ,3023
+ ,3188
+ ,4057
+ ,3476)
> 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.2547441 
 beta :  0 
 gamma:  0.5176692 

Coefficients:
            [,1]
a   2576.3207288
b      4.2848193
s1     1.0341413
s2     0.6928150
s3     0.6238967
s4     0.7963593
s5     0.7457780
s6     0.8614366
s7     0.9622616
s8     1.0098185
s9     1.1665642
s10    1.2480769
s11    1.6052565
s12    1.3366903
> myresid <- x - fit$fitted[,'xhat']
> postscript(file="/var/wessaorg/rcomp/tmp/1kk3c1324225769.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/wessaorg/rcomp/tmp/2kwql1324225769.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/wessaorg/rcomp/tmp/3wrwm1324225769.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/wessaorg/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab
> load(file="/var/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/wessaorg/rcomp/tmp/4whfn1324225769.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/wessaorg/rcomp/tmp/5c0kb1324225769.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/wessaorg/rcomp/tmp/6mydn1324225769.tab") 
> 
> try(system("convert tmp/1kk3c1324225769.ps tmp/1kk3c1324225769.png",intern=TRUE))
character(0)
> try(system("convert tmp/2kwql1324225769.ps tmp/2kwql1324225769.png",intern=TRUE))
character(0)
> try(system("convert tmp/3wrwm1324225769.ps tmp/3wrwm1324225769.png",intern=TRUE))
character(0)
> 
> 
> proc.time()
   user  system elapsed 
  2.780   0.219   2.996