Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data:
2421.21 2378.63 2336.00 2250.79 3113.00 3070.38 2421.21 1990.13 2032.71 2032.71 2075.33 2165.17 1904.92 1644.25 1430.79 1430.79 2250.79 2336.00 1686.83 952.46 1340.96 1340.96 1644.25 1819.29 1776.67 1340.96 1559.04 1473.42 2207.79 2032.71 1340.96 824.25 1298.33 1430.79 1559.04 1729.46 1383.54 1084.92 1213.17 1255.75 2378.63 2378.63 1729.46 1644.25 1904.92 1776.67 2122.58 2553.67 2639.29 2032.71 1861.88 1686.83 2856.96 2942.58 2724.50 2942.58 2899.54 2553.67 2942.58 3373.67 3548.71 3027.79 2681.88 2942.58 4065.42 4411.33 4326.13 4496.50 4453.92 4022.83 4757.21 4932.25 5188.29 4411.33 4108.04 4453.92 5278.13 6012.50 5837.46 5837.46 5923.08 5624.00 6401.42 6401.42 6268.96 5534.17 5666.63 5752.25 6315.79 7050.17 6529.21 6789.92 6571.83 6444.00 7439.08 7221.00 6917.71 6486.63 6917.71 7135.79 7396.04 7741.92 7396.04 7609.50 7349.21 7306.63 8386.88 8476.71 8130.83 7524.29 8041.00 8258.67 8519.33 8907.83 8519.33 8822.63 8690.17 8216.04 9211.08 9211.08
Seasonal period
12
12
1
2
3
4
5
6
7
8
9
10
11
12
Type of Exponential Smoothing
(?)
Triple
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