Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data:
1772.2 1769.5 1768 1794.8 1823.4 1856.9 1866.9 1869.8 1843.8 1837.1 1857.7 1840.3 1914.6 1972.9 2050.1 2086.2 2112.5 2147.6 2190.4 2194.1 2216.2 2218.6 2233.5 2307.2 2350.4 2368.2 2353.8 2316.5 2305.5 2308.4 2334.4 2381.2 2449.7 2490.3 2523.5 2537.6 2526.1 2545.9 2542.7 2584.3 2600.2 2593.9 2618.9 2591.3 2521.2 2536.6 2596.1 2656.6 2710.3 2778.8 2775.5 2785.2 2847.7 2834.4 2839 2802.6 2819.3 2872 2918.4 2977.8 3031.2 3064.7 3093 3100.6 3141.1 3180.4 3240.3 3265 3338.2 3376.6 3422.5 3432 3516.3 3564 3636.3 3724 3815.4 3828.1 3853.3 3884.5 3918.7 3919.6 3950.8 3981 4063 4132 4160.3 4178.3 4244.1 4256.5 4283.4 4263.3 4256.6 4264.3 4302.3 4256.6 4374 4398.8 4433.9 4446.3 4525.8 4633.1 4677.5 4754.5 4876.2 4932.6 4906.3 4953.1 4909.6 4922.2 4873.5 4854.3 4795.3 4831.9 4913.3 4977.5 5090.7 5128.9 5154.1 5191.5 5251.8 5356.1 5451.9 5450.8 5469.4 5684.6 5740.3 5816.2 5825.9 5831.4 5873.3 5889.5 5908.5 5787.4 5776.6 5883.5 6005.7 5957.8 6030.2 5955.1 5857.3 5889.1 5866.4 5871 5944 6077.6 6197.5 6325.6 6448.3 6559.6 6623.3 6677.3 6740.3 6797.3 6903.5 6955.9 7022.8 7051 7119 7153.4 7193 7269.5 7332.6 7458 7496.6 7592.9 7632.1 7734 7806.6 7865 7927.4 7944.7 8027.7 8059.6 8059.5 7988.9 7950.2 8003.8 8037.5 8069 8157.6 8244.3 8329.4 8417 8432.5 8486.4 8531.1 8643.8 8727.9 8847.3 8904.3 9003.2 9025.3 9044.7 9120.7 9184.3 9247.2 9407.1 9488.9 9592.5 9666.2 9809.6 9932.7 10008.9 10103.4 10194.3 10328.8 10507.6 10601.2 10684 10819.9 11014.3 11043 11258.5 11267.9 11334.5 11297.2 11371.3 11340.1 11380.1 11477.9 11538.8 11596.4 11598.8 11645.8 11738.7 11935.5 12042.8 12127.6 12213.8 12303.5 12410.3 12534.1 12587.5 12683.2 12748.7 12915.9 12962.5 12965.9 13060.7 13099.9 13204 13321.1 13391.2 13366.9 13415.3 13324.6 13141.9 12925.4 12901.5 12973 13155
Seasonal period
4
12
1
2
3
4
5
6
7
8
9
10
11
12
Type of Exponential Smoothing
(?)
Double
Single
Double
Triple
Type of seasonality
(?)
multiplicative
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
1 seconds
R Server
Big Analytics Cloud Computing Center
Click here to blog (archive) this computation