Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data:
-51.08 -13.46 97.77 30.77 -19.56 34.13 42.98 37.12 57.96 70.87 -42.88 -50.71 35.63 -6.753 -48.52 -18.52 -45.85 -39.16 24.69 51.83 44.67 -49.42 -25.17 -47 -34.66 -48.04 26.19 11.19 42.86 6.554 67.4 141.5 -81.62 61.29 -156.5 -80.29 -40.95 -64.33 -62.1 127.9 179.6 24.26 99.11 136.3 -10.91 102 50.25 22.42 -136.2 -13.62 -36.39 61.61 119.3 40.97 -9.18 -24.04 -3.202 -53.29 -24.04 -187.9 -119.5 -165.9 -75.68 37.32 326.2 215.9 10.77 -89.09 -26.26 -34.34 -21.09 61.08 63.42 61.03 81.26 8.263 -117.1 -79.37 -82.52 -98.38 -57.55 -43.63 -33.38 15.79 27.13 -22.26 2.972 -68.03 -91.35 -19.66 -12.81 91.33 152.2 129.1 137.3 17.5 54.84 30.45 -39.32 -34.32 -110.6 -108 -84.11 -133 -71.13 -73.21 -46.96 -6.794 -5.454 11.16 -40.61 -87.61 -103.9 -103.2 -94.4 -85.25 -53.42 -64.5 -22.25 14.92 3.256 -13.13 -39.9 -73.9 -95.22 6.469 -91.69 -11.54 34.29 -60.79 56.46 110.6 76.97 97.58 52.81 -11.19 -64.51 -23.82 11.02 -16.83 15 15.92 128.2 130.3 126.7 147.3 81.52 16.52 -19.8 44.89 118.7
Seasonal period
12
12
1
2
3
4
5
6
7
8
9
10
11
12
Type of Exponential Smoothing
(?)
Single
Single
Double
Triple
Type of seasonality
(?)
additive
additive
multiplicative
Number of Forecasts
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Chart options
R Code
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 myresid <- x - fit$fitted[,'xhat'] bitmap(file='test1.png') 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() bitmap(file='test2.png') 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() bitmap(file='test3.png') 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() load(file='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='mytable.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='mytable1.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='mytable2.tab')
Compute
Summary of computational transaction
Raw Input
view raw input (R code)
Raw Output
view raw output of R engine
Computing time
0 seconds
R Server
Big Analytics Cloud Computing Center
Click here to blog (archive) this computation