R version 2.15.2 (2012-10-26) -- "Trick or Treat" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-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(1.0137 + ,0.9834 + ,0.9643 + ,0.9470 + ,0.9060 + ,0.9492 + ,0.9397 + ,0.9041 + ,0.8721 + ,0.8552 + ,0.8564 + ,0.8973 + ,0.9383 + ,0.9217 + ,0.9095 + ,0.8920 + ,0.8742 + ,0.8532 + ,0.8607 + ,0.9005 + ,0.9111 + ,0.9059 + ,0.8883 + ,0.8924 + ,0.8833 + ,0.8700 + ,0.8758 + ,0.8858 + ,0.9170 + ,0.9554 + ,0.9922 + ,0.9778 + ,0.9808 + ,0.9811 + ,1.0014 + ,1.0183 + ,1.0622 + ,1.0773 + ,1.0807 + ,1.0848 + ,1.1582 + ,1.1663 + ,1.1372 + ,1.1139 + ,1.1222 + ,1.1692 + ,1.1702 + ,1.2286 + ,1.2613 + ,1.2646 + ,1.2262 + ,1.1985 + ,1.2007 + ,1.2138 + ,1.2266 + ,1.2176 + ,1.2218 + ,1.2490 + ,1.2991 + ,1.3408 + ,1.3119 + ,1.3014 + ,1.3201 + ,1.2938 + ,1.2694 + ,1.2165 + ,1.2037 + ,1.2292 + ,1.2256 + ,1.2015 + ,1.1786 + ,1.1856 + ,1.2103 + ,1.1938 + ,1.2020 + ,1.2271 + ,1.2770 + ,1.2650 + ,1.2684 + ,1.2811 + ,1.2727 + ,1.2611 + ,1.2881 + ,1.3213 + ,1.2999 + ,1.3074 + ,1.3242 + ,1.3516 + ,1.3511 + ,1.3419 + ,1.3716 + ,1.3622 + ,1.3896 + ,1.4227 + ,1.4684 + ,1.4570 + ,1.4718 + ,1.4748 + ,1.5527 + ,1.5750 + ,1.5557 + ,1.5553 + ,1.5770 + ,1.4975 + ,1.4369 + ,1.3322 + ,1.2732 + ,1.3449 + ,1.3239 + ,1.2785 + ,1.3050 + ,1.3190 + ,1.3650 + ,1.4016 + ,1.4088 + ,1.4268 + ,1.4562 + ,1.4816 + ,1.4914 + ,1.4614 + ,1.4272 + ,1.3686 + ,1.3569 + ,1.3406 + ,1.2565 + ,1.2208 + ,1.2770 + ,1.2894 + ,1.3067 + ,1.3898 + ,1.3661 + ,1.3220 + ,1.3360 + ,1.3649 + ,1.3999 + ,1.4442 + ,1.4349 + ,1.4388 + ,1.4264 + ,1.4343 + ,1.3770 + ,1.3706 + ,1.3556 + ,1.3179 + ,1.2905 + ,1.3224 + ,1.3201 + ,1.3162 + ,1.2789 + ,1.2526 + ,1.2288 + ,1.2400 + ,1.2856 + ,1.2974 + ,1.2828) > par3 = 'additive' > par2 = 'Triple' > par1 = '12' > 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.8549788 beta : 0.007152189 gamma: 1 Coefficients: [,1] a 1.3088682129 b 0.0002372431 s1 -0.0224693402 s2 -0.0021868753 s3 0.0182681883 s4 0.0392807197 s5 0.0422064244 s6 0.0166423417 s7 0.0012780881 s8 0.0044626706 s9 0.0048540522 s10 -0.0021515317 s11 -0.0071946970 s12 -0.0260682129 > myresid <- x - fit$fitted[,'xhat'] > postscript(file="/var/wessaorg/rcomp/tmp/1m4ac1354722220.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/2y8031354722220.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/39yy31354722220.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/4nte21354722220.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/585g51354722221.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/6mpvj1354722221.tab") > > try(system("convert tmp/1m4ac1354722220.ps tmp/1m4ac1354722220.png",intern=TRUE)) character(0) > try(system("convert tmp/2y8031354722220.ps tmp/2y8031354722220.png",intern=TRUE)) character(0) > try(system("convert tmp/39yy31354722220.ps tmp/39yy31354722220.png",intern=TRUE)) character(0) > > > proc.time() user system elapsed 2.209 0.426 2.615