Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data:
1709 1646 1794 1878 2173 2321 2468 2416 2184 2121 1962 1825 1751 1688 1920 1941 2311 2279 2638 2448 2279 2163 1941 1878 1773 1688 1783 1984 2290 2511 2712 2522 2342 2195 1931 1910 1730 1688 1899 1994 2342 2553 2712 2627 2363 2311 2026 1910 1762 1815 2005 2089 2617 2828 2965 2891 2532 2363 2216 2026 1804 1773 2015 2089 2627 2712 3007 2880 2490 2237 2205 1984 1868 1815 2047 2142 2743 2775 3028 2965 2501 2501 2131 2015 1910 1868 2121 2268 2690 2933 3218 3028 2659 2406 2258 2057 1889 1984 2110 2311 2785 3039 3229 3070 2659 2543 2237 2142 1962 1910 2216 2437 2817 3123 3345 3112 2659 2469 2332 2110 1910 1941 2216 2342 2923 3229 3513 3355 2849 2680 2395 2205 1994 1952 2290 2395 2965 3239 3608 3524 3018 2648 2363 2247 1994 1941 2258 2332 3323 3608 3957 3672 3155 2933 2585 2384 2057 2100 2458 2638 3292 3724 4652 4379 4231 3756 3429 3461 3345 4220 4874 5064 5951 6774 7997 7523 7438 6879 6489 6288 5919 6183 6594 6489 8040 9715 9714 9756 8595 7861 7753 8154 7778 7402 8903 9742 11372 12741 13733 13691 12239 12502 11241 10829 11569 10397 12493 11962 13974 14945 16805 16587 14225 14157 13016 12253 11704 12275 13695 14082 16555 17339 17777 17592 16194 15336 14208 13116 12354 12682 14141 14989 16159 18276 19157 18737 17109 17094 15418 14312 13260 14990 15975 16770 19819 20983 22001 22337 20750 19969 17293 16498 15117 16058 18137 18471 21398 23854 26025 25479 22804 19619 19627 18488 17243 18284 20226 20903 23768 26323 28038 26776 22886 22813 22404 19795 18839 18892 20823 22212 25076 26884 30611 30228 26762 25885 23328 21930 21433 22369 24503 25905 30605 34984 37060 34502 31793 29275 28305 25248 27730 27424 32684 31366 37459 41060 43558 42398 33827 34962 33480 32445 30715 30400 31451 31306 40592 44133 47387 41310 37913 34355 34607 28729 26138 30745 35018 34549 40980 42869 45022 40387 38180 38608 35308 30234 28801 33034 35294 33181 40797 42355 46098 42430 41851 39331 37328 34514 32494 33308 36805 34221 41020 44350 46173 44435 40943 39269 35901 32142 31239 32261 34951 38109 43168 45547 49568 45387 41805 41281 36068 34879 32791 34206 39128 40249 43519 46137 56709 52306 49397 45500 39857 37958 35567 37696 42319 39137 47062 50610 54457 54435 48516 43225 42155 39995 37541 37277 41778 41666 49616 57793 61884 62400 50820 51116 45731 42528 40459 40295 44147 42697 52561 56572 56858 58363 45627 45622 41304 36016 35592 35677 39864 41761 50380 49129 55066 55671 49058 44503 42145 38698 38963 38690 39792 42545 50145 58164 59035 59408 55988 47321 42269 39606 37059 37963 31043 41712 50366 56977 56807 54634 51367 48073 46251 43736 39975 40478 46895 46147 55011 57799 62450 63896 57784 53231 50354 38410 41600 41471 46287 49013 56624 61739 66600 60054
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
par3 <- 'additive' par2 <- 'Single' 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
1 seconds
R Server
Big Analytics Cloud Computing Center
Click here to blog (archive) this computation