Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data:
3281 3397 3498.5 3538 3449.5 3673 3350.5 3604 3673.5 3747 3616 3580.5 3710 3994.5 4091 3954.5 4004 4287 3831 4046.5 4079.5 4029.5 3880 3855 3841.5 4123.5 4133 3958.5 4003 4151.5 3723 3957 3965.5 3861.5 3917.5 3704 3950 4140.5 4090 4162 4066 4358.5 4022.5 4285.5 4373.5 4284.5 4077.5 4122 4181.5 4535.5 4497 4420.5 4370 4712 4475 4578.5 4751.5 4746 4581.5 4645.5 4751 4952.5 4996.5 4998 4986.5 5348 4933 5263 5330.5 5301 5159 5258.5 5411.5 5536.5 5613 5505.5 5476 5782.5 5283 5451.5 5578 5548.5 5379.5 5117.5 5316.5 5505.5 5620.5 5383.5 5461.5 5658.5 5357.5 5622 5608 5604.5 5399 5185 5221 5379.5 5333 5214 5206.5 5630 5285.5 5512.5 5592.5 5554.5 5284.5 5198.5 5241.5 5455 5548.5 5375 5346 5730.5 5457 5603
Seasonal period
48
12
1
2
3
4
5
6
7
8
9
10
11
12
Type of Exponential Smoothing
(?)
1
Single
Double
Triple
Type of seasonality
(?)
0
additive
multiplicative
Number of Forecasts
0
12
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Chart options
R Code
par4 <- '18' par3 <- 'multiplicative' par2 <- 'Triple' par1 <- '12' par1 <- as.numeric(par1) par4 <- as.numeric(par4) 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, par4, 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