Free Statistics

of Irreproducible Research!

Author's title

Author*The author of this computation has been verified*
R Software Modulerwasp_arimaforecasting.wasp
Title produced by softwareARIMA Forecasting
Date of computationMon, 20 Dec 2010 15:06:20 +0000
Cite this page as followsStatistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?v=date/2010/Dec/20/t1292857445l5atidfjh0feaz3.htm/, Retrieved Sat, 04 May 2024 05:23:56 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=112988, Retrieved Sat, 04 May 2024 05:23:56 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact143
Family? (F = Feedback message, R = changed R code, M = changed R Module, P = changed Parameters, D = changed Data)
-     [Univariate Data Series] [data set] [2008-12-01 19:54:57] [b98453cac15ba1066b407e146608df68]
- RMP   [Standard Deviation-Mean Plot] [Unemployment] [2010-11-29 10:34:47] [b98453cac15ba1066b407e146608df68]
- RMP     [ARIMA Forecasting] [Unemployment] [2010-11-29 20:46:45] [b98453cac15ba1066b407e146608df68]
-   PD      [ARIMA Forecasting] [test 7] [2010-12-05 11:13:06] [74be16979710d4c4e7c6647856088456]
-   P         [ARIMA Forecasting] [W9 - Blog 9] [2010-12-06 16:23:47] [1aa8d85d6b335d32b1f6be940e33a166]
-   PD            [ARIMA Forecasting] [ARIMA forecast Li...] [2010-12-20 15:06:20] [47bfda5353cd53c1cf7ea7aa9038654a] [Current]
- RMPD              [Mean Plot] [Mean plot Jenever] [2010-12-20 15:10:29] [1aa8d85d6b335d32b1f6be940e33a166]
- RMPD              [Mean Plot] [Mean plot Whisky] [2010-12-20 15:15:47] [1aa8d85d6b335d32b1f6be940e33a166]
- RMP               [Mean Plot] [Mean plot Likeur] [2010-12-20 15:17:56] [1aa8d85d6b335d32b1f6be940e33a166]
- RMPD              [Bivariate Kernel Density Estimation] [Bivariate Kernell...] [2010-12-20 15:24:35] [1aa8d85d6b335d32b1f6be940e33a166]
- RMPD              [Bivariate Kernel Density Estimation] [Bivariate Kernell...] [2010-12-20 15:27:48] [1aa8d85d6b335d32b1f6be940e33a166]
- RMPD              [Bivariate Kernel Density Estimation] [Bivariate Kernell...] [2010-12-20 15:30:25] [1aa8d85d6b335d32b1f6be940e33a166]
-   PD              [ARIMA Forecasting] [ARIMA forecast Wh...] [2010-12-21 14:41:20] [1aa8d85d6b335d32b1f6be940e33a166]
Feedback Forum

Post a new message
Dataseries X:
25,00
25,09
25,03
25,21
25,33
25,23
25,13
25,03
25,03
25,15
25,18
24,90
25,18
25,25
25,28
25,32
25,27
25,22
25,14
25,41
25,72
25,66
25,65
25,27
23,90
24,06
24,33
24,39
24,39
24,49
24,83
25,08
25,11
25,13
25,17
25,11
25,35
25,36
25,35
25,34
25,39
25,58
25,71
25,66
25,74
25,73
25,72
25,55
25,71
25,92
25,93
26,00
26,02
26,08
26,17
26,18
26,21
26,28
26,34
26,17
26,38
26,36
26,27
26,26
26,49
26,99
27,14
27,10
27,01
26,93
26,97
26,35
26,93




Summary of computational transaction
Raw Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time2 seconds
R Server'George Udny Yule' @ 72.249.76.132

\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 & 2 seconds \tabularnewline
R Server & 'George Udny Yule' @ 72.249.76.132 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=112988&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]2 seconds[/C][/ROW]
[ROW][C]R Server[/C][C]'George Udny Yule' @ 72.249.76.132[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=112988&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=112988&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 time2 seconds
R Server'George Udny Yule' @ 72.249.76.132







Univariate ARIMA Extrapolation Forecast
timeY[t]F[t]95% LB95% UBp-value(H0: Y[t] = F[t])P(F[t]>Y[t-1])P(F[t]>Y[t-s])P(F[t]>Y[61])
4925.71-------
5025.92-------
5125.93-------
5226-------
5326.02-------
5426.08-------
5526.17-------
5626.18-------
5726.21-------
5826.28-------
5926.34-------
6026.17-------
6126.38-------
6226.3626.471826.048626.8950.30230.66460.99470.6646
6326.2726.399725.738527.0610.35030.54690.91810.5233
6426.2626.456325.661227.25140.31420.6770.86970.5746
6526.4926.411925.47627.34780.4350.62480.79410.5266
6626.9926.446825.407127.48640.15290.46750.75540.5501
6727.1426.419425.272227.56660.10910.16480.6650.5268
6827.126.440925.20527.67670.14790.13380.66050.5385
6927.0126.42425.098427.74960.19310.15880.62420.5259
7026.9326.437325.032827.84170.24580.21210.58690.5318
7126.9726.426924.943927.90980.23640.2530.54570.5247
7226.3526.43524.880427.98960.45730.250.63090.5277
7326.9326.428624.803328.05390.27270.53780.52340.5234

\begin{tabular}{lllllllll}
\hline
Univariate ARIMA Extrapolation Forecast \tabularnewline
time & Y[t] & F[t] & 95% LB & 95% UB & p-value(H0: Y[t] = F[t]) & P(F[t]>Y[t-1]) & P(F[t]>Y[t-s]) & P(F[t]>Y[61]) \tabularnewline
49 & 25.71 & - & - & - & - & - & - & - \tabularnewline
50 & 25.92 & - & - & - & - & - & - & - \tabularnewline
51 & 25.93 & - & - & - & - & - & - & - \tabularnewline
52 & 26 & - & - & - & - & - & - & - \tabularnewline
53 & 26.02 & - & - & - & - & - & - & - \tabularnewline
54 & 26.08 & - & - & - & - & - & - & - \tabularnewline
55 & 26.17 & - & - & - & - & - & - & - \tabularnewline
56 & 26.18 & - & - & - & - & - & - & - \tabularnewline
57 & 26.21 & - & - & - & - & - & - & - \tabularnewline
58 & 26.28 & - & - & - & - & - & - & - \tabularnewline
59 & 26.34 & - & - & - & - & - & - & - \tabularnewline
60 & 26.17 & - & - & - & - & - & - & - \tabularnewline
61 & 26.38 & - & - & - & - & - & - & - \tabularnewline
62 & 26.36 & 26.4718 & 26.0486 & 26.895 & 0.3023 & 0.6646 & 0.9947 & 0.6646 \tabularnewline
63 & 26.27 & 26.3997 & 25.7385 & 27.061 & 0.3503 & 0.5469 & 0.9181 & 0.5233 \tabularnewline
64 & 26.26 & 26.4563 & 25.6612 & 27.2514 & 0.3142 & 0.677 & 0.8697 & 0.5746 \tabularnewline
65 & 26.49 & 26.4119 & 25.476 & 27.3478 & 0.435 & 0.6248 & 0.7941 & 0.5266 \tabularnewline
66 & 26.99 & 26.4468 & 25.4071 & 27.4864 & 0.1529 & 0.4675 & 0.7554 & 0.5501 \tabularnewline
67 & 27.14 & 26.4194 & 25.2722 & 27.5666 & 0.1091 & 0.1648 & 0.665 & 0.5268 \tabularnewline
68 & 27.1 & 26.4409 & 25.205 & 27.6767 & 0.1479 & 0.1338 & 0.6605 & 0.5385 \tabularnewline
69 & 27.01 & 26.424 & 25.0984 & 27.7496 & 0.1931 & 0.1588 & 0.6242 & 0.5259 \tabularnewline
70 & 26.93 & 26.4373 & 25.0328 & 27.8417 & 0.2458 & 0.2121 & 0.5869 & 0.5318 \tabularnewline
71 & 26.97 & 26.4269 & 24.9439 & 27.9098 & 0.2364 & 0.253 & 0.5457 & 0.5247 \tabularnewline
72 & 26.35 & 26.435 & 24.8804 & 27.9896 & 0.4573 & 0.25 & 0.6309 & 0.5277 \tabularnewline
73 & 26.93 & 26.4286 & 24.8033 & 28.0539 & 0.2727 & 0.5378 & 0.5234 & 0.5234 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=112988&T=1

[TABLE]
[ROW][C]Univariate ARIMA Extrapolation Forecast[/C][/ROW]
[ROW][C]time[/C][C]Y[t][/C][C]F[t][/C][C]95% LB[/C][C]95% UB[/C][C]p-value(H0: Y[t] = F[t])[/C][C]P(F[t]>Y[t-1])[/C][C]P(F[t]>Y[t-s])[/C][C]P(F[t]>Y[61])[/C][/ROW]
[ROW][C]49[/C][C]25.71[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]50[/C][C]25.92[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]51[/C][C]25.93[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]52[/C][C]26[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]53[/C][C]26.02[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]54[/C][C]26.08[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]55[/C][C]26.17[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]56[/C][C]26.18[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]57[/C][C]26.21[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]58[/C][C]26.28[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]59[/C][C]26.34[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]60[/C][C]26.17[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]61[/C][C]26.38[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]62[/C][C]26.36[/C][C]26.4718[/C][C]26.0486[/C][C]26.895[/C][C]0.3023[/C][C]0.6646[/C][C]0.9947[/C][C]0.6646[/C][/ROW]
[ROW][C]63[/C][C]26.27[/C][C]26.3997[/C][C]25.7385[/C][C]27.061[/C][C]0.3503[/C][C]0.5469[/C][C]0.9181[/C][C]0.5233[/C][/ROW]
[ROW][C]64[/C][C]26.26[/C][C]26.4563[/C][C]25.6612[/C][C]27.2514[/C][C]0.3142[/C][C]0.677[/C][C]0.8697[/C][C]0.5746[/C][/ROW]
[ROW][C]65[/C][C]26.49[/C][C]26.4119[/C][C]25.476[/C][C]27.3478[/C][C]0.435[/C][C]0.6248[/C][C]0.7941[/C][C]0.5266[/C][/ROW]
[ROW][C]66[/C][C]26.99[/C][C]26.4468[/C][C]25.4071[/C][C]27.4864[/C][C]0.1529[/C][C]0.4675[/C][C]0.7554[/C][C]0.5501[/C][/ROW]
[ROW][C]67[/C][C]27.14[/C][C]26.4194[/C][C]25.2722[/C][C]27.5666[/C][C]0.1091[/C][C]0.1648[/C][C]0.665[/C][C]0.5268[/C][/ROW]
[ROW][C]68[/C][C]27.1[/C][C]26.4409[/C][C]25.205[/C][C]27.6767[/C][C]0.1479[/C][C]0.1338[/C][C]0.6605[/C][C]0.5385[/C][/ROW]
[ROW][C]69[/C][C]27.01[/C][C]26.424[/C][C]25.0984[/C][C]27.7496[/C][C]0.1931[/C][C]0.1588[/C][C]0.6242[/C][C]0.5259[/C][/ROW]
[ROW][C]70[/C][C]26.93[/C][C]26.4373[/C][C]25.0328[/C][C]27.8417[/C][C]0.2458[/C][C]0.2121[/C][C]0.5869[/C][C]0.5318[/C][/ROW]
[ROW][C]71[/C][C]26.97[/C][C]26.4269[/C][C]24.9439[/C][C]27.9098[/C][C]0.2364[/C][C]0.253[/C][C]0.5457[/C][C]0.5247[/C][/ROW]
[ROW][C]72[/C][C]26.35[/C][C]26.435[/C][C]24.8804[/C][C]27.9896[/C][C]0.4573[/C][C]0.25[/C][C]0.6309[/C][C]0.5277[/C][/ROW]
[ROW][C]73[/C][C]26.93[/C][C]26.4286[/C][C]24.8033[/C][C]28.0539[/C][C]0.2727[/C][C]0.5378[/C][C]0.5234[/C][C]0.5234[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=112988&T=1

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

As an alternative you can also use a QR Code:  

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

Univariate ARIMA Extrapolation Forecast
timeY[t]F[t]95% LB95% UBp-value(H0: Y[t] = F[t])P(F[t]>Y[t-1])P(F[t]>Y[t-s])P(F[t]>Y[61])
4925.71-------
5025.92-------
5125.93-------
5226-------
5326.02-------
5426.08-------
5526.17-------
5626.18-------
5726.21-------
5826.28-------
5926.34-------
6026.17-------
6126.38-------
6226.3626.471826.048626.8950.30230.66460.99470.6646
6326.2726.399725.738527.0610.35030.54690.91810.5233
6426.2626.456325.661227.25140.31420.6770.86970.5746
6526.4926.411925.47627.34780.4350.62480.79410.5266
6626.9926.446825.407127.48640.15290.46750.75540.5501
6727.1426.419425.272227.56660.10910.16480.6650.5268
6827.126.440925.20527.67670.14790.13380.66050.5385
6927.0126.42425.098427.74960.19310.15880.62420.5259
7026.9326.437325.032827.84170.24580.21210.58690.5318
7126.9726.426924.943927.90980.23640.2530.54570.5247
7226.3526.43524.880427.98960.45730.250.63090.5277
7326.9326.428624.803328.05390.27270.53780.52340.5234







Univariate ARIMA Extrapolation Forecast Performance
time% S.E.PEMAPESq.EMSERMSE
620.0082-0.004200.012500
630.0128-0.00490.00460.01680.01470.1211
640.0153-0.00740.00550.03850.02260.1504
650.01810.0030.00490.00610.01850.136
660.02010.02050.0080.29510.07380.2717
670.02220.02730.01120.51930.14810.3848
680.02380.02490.01320.43440.1890.4347
690.02560.02220.01430.34340.20830.4564
700.02710.01860.01480.24280.21210.4606
710.02860.02060.01540.2950.22040.4695
720.03-0.00320.01430.00720.2010.4484
730.03140.0190.01470.25140.20520.453

\begin{tabular}{lllllllll}
\hline
Univariate ARIMA Extrapolation Forecast Performance \tabularnewline
time & % S.E. & PE & MAPE & Sq.E & MSE & RMSE \tabularnewline
62 & 0.0082 & -0.0042 & 0 & 0.0125 & 0 & 0 \tabularnewline
63 & 0.0128 & -0.0049 & 0.0046 & 0.0168 & 0.0147 & 0.1211 \tabularnewline
64 & 0.0153 & -0.0074 & 0.0055 & 0.0385 & 0.0226 & 0.1504 \tabularnewline
65 & 0.0181 & 0.003 & 0.0049 & 0.0061 & 0.0185 & 0.136 \tabularnewline
66 & 0.0201 & 0.0205 & 0.008 & 0.2951 & 0.0738 & 0.2717 \tabularnewline
67 & 0.0222 & 0.0273 & 0.0112 & 0.5193 & 0.1481 & 0.3848 \tabularnewline
68 & 0.0238 & 0.0249 & 0.0132 & 0.4344 & 0.189 & 0.4347 \tabularnewline
69 & 0.0256 & 0.0222 & 0.0143 & 0.3434 & 0.2083 & 0.4564 \tabularnewline
70 & 0.0271 & 0.0186 & 0.0148 & 0.2428 & 0.2121 & 0.4606 \tabularnewline
71 & 0.0286 & 0.0206 & 0.0154 & 0.295 & 0.2204 & 0.4695 \tabularnewline
72 & 0.03 & -0.0032 & 0.0143 & 0.0072 & 0.201 & 0.4484 \tabularnewline
73 & 0.0314 & 0.019 & 0.0147 & 0.2514 & 0.2052 & 0.453 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=112988&T=2

[TABLE]
[ROW][C]Univariate ARIMA Extrapolation Forecast Performance[/C][/ROW]
[ROW][C]time[/C][C]% S.E.[/C][C]PE[/C][C]MAPE[/C][C]Sq.E[/C][C]MSE[/C][C]RMSE[/C][/ROW]
[ROW][C]62[/C][C]0.0082[/C][C]-0.0042[/C][C]0[/C][C]0.0125[/C][C]0[/C][C]0[/C][/ROW]
[ROW][C]63[/C][C]0.0128[/C][C]-0.0049[/C][C]0.0046[/C][C]0.0168[/C][C]0.0147[/C][C]0.1211[/C][/ROW]
[ROW][C]64[/C][C]0.0153[/C][C]-0.0074[/C][C]0.0055[/C][C]0.0385[/C][C]0.0226[/C][C]0.1504[/C][/ROW]
[ROW][C]65[/C][C]0.0181[/C][C]0.003[/C][C]0.0049[/C][C]0.0061[/C][C]0.0185[/C][C]0.136[/C][/ROW]
[ROW][C]66[/C][C]0.0201[/C][C]0.0205[/C][C]0.008[/C][C]0.2951[/C][C]0.0738[/C][C]0.2717[/C][/ROW]
[ROW][C]67[/C][C]0.0222[/C][C]0.0273[/C][C]0.0112[/C][C]0.5193[/C][C]0.1481[/C][C]0.3848[/C][/ROW]
[ROW][C]68[/C][C]0.0238[/C][C]0.0249[/C][C]0.0132[/C][C]0.4344[/C][C]0.189[/C][C]0.4347[/C][/ROW]
[ROW][C]69[/C][C]0.0256[/C][C]0.0222[/C][C]0.0143[/C][C]0.3434[/C][C]0.2083[/C][C]0.4564[/C][/ROW]
[ROW][C]70[/C][C]0.0271[/C][C]0.0186[/C][C]0.0148[/C][C]0.2428[/C][C]0.2121[/C][C]0.4606[/C][/ROW]
[ROW][C]71[/C][C]0.0286[/C][C]0.0206[/C][C]0.0154[/C][C]0.295[/C][C]0.2204[/C][C]0.4695[/C][/ROW]
[ROW][C]72[/C][C]0.03[/C][C]-0.0032[/C][C]0.0143[/C][C]0.0072[/C][C]0.201[/C][C]0.4484[/C][/ROW]
[ROW][C]73[/C][C]0.0314[/C][C]0.019[/C][C]0.0147[/C][C]0.2514[/C][C]0.2052[/C][C]0.453[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=112988&T=2

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

As an alternative you can also use a QR Code:  

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

Univariate ARIMA Extrapolation Forecast Performance
time% S.E.PEMAPESq.EMSERMSE
620.0082-0.004200.012500
630.0128-0.00490.00460.01680.01470.1211
640.0153-0.00740.00550.03850.02260.1504
650.01810.0030.00490.00610.01850.136
660.02010.02050.0080.29510.07380.2717
670.02220.02730.01120.51930.14810.3848
680.02380.02490.01320.43440.1890.4347
690.02560.02220.01430.34340.20830.4564
700.02710.01860.01480.24280.21210.4606
710.02860.02060.01540.2950.22040.4695
720.03-0.00320.01430.00720.2010.4484
730.03140.0190.01470.25140.20520.453



Parameters (Session):
par1 = 12 ; par2 = 1 ; par3 = 1 ; par4 = 0 ; par5 = 12 ; par6 = 1 ; par7 = 1 ; par8 = 0 ; par9 = 0 ; par10 = FALSE ;
Parameters (R input):
par1 = 12 ; par2 = 1 ; par3 = 1 ; par4 = 0 ; par5 = 12 ; par6 = 1 ; par7 = 1 ; par8 = 0 ; par9 = 0 ; par10 = FALSE ;
R code (references can be found in the software module):
par1 <- as.numeric(par1) #cut off periods
par2 <- as.numeric(par2) #lambda
par3 <- as.numeric(par3) #degree of non-seasonal differencing
par4 <- as.numeric(par4) #degree of seasonal differencing
par5 <- as.numeric(par5) #seasonal period
par6 <- as.numeric(par6) #p
par7 <- as.numeric(par7) #q
par8 <- as.numeric(par8) #P
par9 <- as.numeric(par9) #Q
if (par10 == 'TRUE') par10 <- TRUE
if (par10 == 'FALSE') par10 <- FALSE
if (par2 == 0) x <- log(x)
if (par2 != 0) x <- x^par2
lx <- length(x)
first <- lx - 2*par1
nx <- lx - par1
nx1 <- nx + 1
fx <- lx - nx
if (fx < 1) {
fx <- par5
nx1 <- lx + fx - 1
first <- lx - 2*fx
}
first <- 1
if (fx < 3) fx <- round(lx/10,0)
(arima.out <- arima(x[1:nx], order=c(par6,par3,par7), seasonal=list(order=c(par8,par4,par9), period=par5), include.mean=par10, method='ML'))
(forecast <- predict(arima.out,par1))
(lb <- forecast$pred - 1.96 * forecast$se)
(ub <- forecast$pred + 1.96 * forecast$se)
if (par2 == 0) {
x <- exp(x)
forecast$pred <- exp(forecast$pred)
lb <- exp(lb)
ub <- exp(ub)
}
if (par2 != 0) {
x <- x^(1/par2)
forecast$pred <- forecast$pred^(1/par2)
lb <- lb^(1/par2)
ub <- ub^(1/par2)
}
if (par2 < 0) {
olb <- lb
lb <- ub
ub <- olb
}
(actandfor <- c(x[1:nx], forecast$pred))
(perc.se <- (ub-forecast$pred)/1.96/forecast$pred)
bitmap(file='test1.png')
opar <- par(mar=c(4,4,2,2),las=1)
ylim <- c( min(x[first:nx],lb), max(x[first:nx],ub))
plot(x,ylim=ylim,type='n',xlim=c(first,lx))
usr <- par('usr')
rect(usr[1],usr[3],nx+1,usr[4],border=NA,col='lemonchiffon')
rect(nx1,usr[3],usr[2],usr[4],border=NA,col='lavender')
abline(h= (-3:3)*2 , col ='gray', lty =3)
polygon( c(nx1:lx,lx:nx1), c(lb,rev(ub)), col = 'orange', lty=2,border=NA)
lines(nx1:lx, lb , lty=2)
lines(nx1:lx, ub , lty=2)
lines(x, lwd=2)
lines(nx1:lx, forecast$pred , lwd=2 , col ='white')
box()
par(opar)
dev.off()
prob.dec <- array(NA, dim=fx)
prob.sdec <- array(NA, dim=fx)
prob.ldec <- array(NA, dim=fx)
prob.pval <- array(NA, dim=fx)
perf.pe <- array(0, dim=fx)
perf.mape <- array(0, dim=fx)
perf.mape1 <- array(0, dim=fx)
perf.se <- array(0, dim=fx)
perf.mse <- array(0, dim=fx)
perf.mse1 <- array(0, dim=fx)
perf.rmse <- array(0, dim=fx)
for (i in 1:fx) {
locSD <- (ub[i] - forecast$pred[i]) / 1.96
perf.pe[i] = (x[nx+i] - forecast$pred[i]) / forecast$pred[i]
perf.se[i] = (x[nx+i] - forecast$pred[i])^2
prob.dec[i] = pnorm((x[nx+i-1] - forecast$pred[i]) / locSD)
prob.sdec[i] = pnorm((x[nx+i-par5] - forecast$pred[i]) / locSD)
prob.ldec[i] = pnorm((x[nx] - forecast$pred[i]) / locSD)
prob.pval[i] = pnorm(abs(x[nx+i] - forecast$pred[i]) / locSD)
}
perf.mape[1] = abs(perf.pe[1])
perf.mse[1] = abs(perf.se[1])
for (i in 2:fx) {
perf.mape[i] = perf.mape[i-1] + abs(perf.pe[i])
perf.mape1[i] = perf.mape[i] / i
perf.mse[i] = perf.mse[i-1] + perf.se[i]
perf.mse1[i] = perf.mse[i] / i
}
perf.rmse = sqrt(perf.mse1)
bitmap(file='test2.png')
plot(forecast$pred, pch=19, type='b',main='ARIMA Extrapolation Forecast', ylab='Forecast and 95% CI', xlab='time',ylim=c(min(lb),max(ub)))
dum <- forecast$pred
dum[1:par1] <- x[(nx+1):lx]
lines(dum, lty=1)
lines(ub,lty=3)
lines(lb,lty=3)
dev.off()
load(file='createtable')
a<-table.start()
a<-table.row.start(a)
a<-table.element(a,'Univariate ARIMA Extrapolation Forecast',9,TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'time',1,header=TRUE)
a<-table.element(a,'Y[t]',1,header=TRUE)
a<-table.element(a,'F[t]',1,header=TRUE)
a<-table.element(a,'95% LB',1,header=TRUE)
a<-table.element(a,'95% UB',1,header=TRUE)
a<-table.element(a,'p-value
(H0: Y[t] = F[t])',1,header=TRUE)
a<-table.element(a,'P(F[t]>Y[t-1])',1,header=TRUE)
a<-table.element(a,'P(F[t]>Y[t-s])',1,header=TRUE)
mylab <- paste('P(F[t]>Y[',nx,sep='')
mylab <- paste(mylab,'])',sep='')
a<-table.element(a,mylab,1,header=TRUE)
a<-table.row.end(a)
for (i in (nx-par5):nx) {
a<-table.row.start(a)
a<-table.element(a,i,header=TRUE)
a<-table.element(a,x[i])
a<-table.element(a,'-')
a<-table.element(a,'-')
a<-table.element(a,'-')
a<-table.element(a,'-')
a<-table.element(a,'-')
a<-table.element(a,'-')
a<-table.element(a,'-')
a<-table.row.end(a)
}
for (i in 1:fx) {
a<-table.row.start(a)
a<-table.element(a,nx+i,header=TRUE)
a<-table.element(a,round(x[nx+i],4))
a<-table.element(a,round(forecast$pred[i],4))
a<-table.element(a,round(lb[i],4))
a<-table.element(a,round(ub[i],4))
a<-table.element(a,round((1-prob.pval[i]),4))
a<-table.element(a,round((1-prob.dec[i]),4))
a<-table.element(a,round((1-prob.sdec[i]),4))
a<-table.element(a,round((1-prob.ldec[i]),4))
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,'Univariate ARIMA Extrapolation Forecast Performance',7,TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'time',1,header=TRUE)
a<-table.element(a,'% S.E.',1,header=TRUE)
a<-table.element(a,'PE',1,header=TRUE)
a<-table.element(a,'MAPE',1,header=TRUE)
a<-table.element(a,'Sq.E',1,header=TRUE)
a<-table.element(a,'MSE',1,header=TRUE)
a<-table.element(a,'RMSE',1,header=TRUE)
a<-table.row.end(a)
for (i in 1:fx) {
a<-table.row.start(a)
a<-table.element(a,nx+i,header=TRUE)
a<-table.element(a,round(perc.se[i],4))
a<-table.element(a,round(perf.pe[i],4))
a<-table.element(a,round(perf.mape1[i],4))
a<-table.element(a,round(perf.se[i],4))
a<-table.element(a,round(perf.mse1[i],4))
a<-table.element(a,round(perf.rmse[i],4))
a<-table.row.end(a)
}
a<-table.end(a)
table.save(a,file='mytable1.tab')