Free Statistics

of Irreproducible Research!

Author's title

Author*Unverified author*
R Software Modulerwasp_exponentialsmoothing.wasp
Title produced by softwareExponential Smoothing
Date of computationFri, 20 Feb 2009 11:16:03 -0700
Cite this page as followsStatistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?v=date/2009/Feb/20/t1235154097dj8vkyz6zke2vt3.htm/, Retrieved Sat, 11 May 2024 15:32:42 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=38084, Retrieved Sat, 11 May 2024 15:32:42 +0000
QR Codes:

Original text written by user:esto es una prueba
IsPrivate?No (this computation is public)
User-defined keywordsbarranca
Estimated Impact209
Family? (F = Feedback message, R = changed R code, M = changed R Module, P = changed Parameters, D = changed Data)
-       [Exponential Smoothing] [analisis de ingre...] [2009-02-20 18:16:03] [d41d8cd98f00b204e9800998ecf8427e] [Current]
Feedback Forum

Post a new message
Dataseries X:
72077
49560
46252
55204
47035
54511
73369
53409




Summary of computational transaction
Raw Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time4 seconds
R Server'Sir Ronald Aylmer Fisher' @ 193.190.124.24

\begin{tabular}{lllllllll}
\hline
Summary of computational transaction \tabularnewline
Raw Input & view raw input (R code)  \tabularnewline
Raw Output & view raw output of R engine  \tabularnewline
Computing time & 4 seconds \tabularnewline
R Server & 'Sir Ronald Aylmer Fisher' @ 193.190.124.24 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=38084&T=0

[TABLE]
[ROW][C]Summary of computational transaction[/C][/ROW]
[ROW][C]Raw Input[/C][C]view raw input (R code) [/C][/ROW]
[ROW][C]Raw Output[/C][C]view raw output of R engine [/C][/ROW]
[ROW][C]Computing time[/C][C]4 seconds[/C][/ROW]
[ROW][C]R Server[/C][C]'Sir Ronald Aylmer Fisher' @ 193.190.124.24[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=38084&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=38084&T=0

As an alternative you can also use a QR Code:  

The GUIDs for individual cells are displayed in the table below:

Summary of computational transaction
Raw Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time4 seconds
R Server'Sir Ronald Aylmer Fisher' @ 193.190.124.24







Estimated Parameters of Exponential Smoothing
ParameterValue
alpha0.629685196986489
beta1
gamma0

\begin{tabular}{lllllllll}
\hline
Estimated Parameters of Exponential Smoothing \tabularnewline
Parameter & Value \tabularnewline
alpha & 0.629685196986489 \tabularnewline
beta & 1 \tabularnewline
gamma & 0 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=38084&T=1

[TABLE]
[ROW][C]Estimated Parameters of Exponential Smoothing[/C][/ROW]
[ROW][C]Parameter[/C][C]Value[/C][/ROW]
[ROW][C]alpha[/C][C]0.629685196986489[/C][/ROW]
[ROW][C]beta[/C][C]1[/C][/ROW]
[ROW][C]gamma[/C][C]0[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=38084&T=1

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=38084&T=1

As an alternative you can also use a QR Code:  

The GUIDs for individual cells are displayed in the table below:

Estimated Parameters of Exponential Smoothing
ParameterValue
alpha0.629685196986489
beta1
gamma0







Interpolation Forecasts of Exponential Smoothing
tObservedFittedResiduals
3462522704319209
45520428717.245897826926486.7541021731
54703551652.5027954595-4617.50279545946
65451152094.29640404342416.70359595665
77336958487.188129727614881.8118702724
85340982100.0306536306-28691.0306536306

\begin{tabular}{lllllllll}
\hline
Interpolation Forecasts of Exponential Smoothing \tabularnewline
t & Observed & Fitted & Residuals \tabularnewline
3 & 46252 & 27043 & 19209 \tabularnewline
4 & 55204 & 28717.2458978269 & 26486.7541021731 \tabularnewline
5 & 47035 & 51652.5027954595 & -4617.50279545946 \tabularnewline
6 & 54511 & 52094.2964040434 & 2416.70359595665 \tabularnewline
7 & 73369 & 58487.1881297276 & 14881.8118702724 \tabularnewline
8 & 53409 & 82100.0306536306 & -28691.0306536306 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=38084&T=2

[TABLE]
[ROW][C]Interpolation Forecasts of Exponential Smoothing[/C][/ROW]
[ROW][C]t[/C][C]Observed[/C][C]Fitted[/C][C]Residuals[/C][/ROW]
[ROW][C]3[/C][C]46252[/C][C]27043[/C][C]19209[/C][/ROW]
[ROW][C]4[/C][C]55204[/C][C]28717.2458978269[/C][C]26486.7541021731[/C][/ROW]
[ROW][C]5[/C][C]47035[/C][C]51652.5027954595[/C][C]-4617.50279545946[/C][/ROW]
[ROW][C]6[/C][C]54511[/C][C]52094.2964040434[/C][C]2416.70359595665[/C][/ROW]
[ROW][C]7[/C][C]73369[/C][C]58487.1881297276[/C][C]14881.8118702724[/C][/ROW]
[ROW][C]8[/C][C]53409[/C][C]82100.0306536306[/C][C]-28691.0306536306[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=38084&T=2

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=38084&T=2

As an alternative you can also use a QR Code:  

The GUIDs for individual cells are displayed in the table below:

Interpolation Forecasts of Exponential Smoothing
tObservedFittedResiduals
3462522704319209
45520428717.245897826926486.7541021731
54703551652.5027954595-4617.50279545946
65451152094.29640404342416.70359595665
77336958487.188129727614881.8118702724
85340982100.0306536306-28691.0306536306







Extrapolation Forecasts of Exponential Smoothing
tForecast95% Lower Bound95% Upper Bound
960209.381960731721054.566189955599364.197731508
1056385.0505567096-6580.15174409519119350.252857514
1152560.7191526875-44575.9380985348149697.376403910
1248736.3877486654-89689.0383582924187161.813855623
1344912.0563446433-140448.620404781230272.733094067

\begin{tabular}{lllllllll}
\hline
Extrapolation Forecasts of Exponential Smoothing \tabularnewline
t & Forecast & 95% Lower Bound & 95% Upper Bound \tabularnewline
9 & 60209.3819607317 & 21054.5661899555 & 99364.197731508 \tabularnewline
10 & 56385.0505567096 & -6580.15174409519 & 119350.252857514 \tabularnewline
11 & 52560.7191526875 & -44575.9380985348 & 149697.376403910 \tabularnewline
12 & 48736.3877486654 & -89689.0383582924 & 187161.813855623 \tabularnewline
13 & 44912.0563446433 & -140448.620404781 & 230272.733094067 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=38084&T=3

[TABLE]
[ROW][C]Extrapolation Forecasts of Exponential Smoothing[/C][/ROW]
[ROW][C]t[/C][C]Forecast[/C][C]95% Lower Bound[/C][C]95% Upper Bound[/C][/ROW]
[ROW][C]9[/C][C]60209.3819607317[/C][C]21054.5661899555[/C][C]99364.197731508[/C][/ROW]
[ROW][C]10[/C][C]56385.0505567096[/C][C]-6580.15174409519[/C][C]119350.252857514[/C][/ROW]
[ROW][C]11[/C][C]52560.7191526875[/C][C]-44575.9380985348[/C][C]149697.376403910[/C][/ROW]
[ROW][C]12[/C][C]48736.3877486654[/C][C]-89689.0383582924[/C][C]187161.813855623[/C][/ROW]
[ROW][C]13[/C][C]44912.0563446433[/C][C]-140448.620404781[/C][C]230272.733094067[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=38084&T=3

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=38084&T=3

As an alternative you can also use a QR Code:  

The GUIDs for individual cells are displayed in the table below:

Extrapolation Forecasts of Exponential Smoothing
tForecast95% Lower Bound95% Upper Bound
960209.381960731721054.566189955599364.197731508
1056385.0505567096-6580.15174409519119350.252857514
1152560.7191526875-44575.9380985348149697.376403910
1248736.3877486654-89689.0383582924187161.813855623
1344912.0563446433-140448.620404781230272.733094067



Parameters (Session):
par1 = 5 ; par2 = Double ; par3 = additive ;
Parameters (R input):
par1 = 5 ; par2 = Double ; par3 = additive ;
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')