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 computationFri, 19 Dec 2008 16:09:36 -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/2008/Dec/20/t122972826983qk3xpr8dn1bsx.htm/, Retrieved Sat, 18 May 2024 09:19:00 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=35272, Retrieved Sat, 18 May 2024 09:19:00 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact222
Family? (F = Feedback message, R = changed R code, M = changed R Module, P = changed Parameters, D = changed Data)
-     [Central Tendency] [Central Tendency:...] [2008-12-12 13:08:46] [6816386b1f3c2f6c0c9f2aa1e5bc9362]
- RMPD  [Mean Plot] [Mean plot - prijs...] [2008-12-12 14:56:05] [6816386b1f3c2f6c0c9f2aa1e5bc9362]
- RMPD    [Tukey lambda PPCC Plot] [PPCC: Bel 20] [2008-12-12 15:02:48] [6816386b1f3c2f6c0c9f2aa1e5bc9362]
- RMP       [ARIMA Backward Selection] [Arima: Bel 20] [2008-12-14 20:11:31] [6816386b1f3c2f6c0c9f2aa1e5bc9362]
F RMPD        [ARIMA Forecasting] [Arima forecasting...] [2008-12-14 22:14:13] [6816386b1f3c2f6c0c9f2aa1e5bc9362]
-   PD          [ARIMA Forecasting] [Arima forecasting...] [2008-12-14 22:31:41] [6816386b1f3c2f6c0c9f2aa1e5bc9362]
-   PD              [ARIMA Forecasting] [Arima forecasting...] [2008-12-19 23:09:36] [14a75ec03b2c0d8ddd8b141a7b1594fd] [Current]
Feedback Forum

Post a new message
Dataseries X:
10967.87
10433.56
10665.78
10666.71
10682.74
10777.22
10052.6
10213.97
10546.82
10767.2
10444.5
10314.68
9042.56
9220.75
9721.84
9978.53
9923.81
9892.56
10500.98
10179.35
10080.48
9492.44
8616.49
8685.4
8160.67
8048.1
8641.21
8526.63
8474.21
7916.13
7977.64
8334.59
8623.36
9098.03
9154.34
9284.73
9492.49
9682.35
9762.12
10124.63
10540.05
10601.61
10323.73
10418.4
10092.96
10364.91
10152.09
10032.8
10204.59
10001.6
10411.75
10673.38
10539.51
10723.78
10682.06
10283.19
10377.18
10486.64
10545.38
10554.27
10532.54
10324.31
10695.25
10827.81
10872.48
10971.19
11145.65
11234.68
11333.88
10997.97
11036.89
11257.35
11533.59
11963.12
12185.15
12377.62
12512.89
12631.48
12268.53
12754.8
13407.75
13480.21
13673.28
13239.71
13557.69
13901.28
13200.58
13406.97
12538.12
12419.57
12193.88
12656.63
12812.48
12056.67
11322.38
11530.75
11114.08
9181.73
8614.55




Summary of computational transaction
Raw Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time1 seconds
R Server'Gwilym Jenkins' @ 72.249.127.135

\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 & 1 seconds \tabularnewline
R Server & 'Gwilym Jenkins' @ 72.249.127.135 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=35272&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]1 seconds[/C][/ROW]
[ROW][C]R Server[/C][C]'Gwilym Jenkins' @ 72.249.127.135[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=35272&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=35272&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 time1 seconds
R Server'Gwilym Jenkins' @ 72.249.127.135







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[87])
7512185.15-------
7612377.62-------
7712512.89-------
7812631.48-------
7912268.53-------
8012754.8-------
8113407.75-------
8213480.21-------
8313673.28-------
8413239.71-------
8513557.69-------
8613901.28-------
8713200.58-------
8813406.9713200.5812532.913313868.24670.27230.50.99220.5
8912538.1213200.5812256.356714144.80330.08450.33420.92330.5
9012419.5713200.5812044.147314357.01270.09280.86920.83260.5
9112193.8813200.5811865.246614535.91340.06980.87420.91440.5
9212656.6313200.5811707.631814693.52820.23760.90690.72080.5
9312812.4813200.5811565.137214836.02280.32090.74280.4020.5
9412056.6713200.5811434.099914967.06010.10220.66660.37820.5
9511322.3813200.5811312.133415089.02660.02560.88240.31190.5
9611530.7513200.5811197.579915203.58010.05110.9670.48470.5
9711114.0813200.5811089.232515311.92750.02640.93940.37010.5
989181.7313200.5810986.1815414.982e-040.96760.26760.5
998614.5513200.5810887.714715513.44531e-040.99970.50.5

\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[87]) \tabularnewline
75 & 12185.15 & - & - & - & - & - & - & - \tabularnewline
76 & 12377.62 & - & - & - & - & - & - & - \tabularnewline
77 & 12512.89 & - & - & - & - & - & - & - \tabularnewline
78 & 12631.48 & - & - & - & - & - & - & - \tabularnewline
79 & 12268.53 & - & - & - & - & - & - & - \tabularnewline
80 & 12754.8 & - & - & - & - & - & - & - \tabularnewline
81 & 13407.75 & - & - & - & - & - & - & - \tabularnewline
82 & 13480.21 & - & - & - & - & - & - & - \tabularnewline
83 & 13673.28 & - & - & - & - & - & - & - \tabularnewline
84 & 13239.71 & - & - & - & - & - & - & - \tabularnewline
85 & 13557.69 & - & - & - & - & - & - & - \tabularnewline
86 & 13901.28 & - & - & - & - & - & - & - \tabularnewline
87 & 13200.58 & - & - & - & - & - & - & - \tabularnewline
88 & 13406.97 & 13200.58 & 12532.9133 & 13868.2467 & 0.2723 & 0.5 & 0.9922 & 0.5 \tabularnewline
89 & 12538.12 & 13200.58 & 12256.3567 & 14144.8033 & 0.0845 & 0.3342 & 0.9233 & 0.5 \tabularnewline
90 & 12419.57 & 13200.58 & 12044.1473 & 14357.0127 & 0.0928 & 0.8692 & 0.8326 & 0.5 \tabularnewline
91 & 12193.88 & 13200.58 & 11865.2466 & 14535.9134 & 0.0698 & 0.8742 & 0.9144 & 0.5 \tabularnewline
92 & 12656.63 & 13200.58 & 11707.6318 & 14693.5282 & 0.2376 & 0.9069 & 0.7208 & 0.5 \tabularnewline
93 & 12812.48 & 13200.58 & 11565.1372 & 14836.0228 & 0.3209 & 0.7428 & 0.402 & 0.5 \tabularnewline
94 & 12056.67 & 13200.58 & 11434.0999 & 14967.0601 & 0.1022 & 0.6666 & 0.3782 & 0.5 \tabularnewline
95 & 11322.38 & 13200.58 & 11312.1334 & 15089.0266 & 0.0256 & 0.8824 & 0.3119 & 0.5 \tabularnewline
96 & 11530.75 & 13200.58 & 11197.5799 & 15203.5801 & 0.0511 & 0.967 & 0.4847 & 0.5 \tabularnewline
97 & 11114.08 & 13200.58 & 11089.2325 & 15311.9275 & 0.0264 & 0.9394 & 0.3701 & 0.5 \tabularnewline
98 & 9181.73 & 13200.58 & 10986.18 & 15414.98 & 2e-04 & 0.9676 & 0.2676 & 0.5 \tabularnewline
99 & 8614.55 & 13200.58 & 10887.7147 & 15513.4453 & 1e-04 & 0.9997 & 0.5 & 0.5 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=35272&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[87])[/C][/ROW]
[ROW][C]75[/C][C]12185.15[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]76[/C][C]12377.62[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]77[/C][C]12512.89[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]78[/C][C]12631.48[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]79[/C][C]12268.53[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]80[/C][C]12754.8[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]81[/C][C]13407.75[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]82[/C][C]13480.21[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]83[/C][C]13673.28[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]84[/C][C]13239.71[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]85[/C][C]13557.69[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]86[/C][C]13901.28[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]87[/C][C]13200.58[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]88[/C][C]13406.97[/C][C]13200.58[/C][C]12532.9133[/C][C]13868.2467[/C][C]0.2723[/C][C]0.5[/C][C]0.9922[/C][C]0.5[/C][/ROW]
[ROW][C]89[/C][C]12538.12[/C][C]13200.58[/C][C]12256.3567[/C][C]14144.8033[/C][C]0.0845[/C][C]0.3342[/C][C]0.9233[/C][C]0.5[/C][/ROW]
[ROW][C]90[/C][C]12419.57[/C][C]13200.58[/C][C]12044.1473[/C][C]14357.0127[/C][C]0.0928[/C][C]0.8692[/C][C]0.8326[/C][C]0.5[/C][/ROW]
[ROW][C]91[/C][C]12193.88[/C][C]13200.58[/C][C]11865.2466[/C][C]14535.9134[/C][C]0.0698[/C][C]0.8742[/C][C]0.9144[/C][C]0.5[/C][/ROW]
[ROW][C]92[/C][C]12656.63[/C][C]13200.58[/C][C]11707.6318[/C][C]14693.5282[/C][C]0.2376[/C][C]0.9069[/C][C]0.7208[/C][C]0.5[/C][/ROW]
[ROW][C]93[/C][C]12812.48[/C][C]13200.58[/C][C]11565.1372[/C][C]14836.0228[/C][C]0.3209[/C][C]0.7428[/C][C]0.402[/C][C]0.5[/C][/ROW]
[ROW][C]94[/C][C]12056.67[/C][C]13200.58[/C][C]11434.0999[/C][C]14967.0601[/C][C]0.1022[/C][C]0.6666[/C][C]0.3782[/C][C]0.5[/C][/ROW]
[ROW][C]95[/C][C]11322.38[/C][C]13200.58[/C][C]11312.1334[/C][C]15089.0266[/C][C]0.0256[/C][C]0.8824[/C][C]0.3119[/C][C]0.5[/C][/ROW]
[ROW][C]96[/C][C]11530.75[/C][C]13200.58[/C][C]11197.5799[/C][C]15203.5801[/C][C]0.0511[/C][C]0.967[/C][C]0.4847[/C][C]0.5[/C][/ROW]
[ROW][C]97[/C][C]11114.08[/C][C]13200.58[/C][C]11089.2325[/C][C]15311.9275[/C][C]0.0264[/C][C]0.9394[/C][C]0.3701[/C][C]0.5[/C][/ROW]
[ROW][C]98[/C][C]9181.73[/C][C]13200.58[/C][C]10986.18[/C][C]15414.98[/C][C]2e-04[/C][C]0.9676[/C][C]0.2676[/C][C]0.5[/C][/ROW]
[ROW][C]99[/C][C]8614.55[/C][C]13200.58[/C][C]10887.7147[/C][C]15513.4453[/C][C]1e-04[/C][C]0.9997[/C][C]0.5[/C][C]0.5[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=35272&T=1

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=35272&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[87])
7512185.15-------
7612377.62-------
7712512.89-------
7812631.48-------
7912268.53-------
8012754.8-------
8113407.75-------
8213480.21-------
8313673.28-------
8413239.71-------
8513557.69-------
8613901.28-------
8713200.58-------
8813406.9713200.5812532.913313868.24670.27230.50.99220.5
8912538.1213200.5812256.356714144.80330.08450.33420.92330.5
9012419.5713200.5812044.147314357.01270.09280.86920.83260.5
9112193.8813200.5811865.246614535.91340.06980.87420.91440.5
9212656.6313200.5811707.631814693.52820.23760.90690.72080.5
9312812.4813200.5811565.137214836.02280.32090.74280.4020.5
9412056.6713200.5811434.099914967.06010.10220.66660.37820.5
9511322.3813200.5811312.133415089.02660.02560.88240.31190.5
9611530.7513200.5811197.579915203.58010.05110.9670.48470.5
9711114.0813200.5811089.232515311.92750.02640.93940.37010.5
989181.7313200.5810986.1815414.982e-040.96760.26760.5
998614.5513200.5810887.714715513.44531e-040.99970.50.5







Univariate ARIMA Extrapolation Forecast Performance
time% S.E.PEMAPESq.EMSERMSE
880.02580.01560.001342596.83213549.73659.5797
890.0365-0.05020.0042438853.251636571.1043191.2357
900.0447-0.05920.0049609976.620150831.385225.4582
910.0516-0.07630.00641013444.8984453.7408290.6093
920.0577-0.04120.0034295881.602524656.8002157.0248
930.0632-0.02940.0025150621.6112551.8008112.0348
940.0683-0.08670.00721308530.0881109044.174330.2184
950.073-0.14230.01193527635.24293969.6033542.1896
960.0774-0.12650.01052788332.2289232361.0191482.0384
970.0816-0.15810.01324353482.25362790.1875602.3207
980.0856-0.30440.025416151155.32251345929.61021160.1421
990.0894-0.34740.02921031671.16091752639.26341323.8728

\begin{tabular}{lllllllll}
\hline
Univariate ARIMA Extrapolation Forecast Performance \tabularnewline
time & % S.E. & PE & MAPE & Sq.E & MSE & RMSE \tabularnewline
88 & 0.0258 & 0.0156 & 0.0013 & 42596.8321 & 3549.736 & 59.5797 \tabularnewline
89 & 0.0365 & -0.0502 & 0.0042 & 438853.2516 & 36571.1043 & 191.2357 \tabularnewline
90 & 0.0447 & -0.0592 & 0.0049 & 609976.6201 & 50831.385 & 225.4582 \tabularnewline
91 & 0.0516 & -0.0763 & 0.0064 & 1013444.89 & 84453.7408 & 290.6093 \tabularnewline
92 & 0.0577 & -0.0412 & 0.0034 & 295881.6025 & 24656.8002 & 157.0248 \tabularnewline
93 & 0.0632 & -0.0294 & 0.0025 & 150621.61 & 12551.8008 & 112.0348 \tabularnewline
94 & 0.0683 & -0.0867 & 0.0072 & 1308530.0881 & 109044.174 & 330.2184 \tabularnewline
95 & 0.073 & -0.1423 & 0.0119 & 3527635.24 & 293969.6033 & 542.1896 \tabularnewline
96 & 0.0774 & -0.1265 & 0.0105 & 2788332.2289 & 232361.0191 & 482.0384 \tabularnewline
97 & 0.0816 & -0.1581 & 0.0132 & 4353482.25 & 362790.1875 & 602.3207 \tabularnewline
98 & 0.0856 & -0.3044 & 0.0254 & 16151155.3225 & 1345929.6102 & 1160.1421 \tabularnewline
99 & 0.0894 & -0.3474 & 0.029 & 21031671.1609 & 1752639.2634 & 1323.8728 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=35272&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]88[/C][C]0.0258[/C][C]0.0156[/C][C]0.0013[/C][C]42596.8321[/C][C]3549.736[/C][C]59.5797[/C][/ROW]
[ROW][C]89[/C][C]0.0365[/C][C]-0.0502[/C][C]0.0042[/C][C]438853.2516[/C][C]36571.1043[/C][C]191.2357[/C][/ROW]
[ROW][C]90[/C][C]0.0447[/C][C]-0.0592[/C][C]0.0049[/C][C]609976.6201[/C][C]50831.385[/C][C]225.4582[/C][/ROW]
[ROW][C]91[/C][C]0.0516[/C][C]-0.0763[/C][C]0.0064[/C][C]1013444.89[/C][C]84453.7408[/C][C]290.6093[/C][/ROW]
[ROW][C]92[/C][C]0.0577[/C][C]-0.0412[/C][C]0.0034[/C][C]295881.6025[/C][C]24656.8002[/C][C]157.0248[/C][/ROW]
[ROW][C]93[/C][C]0.0632[/C][C]-0.0294[/C][C]0.0025[/C][C]150621.61[/C][C]12551.8008[/C][C]112.0348[/C][/ROW]
[ROW][C]94[/C][C]0.0683[/C][C]-0.0867[/C][C]0.0072[/C][C]1308530.0881[/C][C]109044.174[/C][C]330.2184[/C][/ROW]
[ROW][C]95[/C][C]0.073[/C][C]-0.1423[/C][C]0.0119[/C][C]3527635.24[/C][C]293969.6033[/C][C]542.1896[/C][/ROW]
[ROW][C]96[/C][C]0.0774[/C][C]-0.1265[/C][C]0.0105[/C][C]2788332.2289[/C][C]232361.0191[/C][C]482.0384[/C][/ROW]
[ROW][C]97[/C][C]0.0816[/C][C]-0.1581[/C][C]0.0132[/C][C]4353482.25[/C][C]362790.1875[/C][C]602.3207[/C][/ROW]
[ROW][C]98[/C][C]0.0856[/C][C]-0.3044[/C][C]0.0254[/C][C]16151155.3225[/C][C]1345929.6102[/C][C]1160.1421[/C][/ROW]
[ROW][C]99[/C][C]0.0894[/C][C]-0.3474[/C][C]0.029[/C][C]21031671.1609[/C][C]1752639.2634[/C][C]1323.8728[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=35272&T=2

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=35272&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
880.02580.01560.001342596.83213549.73659.5797
890.0365-0.05020.0042438853.251636571.1043191.2357
900.0447-0.05920.0049609976.620150831.385225.4582
910.0516-0.07630.00641013444.8984453.7408290.6093
920.0577-0.04120.0034295881.602524656.8002157.0248
930.0632-0.02940.0025150621.6112551.8008112.0348
940.0683-0.08670.00721308530.0881109044.174330.2184
950.073-0.14230.01193527635.24293969.6033542.1896
960.0774-0.12650.01052788332.2289232361.0191482.0384
970.0816-0.15810.01324353482.25362790.1875602.3207
980.0856-0.30440.025416151155.32251345929.61021160.1421
990.0894-0.34740.02921031671.16091752639.26341323.8728



Parameters (Session):
par1 = 12 ; par2 = 1 ; par3 = 1 ; par4 = 0 ; par5 = 12 ; par6 = 0 ; par7 = 0 ; par8 = 0 ; par9 = 0 ; par10 = FALSE ;
Parameters (R input):
par1 = 12 ; par2 = 1 ; par3 = 1 ; par4 = 0 ; par5 = 12 ; par6 = 0 ; par7 = 0 ; 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,fx))
(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.se <- array(0, dim=fx)
perf.mse <- 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.mape[i] = perf.mape[i] + abs(perf.pe[i])
perf.se[i] = (x[nx+i] - forecast$pred[i])^2
perf.mse[i] = perf.mse[i] + perf.se[i]
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 = perf.mape / fx
perf.mse = perf.mse / fx
perf.rmse = sqrt(perf.mse)
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:12] <- 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.mape[i],4))
a<-table.element(a,round(perf.se[i],4))
a<-table.element(a,round(perf.mse[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')