Home » date » 2009 » Dec » 04 »

WS 9.10

*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: Fri, 04 Dec 2009 08:03:34 -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/04/t12599390808btzk0w3sp0tv99.htm/, Retrieved Tue, 21 May 2013 08:57:05 +0000

Original text written by user:

IsPrivate?

No (this computation is public)

User-defined keywords:

System-generated keywords (parent):

t1259334314udw0movhtq9652j (pk = 60874)

Estimated Impact

Dataseries X:

» Textfile « » CSV « » Stem and Leaf « » Histogram « » Kernel Density « » Harrell-Davis Quantiles « » Central Tendency « » Variability «

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.149518688899873
beta	0
gamma	1

Interpolation Forecasts of Exponential Smoothing
t	Observed	Fitted	Residuals
13	94.6	94.919856849353	-0.319856849352945
14	95.9	96.3617041743281	-0.461704174328105
15	104.7	105.090201458249	-0.390201458249422
16	102.8	103.228104975216	-0.428104975216129
17	98.1	98.3098622055097	-0.209862205509722
18	113.9	113.70869326672	0.191306733280030
19	80.9	86.186058175999	-5.28605817599895
20	95.7	94.5274095204302	1.17259047956985
21	113.2	111.907354275041	1.29264572495933
22	105.9	108.595572393490	-2.69557239349042
23	108.8	101.766311366548	7.0336886334517
24	102.3	100.289801916555	2.01019808344506
25	99	93.432230297996	5.56776970200396
26	100.7	95.628212993495	5.07178700650498
27	115.5	105.290271001686	10.2097289983143
28	100.7	104.945952689777	-4.2459526897772
29	109.9	99.575518963534	10.3244810364659
30	114.6	117.380159869492	-2.78015986949163
31	85.4	83.8481389443058	1.55186105569418
32	100.5	99.2823614416082	1.21763855839184
33	114.8	117.455317038801	-2.6553170388012
34	116.5	109.921803365637	6.57819663436301
35	112.9	112.783156856469	0.116843143531099
36	102	105.749217937900	-3.74921793790038
37	106	100.899790878517	5.10020912148258
38	105.3	102.597715371357	2.70228462864254
39	118.8	116.454759617793	2.34524038220671
40	106.1	102.459278055813	3.64072194418722
41	109.3	110.700874128831	-1.40087412883109
42	117.2	115.626901807880	1.5730981921198
43	92.5	86.1033472724347	6.39665272756531
44	104.2	102.267974863519	1.93202513648102
45	112.5	117.549583435051	-5.04958343505081
46	122.4	117.475324743749	4.92467525625108
47	113.3	114.542942131052	-1.24294213105208
48	100	103.868557811495	-3.86855781149458
49	110.7	106.537112415201	4.16288758479921
50	112.8	106.035639434607	6.76436056539315
51	109.8	120.410727400431	-10.6107274004306
52	117.3	105.560826389854	11.7391736101455
53	109.1	110.763744612496	-1.66374461249593
54	115.9	118.263731328191	-2.36373132819064
55	96	92.0389067413026	3.96109325869742
56	99.8	104.054004442563	-4.25400444256285
57	116.8	112.376476851670	4.42352314833039
58	115.7	122.219811614452	-6.51981161445212
59	99.4	112.412014768593	-13.0120147685929
60	94.3	98.0422085770475	-3.74220857704752

Extrapolation Forecasts of Exponential Smoothing
t	Forecast	95% Lower Bound	95% Upper Bound
61	107.283324107706	97.392467790993	117.17418042442
62	108.281693399631	98.2785808314555	118.284805967807
63	106.804081909883	96.6976633658894	116.910500453877
64	112.229636447467	101.981675390702	122.477597504231
65	104.613675132305	94.3181698332825	114.909180431328
66	111.461710351872	100.992108041063	121.931312662682
67	91.7292885705867	81.3700653732765	102.088511767897
68	95.9416467171662	85.4236820238656	106.459611410467
69	111.622270349227	100.752042590325	122.492498108128
70	111.454141710823	100.484419359337	122.423864062309
71	97.434419716843	86.6295328862718	108.239306547414
72	92.9636262894019	17.9729655925062	167.954286986298

Charts produced by software:

http://www.freestatistics.org/blog/date/2009/Dec/04/t12599390808btzk0w3sp0tv99/1kb0s1259939012.png (opens in new window)

http://www.freestatistics.org/blog/date/2009/Dec/04/t12599390808btzk0w3sp0tv99/1kb0s1259939012.ps (opens in new window)

Click here to open pdf file.

http://www.freestatistics.org/blog/date/2009/Dec/04/t12599390808btzk0w3sp0tv99/2xud31259939012.png (opens in new window)

http://www.freestatistics.org/blog/date/2009/Dec/04/t12599390808btzk0w3sp0tv99/2xud31259939012.ps (opens in new window)

Click here to open pdf file.

http://www.freestatistics.org/blog/date/2009/Dec/04/t12599390808btzk0w3sp0tv99/3c7qt1259939012.png (opens in new window)

http://www.freestatistics.org/blog/date/2009/Dec/04/t12599390808btzk0w3sp0tv99/3c7qt1259939012.ps (opens in new window)

Click here to open pdf file.

Parameters (Session):

par1 = 12 ; par2 = Triple ; par3 = multiplicative ;

Parameters (R input):

par1 = 12 ; par2 = Triple ; par3 = multiplicative ;

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')