R version 3.2.5 (2016-04-14) -- "Very, Very Secure Dishes" Copyright (C) 2016 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(7612 + ,7381 + ,6978 + ,6819 + ,6688 + ,6454 + ,6679 + ,6921 + ,7807 + ,7898 + ,7832 + ,7384 + ,7620 + ,7281 + ,6929 + ,6587 + ,6071 + ,5928 + ,5964 + ,6374 + ,7160 + ,7213 + ,6890 + ,6525 + ,6739 + ,6580 + ,6391 + ,6254 + ,6114 + ,5978 + ,6315 + ,6427 + ,7132 + ,7292 + ,7708 + ,7525 + ,7450 + ,7526 + ,7263 + ,7070 + ,6893 + ,6781 + ,7188 + ,7015 + ,8273 + ,8470 + ,8230 + ,8137 + ,8122 + ,8367 + ,8141 + ,7750 + ,7504 + ,7330 + ,7608 + ,7647 + ,8942 + ,8865 + ,8320 + ,8207 + ,8105 + ,8290 + ,8162 + ,8051 + ,7699 + ,7440 + ,7656 + ,7549 + ,9086 + ,8942 + ,8764 + ,8500 + ,8239 + ,8443 + ,8349 + ,8288 + ,7970 + ,7496 + ,7745 + ,7543 + ,9036 + ,9075 + ,8859 + ,8605 + ,8419 + ,8495 + ,8284 + ,7582 + ,7691 + ,7046 + ,7442 + ,7596 + ,8597 + ,8436 + ,7881 + ,7477 + ,7508 + ,7361 + ,7299 + ,6914 + ,6768 + ,6746 + ,7052 + ,7139 + ,7714 + ,7750 + ,7622 + ,7424 + ,7444 + ,7208 + ,7128 + ,7022 + ,6688 + ,6199 + ,6400 + ,6474 + ,7182 + ,7330 + ,7410 + ,7442 + ,7753 + ,7762 + ,7814 + ,7838 + ,7298 + ,7155 + ,7076 + ,7450 + ,8216 + ,8246 + ,8335 + ,8171 + ,8485 + ,8435 + ,8369 + ,8210 + ,7888 + ,8061 + ,8139 + ,7837 + ,8943 + ,8523 + ,8104 + ,7969 + ,7921 + ,7930 + ,7706 + ,7552 + ,7379 + ,6946 + ,7128 + ,7393 + ,8092 + ,8004 + ,7903 + ,7710 + ,7867 + ,7860 + ,7723 + ,7477 + ,7126 + ,7161 + ,7162 + ,7406 + ,7944 + ,8084 + ,8088 + ,7972 + ,8184 + ,7914 + ,7845 + ,7610 + ,7278 + ,6883 + ,7123 + ,7182 + ,7912 + ,7893 + ,7671 + ,7403 + ,7663 + ,7589 + ,7450 + ,7069 + ,6670 + ,6285 + ,6506 + ,6539 + ,7291 + ,7391 + ,7126 + ,6752 + ,6835 + ,6664 + ,6562 + ,6174 + ,5741 + ,5398 + ,5203 + ,5673 + ,6379 + ,6418 + ,6272 + ,6059) > par3 = 'additive' > par2 = 'Double' > par1 = '12' > par3 <- 'additive' > par2 <- 'Double' > 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 without seasonal component. Call: HoltWinters(x = x, gamma = F) Smoothing parameters: alpha: 1 beta : 0.03558395 gamma: FALSE Coefficients: [,1] a 6059.00000 b -33.52414 > myresid <- x - fit$fitted[,'xhat'] > postscript(file="/var/wessaorg/rcomp/tmp/1lz071461426482.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/2j9bx1461426482.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/3wq1t1461426482.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/48m4h1461426482.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/58fam1461426482.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/6duzf1461426482.tab") > > try(system("convert tmp/1lz071461426482.ps tmp/1lz071461426482.png",intern=TRUE)) character(0) > try(system("convert tmp/2j9bx1461426482.ps tmp/2j9bx1461426482.png",intern=TRUE)) character(0) > try(system("convert tmp/3wq1t1461426482.ps tmp/3wq1t1461426482.png",intern=TRUE)) character(0) > > > proc.time() user system elapsed 1.908 0.256 2.170