R version 3.0.2 (2013-09-25) -- "Frisbee Sailing" Copyright (C) 2013 The R Foundation for Statistical Computing Platform: x86_64-pc-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. 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(3221816.00 + ,3209817.00 + ,3197649.00 + ,3172468.00 + ,3421574.00 + ,3408392.00 + ,3221816.00 + ,3097770.00 + ,3109769.00 + ,3109769.00 + ,3123120.00 + ,3147118.00 + ,3184467.00 + ,3184467.00 + ,3160469.00 + ,3097770.00 + ,3421574.00 + ,3470922.00 + ,3396393.00 + ,3221816.00 + ,3296514.00 + ,3184467.00 + ,3234998.00 + ,3259165.00 + ,3284346.00 + ,3221816.00 + ,3234998.00 + ,3147118.00 + ,3421574.00 + ,3508271.00 + ,3433742.00 + ,3296514.00 + ,3445741.00 + ,3284346.00 + ,3433742.00 + ,3421574.00 + ,3458923.00 + ,3321695.00 + ,3470922.00 + ,3458923.00 + ,3682848.00 + ,3632317.00 + ,3433742.00 + ,3333694.00 + ,3470922.00 + ,3284346.00 + ,3421574.00 + ,3445741.00 + ,3496272.00 + ,3384394.00 + ,3445741.00 + ,3483090.00 + ,3620318.00 + ,3508271.00 + ,3359044.00 + ,3197649.00 + ,3347045.00 + ,2936375.00 + ,3135119.00 + ,3246997.00 + ,3359044.00 + ,3197649.00 + ,3197649.00 + ,3197649.00 + ,3284346.00 + ,3160469.00 + ,2997891.00 + ,2861846.00 + ,2960542.00 + ,2575222.00 + ,2811315.00 + ,2948543.00 + ,2973724.00 + ,2836496.00 + ,2848495.00 + ,2811315.00 + ,2936375.00 + ,2848495.00 + ,2675270.00 + ,2550041.00 + ,2761798.00 + ,2301949.00 + ,2600572.00 + ,2736617.00 + ,2736617.00 + ,2575222.00 + ,2425995.00 + ,2413996.00 + ,2550041.00 + ,2425995.00 + ,2190071.00 + ,2027493.00 + ,2202070.00 + ,1791569.00 + ,2164721.00 + ,2363296.00 + ,2425995.00 + ,2288767.00 + ,2115373.00 + ,2239419.00 + ,2288767.00 + ,2251418.00 + ,1878097.00 + ,1704872.00 + ,1828749.00 + ,1455597.00 + ,1840917.00 + ,1978145.00 + ,2090023.00 + ,1903447.00 + ,1728870.00 + ,1828749.00 + ,1878097.00 + ,1779401.00 + ,1406249.00 + ,1243671.00 + ,1392898.00 + ,982397.00 + ,1430247.00 + ,1704872.00) > par3 = 'additive' > par2 = 'Triple' > par1 = '12' > par3 <- 'additive' > par2 <- 'Triple' > par1 <- '12' > #'GNU S' R Code compiled by R2WASP v. 1.2.327 () > #Author: root > #To cite this work: Wessa P., (2013), Exponential Smoothing (v1.0.5) in Free Statistics Software (v$_version), Office for Research Development and Education, URL http://www.wessa.net/rwasp_exponentialsmoothing.wasp/ > #Source of accompanying publication: > # > 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.405343 beta : 0.06451955 gamma: 1 Coefficients: [,1] a 1482782.55 b -32342.41 s1 244518.88 s2 64959.60 s3 -93591.85 s4 17727.43 s5 86888.06 s6 24314.99 s7 -295306.66 s8 -397149.59 s9 -183507.85 s10 -516129.50 s11 -32862.01 s12 222089.45 > myresid <- x - fit$fitted[,'xhat'] > postscript(file="/var/wessaorg/rcomp/tmp/18r171439142310.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/249oy1439142310.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/34c4m1439142310.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/43x9j1439142310.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/54jcz1439142310.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/6wng11439142310.tab") > > try(system("convert tmp/18r171439142310.ps tmp/18r171439142310.png",intern=TRUE)) character(0) > try(system("convert tmp/249oy1439142310.ps tmp/249oy1439142310.png",intern=TRUE)) character(0) > try(system("convert tmp/34c4m1439142310.ps tmp/34c4m1439142310.png",intern=TRUE)) character(0) > > > proc.time() user system elapsed 1.398 0.215 1.621