Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data:
166 165 164 162 160 159 160 162 163 163 164 166 163 166 170 171 176 172 169 180 172 170 161 167 158 163 165 169 168 165 156 157 146 150 146 159 146 151 156 152 152 143 127 126 122 122 114 127 125 123 124 123 127 117 104 110 106 107 100 115 117 123 130 129 125 112 90 96 99 108 101 113 113 120 131 135 137 120 102 114 121 134 122 131
Seasonal period
12
1
2
3
4
5
6
7
8
9
10
11
12
Type of Exponential Smoothing
(?)
Single
Double
Triple
Type of seasonality
(?)
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