R version 2.12.1 (2010-12-16) 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(26.663 + ,23.598 + ,26.931 + ,24.740 + ,25.806 + ,24.364 + ,24.477 + ,23.901 + ,23.175 + ,23.227 + ,21.672 + ,21.870 + ,21.439 + ,21.089 + ,23.709 + ,21.669 + ,21.752 + ,20.761 + ,23.479 + ,23.824 + ,23.105 + ,23.110 + ,21.759 + ,22.073 + ,21.937 + ,20.035 + ,23.590 + ,21.672 + ,22.222 + ,22.123 + ,23.950 + ,23.504 + ,22.238 + ,23.142 + ,21.059 + ,21.573 + ,21.548 + ,20.000 + ,22.424 + ,20.615 + ,21.761 + ,22.874 + ,24.104 + ,23.748 + ,23.262 + ,22.907 + ,21.519 + ,22.025 + ,22.604 + ,20.894 + ,24.677 + ,23.673 + ,25.320 + ,23.583 + ,24.671 + ,24.454 + ,24.122 + ,24.252 + ,22.084 + ,22.991 + ,23.287 + ,23.049 + ,25.076 + ,24.037 + ,24.430 + ,24.667 + ,26.451 + ,25.618 + ,25.014 + ,25.110 + ,22.964 + ,23.981 + ,23.798 + ,22.270 + ,24.775 + ,22.646 + ,23.988 + ,24.737 + ,26.276 + ,25.816 + ,25.210 + ,25.199 + ,23.162 + ,24.707 + ,24.364 + ,22.644 + ,25.565 + ,24.062 + ,25.431 + ,24.635 + ,27.009 + ,26.606 + ,26.268 + ,26.462 + ,25.246 + ,25.180 + ,24.657 + ,23.304 + ,26.982 + ,26.199 + ,27.210 + ,26.122 + ,26.706 + ,26.878 + ,26.152 + ,26.379 + ,24.712 + ,25.688 + ,24.990 + ,24.239 + ,26.721 + ,23.475 + ,24.767 + ,26.219 + ,28.361 + ,28.599 + ,27.914 + ,27.784 + ,25.693 + ,26.881 + ,26.217 + ,24.218 + ,27.914 + ,26.975 + ,28.527 + ,27.139 + ,28.982 + ,28.169 + ,28.056 + ,29.136 + ,26.291 + ,26.987 + ,26.589 + ,24.848 + ,27.543 + ,26.896 + ,28.878 + ,27.390 + ,28.065 + ,28.141 + ,29.048 + ,28.484 + ,26.634 + ,27.735 + ,27.132 + ,24.924 + ,28.963 + ,26.589 + ,27.931 + ,28.009 + ,29.229 + ,28.759 + ,28.405 + ,27.945 + ,25.912 + ,26.619 + ,26.076 + ,25.286 + ,27.660 + ,25.951 + ,26.398 + ,25.565 + ,28.865 + ,30.000 + ,29.261 + ,29.012 + ,26.992 + ,27.897) > 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.4823655 beta : 0.02988495 gamma: 0.563186 Coefficients: [,1] a 28.04366357 b 0.04199921 s1 -0.78546221 s2 -2.19944507 s3 0.87813012 s4 -0.65164728 s5 0.63427267 s6 0.21182821 s7 2.23177191 s8 2.17167733 s9 1.52077678 s10 1.16900861 s11 -0.97500043 s12 -0.18636055 > myresid <- x - fit$fitted[,'xhat'] > postscript(file="/var/www/rcomp/tmp/15ngn1322918419.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/26zaq1322918419.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/3w6x31322918419.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/4a33v1322918419.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/532aj1322918419.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/602ux1322918419.tab") > > try(system("convert tmp/15ngn1322918419.ps tmp/15ngn1322918419.png",intern=TRUE)) character(0) > try(system("convert tmp/26zaq1322918419.ps tmp/26zaq1322918419.png",intern=TRUE)) character(0) > try(system("convert tmp/3w6x31322918419.ps tmp/3w6x31322918419.png",intern=TRUE)) character(0) > > > proc.time() user system elapsed 1.904 0.248 2.133