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(250785 + ,250140 + ,255755 + ,254671 + ,253919 + ,253741 + ,252729 + ,253810 + ,256653 + ,255231 + ,258405 + ,251061 + ,254811 + ,254895 + ,258325 + ,257608 + ,258759 + ,258621 + ,257852 + ,260560 + ,262358 + ,260812 + ,261165 + ,257164 + ,260720 + ,259581 + ,264743 + ,261845 + ,262262 + ,261631 + ,258953 + ,259966 + ,262850 + ,262204 + ,263418 + ,262752 + ,266433 + ,267722 + ,266003 + ,262971 + ,265521 + ,264676 + ,270223 + ,269508 + ,268457 + ,265814 + ,266680 + ,263018 + ,269285 + ,269829 + ,270911 + ,266844 + ,271244 + ,269907 + ,271296 + ,270157 + ,271322 + ,267179 + ,264101 + ,265518 + ,269419 + ,268714 + ,272482 + ,268351 + ,268175 + ,270674 + ,272764 + ,272599 + ,270333 + ,270846 + ,270491 + ,269160 + ,274027 + ,273784 + ,276663 + ,274525 + ,271344 + ,271115 + ,270798 + ,273911 + ,273985 + ,271917 + ,273338 + ,270601 + ,273547 + ,275363 + ,281229 + ,277793 + ,279913 + ,282500 + ,280041 + ,282166 + ,290304 + ,283519 + ,287816 + ,285226 + ,287595 + ,289741 + ,289148 + ,288301 + ,290155 + ,289648 + ,288225 + ,289351 + ,294735 + ,305333 + ,309030 + ,310215 + ,321935 + ,325734 + ,320846 + ,323023 + ,319753 + ,321753 + ,320757 + ,324479 + ,324641 + ,322767 + ,324181 + ,321389 + ,327897 + ,334287 + ,332653 + ,334819 + ,335264 + ,339622 + ,342440 + ,346585 + ,335378 + ,337010 + ,339130 + ,341193 + ,343507 + ,348915 + ,346431 + ,348322 + ,348288 + ,346597 + ,351076 + ,355215 + ,350562 + ,355266 + ,361565 + ,363462 + ,366183 + ,365423 + ,369208 + ,366713 + ,369354 + ,371970 + ,371824 + ,373187 + ,367270 + ,368140 + ,373742 + ,364815 + ,368558 + ,371503 + ,372611 + ,370197 + ,375441 + ,375888 + ,375132 + ,381142 + ,372024 + ,376070 + ,376864 + ,371401 + ,375687 + ,384304 + ,380738 + ,379908 + ,384007 + ,384499 + ,385106 + ,387935 + ,380435 + ,379281 + ,384153 + ,380599) > par3 = 'multiplicative' > par2 = 'Triple' > par1 = '12' > par3 <- 'multiplicative' > 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 multiplicative seasonal component. Call: HoltWinters(x = x, seasonal = par3) Smoothing parameters: alpha: 0.7890513 beta : 0.01234488 gamma: 0.9374388 Coefficients: [,1] a 3.821990e+05 b 7.887929e+02 s1 1.006378e+00 s2 1.013495e+00 s3 1.005270e+00 s4 9.992780e-01 s5 1.001961e+00 s6 1.000068e+00 s7 9.995997e-01 s8 1.005989e+00 s9 9.905870e-01 s10 9.982519e-01 s11 1.007814e+00 s12 9.958029e-01 > myresid <- x - fit$fitted[,'xhat'] > postscript(file="/var/wessaorg/rcomp/tmp/185mj1461604180.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/2mgzi1461604180.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/3ffu11461604180.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/43wg71461604180.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/54m8s1461604180.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/655zc1461604180.tab") > > try(system("convert tmp/185mj1461604180.ps tmp/185mj1461604180.png",intern=TRUE)) character(0) > try(system("convert tmp/2mgzi1461604180.ps tmp/2mgzi1461604180.png",intern=TRUE)) character(0) > try(system("convert tmp/3ffu11461604180.ps tmp/3ffu11461604180.png",intern=TRUE)) character(0) > > > proc.time() user system elapsed 1.719 0.255 1.978