Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data:
1165010 1160665 1156265 1147162.5 1237238.75 1232481.25 1165010 1120157.5 1124488.75 1124488.75 1129328.75 1138005 1151507.5 1151507.5 1142831.25 1120157.5 1237238.75 1255086.25 1228136.25 1165010 1192015 1151507.5 1169781.25 1178512.5 1187615 1165010 1169781.25 1138005 1237238.75 1268588.75 1241638.75 1192015 1245983.75 1187615 1241638.75 1237238.75 1250755 1201131.25 1255086.25 1250755 1331715 1313441.25 1241638.75 1205462.5 1255086.25 1187615 1237238.75 1245983.75 1264257.5 1223805 1245983.75 1259486.25 1309110 1268588.75 1214633.75 1156265 1210288.75 1061788.75 1133660 1174112.5 1214633.75 1156265 1156265 1156265 1187615 1142831.25 1084036.25 1034838.75 1070533.75 931205 1016578.75 1066188.75 1075305 1025681.25 1030012.5 1016578.75 1061788.75 1030012.5 967381.25 922102.5 998662.5 832383.75 940362.5 989560 989560 931205 877236.25 872905 922102.5 877236.25 791931.25 733136.25 796276.25 647831.25 782760 854562.5 877236.25 827626.25 764926.25 809778.75 827626.25 814110 679126.25 616481.25 661278.75 526350 665678.75 715302.5 755755 688283.75 625157.5 661278.75 679126.25 643431.25 508502.5 449707.5 503676.25 355231.25 517178.75 616481.25
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
(?)
1
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
par3 <- 'multiplicative' par2 <- 'Triple' par1 <- '12' 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