R version 2.12.2 (2011-02-25) Copyright (C) 2011 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: x86_64-redhat-linux-gnu (64-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. Natural language support but running in an English locale 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(12.94,12.79,12.82,12.85,12.85,12.72,12.62,12.67,12.6,12.54,12.64,12.67,12.51,12.59,12.52,12.5,12.58,12.51,12.47,12.44,12.51,12.27,12.51,12.41,12.35,12.39,12.31,12.31,12.21,12.1,12.01,11.85,12.12,11.96,11.99,11.93,11.91,11.83,11.92,11.86,11.94,11.87,11.86,11.92,11.82,11.85,11.77,11.82,11.61,11.56,11.45,11.4,11.38,11.33,11.19,11.15,10.98,10.92,10.99,11,10.9,10.99,11.04,11.03,10.99,11,10.87,10.88,10.91,10.92,10.83,10.9,10.82,10.79,10.77,10.72,10.71,10.63,10.61,10.57,10.65,10.57,10.57,10.57,10.52,10.43,10.35,10.2,10.2,10.17,10.14,10.05,10.12,10.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.6295816 beta : 0.01780810 gamma: 0.5298262 Coefficients: [,1] a 10.141706854 b -0.028370183 s1 -0.016042943 s2 0.047210213 s3 -0.027517344 s4 -0.016909406 s5 -0.012686743 s6 -0.038480584 s7 0.013539139 s8 0.007355345 s9 -0.037047768 s10 -0.048627318 s11 0.002061818 s12 -0.038881755 > myresid <- x - fit$fitted[,'xhat'] > postscript(file="/var/www/wessaorg/rcomp/tmp/1ry541305817469.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/wessaorg/rcomp/tmp/2m6mg1305817469.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/wessaorg/rcomp/tmp/3t6lx1305817469.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/wessaorg/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab > load(file="/var/www/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/www/wessaorg/rcomp/tmp/4t8hf1305817469.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/wessaorg/rcomp/tmp/5b5w11305817469.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/wessaorg/rcomp/tmp/6d42y1305817469.tab") > > try(system("convert tmp/1ry541305817469.ps tmp/1ry541305817469.png",intern=TRUE)) character(0) > try(system("convert tmp/2m6mg1305817469.ps tmp/2m6mg1305817469.png",intern=TRUE)) character(0) > try(system("convert tmp/3t6lx1305817469.ps tmp/3t6lx1305817469.png",intern=TRUE)) character(0) > > > proc.time() user system elapsed 2.390 0.250 2.713