Home » date » 2009 » Dec » 01 »

*The author of this computation has been verified* R Software Module: /rwasp_exponentialsmoothing.wasp (opens new window with default values) Title produced by software: Exponential Smoothing Date of computation: Tue, 01 Dec 2009 14:25:38 -0700   Cite this page as follows: Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL http://www.freestatistics.org/blog/date/2009/Dec/01/t1259702811s5eiuo3u5752m6p.htm/, Retrieved Tue, 21 May 2013 12:53:16 +0000   Original text written by user:   IsPrivate? No (this computation is public)   User-defined keywords:   System-generated keywords (parent): t1259334314udw0movhtq9652j (pk = 60874) Estimated Impact 40   Dataseries X: » Textfile « » CSV « » Stem and Leaf « » Histogram « » Kernel Density « » Harrell-Davis Quantiles « » Central Tendency « » Variability « 111.4 87.4 96.8 114.1 110.3 103.9 101.6 94.6 95.9 104.7 102.8 98.1 113.9 80.9 95.7 113.2 105.9 108.8 102.3 99 100.7 115.5 100.7 109.9 114.6 85.4 100.5 114.8 116.5 112.9 102 106 105.3 118.8 106.1 109.3 117.2 92.5 104.2 112.5 122.4 113.3 100 110.7 112.8 109.8 117.3 109.1 115.9 96 99.8 116.8 115.7 99.4 94.3 91 93.2 103.1 94.1 91.8 102.7   Output produced by software: 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 'Gwilym Jenkins' @ 72.249.127.135 Estimated Parameters of Exponential Smoothing Parameter Value alpha 0.0788162596370837 beta 1 gamma 0.94734822479976 Interpolation Forecasts of Exponential Smoothing t Observed Fitted Residuals 13 113.9 114.216458260221 -0.31645826022131 14 80.9 81.0333726382371 -0.133372638237091 15 95.7 95.5857433543653 0.114256645634683 16 113.2 112.488229329621 0.711770670379039 17 105.9 105.088519395747 0.811480604253163 18 108.8 107.851681533232 0.948318466767887 19 102.3 102.547234564864 -0.247234564863732 20 99 95.8819163305467 3.11808366945326 21 100.7 98.268963541234 2.43103645876596 22 115.5 108.357138444377 7.14286155562264 23 100.7 108.491888077685 -7.79188807768526 24 109.9 103.592900411640 6.30709958835989 25 114.6 121.631916200956 -7.03191620095613 26 85.4 86.4651102279986 -1.06511022799863 27 100.5 102.617812933350 -2.11781293335015 28 114.8 121.426526702188 -6.62652670218807 29 116.5 112.797017368105 3.70298263189542 30 112.9 116.088093552074 -3.18809355207401 31 102 108.675136681084 -6.67513668108393 32 106 103.429215530242 2.57078446975783 33 105.3 104.383251970788 0.916748029212187 34 118.8 117.854580033300 0.945419966700314 35 106.1 102.674450667905 3.42554933209513 36 109.3 110.477944750928 -1.17794475092815 37 117.2 115.030535698658 2.16946430134215 38 92.5 85.310509238028 7.189490761972 39 104.2 101.538784648488 2.66121535151179 40 112.5 117.670919879155 -5.17091987915531 41 122.4 119.016894250714 3.38310574928613 42 113.3 116.960839569567 -3.66083956956676 43 100 106.782729872856 -6.78272987285611 44 110.7 110.398884412679 0.301115587321064 45 112.8 110.186666403271 2.61333359672884 46 109.8 125.169538689621 -15.3695386896213 47 117.3 109.757738218203 7.54226178179738 48 109.1 113.783215130895 -4.68321513089481 49 115.9 120.719702352607 -4.81970235260694 50 96 93.2238438070573 2.77615619294272 51 99.8 103.912189953244 -4.11218995324450 52 116.8 110.549914094039 6.25008590596083 53 115.7 118.849790024212 -3.14979002421187 54 99.4 108.746156607763 -9.34615660776292 55 94.3 94.1375873532608 0.162412646739227 56 91 102.367887695294 -11.3678876952937 57 93.2 100.673154186207 -7.47315418620667 58 103.1 95.9945577058963 7.10544229410374 59 94.1 99.8373772191616 -5.73737721916159 60 91.8 90.6378045078787 1.16219549212130 61 102.7 94.3281840404521 8.37181595954787 Extrapolation Forecasts of Exponential Smoothing t Forecast 95% Lower Bound 95% Upper Bound 62 77.0644161292422 67.200218948968 86.9286133095164 63 79.2165064326418 69.2036678726426 89.229344992641 64 90.4945761279843 80.0041618165221 100.984990439446 65 88.3839921826897 77.231179624931 99.5368047404484 66 75.2831645236197 63.692436824392 86.8738922228474 67 70.2136302735289 57.8552027021933 82.5720578448646 68 67.893315505069 54.446720674274 81.3399103358642 69 69.4928097723872 54.2776129127706 84.7080066320037 70 76.0030850630007 57.7299249306356 94.2762451953657 71 69.8173528069797 50.2747638673039 89.3599417466554 72 67.810518752083 46.1236374083056 89.4974000958605 73 75.0155738583945 49.4887353110272 100.542412405762   Charts produced by software: http://www.freestatistics.org/blog/date/2009/Dec/01/t1259702811s5eiuo3u5752m6p/107of1259702736.png (opens in new window) http://www.freestatistics.org/blog/date/2009/Dec/01/t1259702811s5eiuo3u5752m6p/107of1259702736.ps (opens in new window) Click here to open pdf file. http://www.freestatistics.org/blog/date/2009/Dec/01/t1259702811s5eiuo3u5752m6p/2oqv61259702736.png (opens in new window) http://www.freestatistics.org/blog/date/2009/Dec/01/t1259702811s5eiuo3u5752m6p/2oqv61259702736.ps (opens in new window) Click here to open pdf file. http://www.freestatistics.org/blog/date/2009/Dec/01/t1259702811s5eiuo3u5752m6p/3jf4t1259702736.png (opens in new window) http://www.freestatistics.org/blog/date/2009/Dec/01/t1259702811s5eiuo3u5752m6p/3jf4t1259702736.ps (opens in new window) Click here to open pdf file.   Parameters (Session): par1 = 12 ; par2 = periodic ; par3 = 0 ; par5 = 1 ; par7 = 1 ; par8 = FALSE ;   Parameters (R input): par1 = 12 ; par2 = periodic ; par3 = 0 ; par5 = 1 ; par7 = 1 ; par8 = FALSE ;   R code (references can be found in the software module): 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=0, beta=0) if (par2 == 'Double') fit <- HoltWinters(x, gamma=0) 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')