Home » date » 2009 » Dec » 21 »

Paper

*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: Mon, 21 Dec 2009 15:02:05 -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/21/t126143298259mzyyp9z5zyu76.htm/, Retrieved Sat, 25 May 2013 03:11:36 +0000

Original text written by user:

IsPrivate?

No (this computation is public)

User-defined keywords:

System-generated keywords (parent):

t1255509090iv1ijspnf5sojst (pk = 46388)

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	2 seconds
R Server	'Gwilym Jenkins' @ 72.249.127.135

Estimated Parameters of Exponential Smoothing
Parameter	Value
alpha	1
beta	0
gamma	1

Interpolation Forecasts of Exponential Smoothing
t	Observed	Fitted	Residuals
13	23.5	23.6301148459851	-0.130114845985076
14	22.9	22.9437996857881	-0.0437996857881267
15	21.9	21.9463706339436	-0.0463706339436101
16	21.5	21.5244856179741	-0.0244856179740971
17	20.5	20.5031491944293	-0.00314919442930162
18	20.2	20.1831232356379	0.0168767643621131
19	19.4	19.7431788967428	-0.343178896742813
20	19.2	19.5608170367688	-0.360817036768811
21	18.8	18.6247076581915	0.175292341808486
22	18.8	18.469045348585	0.330954651414999
23	22.6	22.2204117107894	0.379588289210556
24	23.3	22.9579508253039	0.342049174696136
25	23	23.2985525957402	-0.298552595740205
26	21.4	22.4545640949381	-1.05456409493806
27	19.9	20.5056726303232	-0.605672630323188
28	18.8	19.554435563383	-0.754435563382998
29	18.6	17.9226264555644	0.677373544435621
30	18.4	18.3083350456507	0.0916649543492731
31	18.6	17.9799704794691	0.620029520530938
32	19.9	18.7523543723900	1.14764562760995
33	19.2	19.3053074364747	-0.105307436474696
34	18.4	18.8629082197206	-0.4629082197206
35	21.1	21.7465655569433	-0.646565556943287
36	20.5	21.4307901943330	-0.930790194332968
37	19.1	20.4925522061045	-1.39255220610451
38	18.1	18.6385264863076	-0.538526486307553
39	17	17.3361370223583	-0.336137022358262
40	17.1	16.6978629842259	0.402137015774091
41	17.4	16.2978528792420	1.10214712075797
42	16.8	17.1242582940799	-0.324258294079879
43	15.3	16.4126741085591	-1.11267410855907
44	14.3	15.4174458818276	-1.11744588182761
45	13.4	13.8605092102093	-0.460509210209255
46	15.3	13.1518965882544	2.14810341174558
47	22.1	18.0742578646356	4.0257421353644
48	23.7	22.4488972816469	1.25110271835310
49	22.2	23.6994097942596	-1.49940979425959
50	19.5	21.6717871495780	-2.17178714957796
51	16.6	18.680788492404	-2.08078849240398
52	17.3	16.3038529733077	0.996147026692313
53	19.8	16.4890027117505	3.31099728824946
54	21.2	19.4924117972216	1.70758820277844
55	21.5	20.7227391285616	0.777260871438443
56	20.6	21.6830315307631	-1.08303153076309
57	19.1	19.9859072147579	-0.885907214757875
58	19.6	18.7644425019367	0.835557498063299
59	23.5	23.1681040184818	0.331895981518244
60	24	23.8742472038864	0.125752796113602

Extrapolation Forecasts of Exponential Smoothing
t	Forecast	95% Lower Bound	95% Upper Bound
61	24.0000526931491	21.6975200010197	26.3025853852786
62	23.4330868353661	20.2116750253280	26.6544986454041
63	22.4583820602558	18.6015920376905	26.315172082821
64	22.0745059221189	17.6321730407109	26.5168388035268
65	21.0522327483702	16.222315541508	25.8821499552324
66	20.7280282013055	15.4351305081929	26.0209258944181
67	20.2604143240205	14.5874172089530	25.9334114390881
68	20.4303331078529	14.2522236080770	26.6084426076288
69	19.820942573076	13.3878770500546	26.2540080960975
70	19.4743237813257	12.7344553930482	26.2141921696032
71	23.0192260363599	14.7096931678474	31.3287589048724
72	23.3847678241084	-30.8218387265673	77.5913743747842

Charts produced by software:

http://www.freestatistics.org/blog/date/2009/Dec/21/t126143298259mzyyp9z5zyu76/1v9lk1261432923.png (opens in new window)

http://www.freestatistics.org/blog/date/2009/Dec/21/t126143298259mzyyp9z5zyu76/1v9lk1261432923.ps (opens in new window)

Click here to open pdf file.

http://www.freestatistics.org/blog/date/2009/Dec/21/t126143298259mzyyp9z5zyu76/24zyi1261432923.png (opens in new window)

http://www.freestatistics.org/blog/date/2009/Dec/21/t126143298259mzyyp9z5zyu76/24zyi1261432923.ps (opens in new window)

Click here to open pdf file.

http://www.freestatistics.org/blog/date/2009/Dec/21/t126143298259mzyyp9z5zyu76/3hbvu1261432923.png (opens in new window)

http://www.freestatistics.org/blog/date/2009/Dec/21/t126143298259mzyyp9z5zyu76/3hbvu1261432923.ps (opens in new window)

Click here to open pdf file.

Parameters (Session):

par1 = 1 ; par2 = 2 ; par3 = 1 ; par4 = 1 ;

Parameters (R input):

par1 = 1 ; par2 = 2 ; par3 = 1 ; par4 = 1 ;

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