Free Statistics

of Irreproducible Research!

Author's title

Author*Unverified author*
R Software Modulerwasp_exponentialsmoothing.wasp
Title produced by softwareExponential Smoothing
Date of computationWed, 28 May 2025 14:56:32 +0200
Cite this page as followsStatistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?v=date/2025/May/28/t1748437012w43sedosbs8cpnh.htm/, Retrieved Sun, 19 Apr 2026 12:06:13 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=320217, Retrieved Sun, 19 Apr 2026 12:06:13 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact184
Family? (F = Feedback message, R = changed R code, M = changed R Module, P = changed Parameters, D = changed Data)
-       [Exponential Smoothing] [] [2025-05-28 12:56:32] [d41d8cd98f00b204e9800998ecf8427e] [Current]
Feedback Forum

Post a new message
Dataseries X:
829,8
839,7
860,0
898,6
891,9
905,5
908,0
921,1
925,4
944,4
929,9
974,4
931,5
950,3
963,8
1 000,8
998,0
1 017,6
1 025,5
1 037,5
1 026,5
1 124,2
1 104,0
1 139,1
1 084,4
1 100,4
1 096,0
1 131,4
1 120,9
1 121,5
1 113,9
1 107,9
1 094,0
1 095,0
1 079,1
1 114,4
1 076,4
1 074,4
1 088,5
1 112,5
1 131,7
1 137,3
1 137,9
1 133,1
1 121,9
1 136,6
1 122,7
1 144,3
1 112,8
1 120,0
1 125,6
1 161,5
1 151,3
1 175,1
1 188,2
1 184,4
1 206,3
1 212,0
1 195,8
1 229,4
1 188,4
1 177,5
1 202,0
1 234,8
1 232,7
1 248,2
1 238,6
1 239,7
1 237,8
1 242,6
1 223,8
1 252,5
1 213,5
1 225,1
1 272,1
1 298,6
1 308,1
1 333,7
1 332,1
1 348,1
1 338,9
1 347,6
1 338,7
1 371,1
1 335,0
1 345,4
1 365,9
1 414,7
1 401,8
1 423,9
1 438,9
1 458,0
1 453,7
1 469,8
1 468,6
1 530,3
1 499,4
1 509,3
1 532,8
1 563,3
1 581,0
1 595,1
1 618,8
1 631,6
1 632,3
1 662,4
1 665,8
1 708,9
1 701,6
1 694,3
1 718,8
1 755,3
1 776,2
1 805,1
1 831,4
1 819,3
1 819,7
1 839,6
1 856,3
1 906,2
1 858,2
1 863,7
1 869,3
1 909,9
1 889,0
1 912,6
1 920,7
1 929,3
1 937,5
1 938,7
1 928,7
1 978,7
1 918,4
1 924,0
1 966,6
1 994,8
2 023,2
2 036,0
2 051,2
2 053,6
2 059,1
2 074,2
2 079,9
2 119,9
2 065,5
2 093,1
2 120,3
2 174,1
2 173,6
2 178,8
2 175,5
2 203,6
2 209,8
2 222,0
2 228,5
2 250,8
2 216,3
2 238,9
2 521,1
2 663,5
2 662,7
2 677,1
2 685,6
2 692,8
2 708,9
2 760,9
2 801,4
2 812,8
2 809,5
2 812,0
2 870,2
2 927,0
2 929,9
2 928,9
2 945,9
2 942,4
2 945,6
2 953,4
2 972,6
2 978,9
2 943,9
3 152,5
3 207,7
3 215,4
3 151,3
3 096,3
3 077,6
3 036,6
3 027,1
3 025,4
2 983,1
2 974,4
2 919,3
2 909,3
2 919,2
2 978,0
2 952,0
2 941,2
2 935,8
2 933,9
2 987,5
2 980,2
2 953,5
2 981,3
2 934,8
2 943,1
2 995,4
3 053,9
3 056,3
3 073,3
3 075,3
3 092,5
3 119,6
3 138,9
3 147,8
3 175,8
3 143,6
3 144,9




Summary of computational transaction
Raw Input view raw input (R code)
Raw Outputview raw output of R engine
Computing time0 seconds
R ServerBig Analytics Cloud Computing Center

\begin{tabular}{lllllllll}
\hline
Summary of computational transaction \tabularnewline
Raw Input view raw input (R code)  \tabularnewline
Raw Outputview raw output of R engine  \tabularnewline
Computing time0 seconds \tabularnewline
R ServerBig Analytics Cloud Computing Center \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=320217&T=0

[TABLE]
[ROW]
Summary of computational transaction[/C][/ROW] [ROW]Raw Input[/C] view raw input (R code) [/C][/ROW] [ROW]Raw Output[/C]view raw output of R engine [/C][/ROW] [ROW]Computing time[/C]0 seconds[/C][/ROW] [ROW]R Server[/C]Big Analytics Cloud Computing Center[/C][/ROW] [/TABLE] Source: https://freestatistics.org/blog/index.php?pk=320217&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=320217&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 Input view raw input (R code)
Raw Outputview raw output of R engine
Computing time0 seconds
R ServerBig Analytics Cloud Computing Center



Parameters (Session):
par1 = 12 ; par2 = Pojedynczy ; par3 = przyłączeniowy ; par4 = 12 ;
Parameters (R input):
par1 = 12 ; par2 = Pojedynczy ; par3 = przyłączeniowy ; par4 = 12 ;
R code (references can be found in the software module):
par1 <- as.numeric(par1)
par4 <- as.numeric(par4)
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, par4, 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')