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 computationWed, 30 Dec 2009 16:46:48 -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/Dec/31/t1262216907ttje6cbawp4w0h0.htm/, Retrieved Thu, 02 May 2024 12:59:23 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=71402, Retrieved Thu, 02 May 2024 12:59:23 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact153
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   [ARIMA Backward Selection] [] [2009-11-27 14:53:14] [b98453cac15ba1066b407e146608df68]
-   PD    [ARIMA Backward Selection] [WS09 - Problem if...] [2009-12-02 16:23:55] [df6326eec97a6ca984a853b142930499]
-           [ARIMA Backward Selection] [WS09 - Backward A...] [2009-12-02 20:17:40] [df6326eec97a6ca984a853b142930499]
- RM          [ARIMA Forecasting] [WS10 - Voorspelling] [2009-12-02 21:21:36] [df6326eec97a6ca984a853b142930499]
-    D            [ARIMA Forecasting] [CaseStatistiek - ...] [2009-12-30 23:46:48] [0cc924834281808eda7297686c82928f] [Current]
Feedback Forum

Post a new message
Dataseries X:
15
14.4
13.5
12.8
12.3
12.2
14.5
17.2
18
18.1
18
18.3
18.7
18.6
18.3
17.9
17.4
17.4
20.1
23.2
24.2
24.2
23.9
23.8
23.8
23.3
22.4
21.5
20.5
19.9
22
24.9
25.7
25.3
24.4
23.8
23.5
23
22.2
21.4
20.3
19.5
21.7
24.7
25.3
24.9
24.1
23.4
23.1
22.4
21.3
20.3
19.3
18.7
21
24
24.8
24.2
23.3
22.7
22.3
21.8
21.2
20.5
19.7
19.2
21.2
23.9
24.8
24.2
23
22.2
21.8
21.2
20.5
19.7
19
18.4
20.7
24.5
26
25.2
24.1
23.7
23.5
23.1
22.7
22.5
21.7
20.5
21.9
22.9
21.5
19
17
16.1
15.9
15.7
15.1
14.8
14.3
14.5
18.9
21.6
20.4
17.9
15.7
14.5
14
13.9
14.4
15.8
15.6
14.7
16.7
17.9
18.7
20.1
19.5
19.4
18.6
17.8
17.1
16.5
15.5
14.9
18.6
19.1
18.8
18.2
18
19
20.7
21.2
20.7
19.6
18.6
18.7
23.8
24.9
24.8
23.8
22.3
21.7
20.7
19.7
18.4
17.4
17
18
23.8
25.5
25.6
23.7
22
21.3
20.7
20.4
20.3
20.4
19.8
19.5
23.1
23.5
23.5
22.9
21.9
21.5
20.5
20.2
19.4
19.2
18.8
18.8
22.6
23.3
23
21.4
19.9
18.8
18.6
18.4
18.6
19.9
19.2
18.4
21.1
20.5
19.1
18.1
17
17.1
17.4
16.8
15.3
14.3
13.4
15.3
22.1
23.7
22.2
19.5
16.6
17.3
19.8
21.2
21.5
20.6
19.1
19.6
23.5
24
23.2
21.2




Summary of computational transaction
Raw Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time2 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 & 2 seconds \tabularnewline
R Server & 'Gwilym Jenkins' @ 72.249.127.135 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=71402&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]'Gwilym Jenkins' @ 72.249.127.135[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=71402&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=71402&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'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[202])
19018.1-------
19117-------
19217.1-------
19317.4-------
19416.8-------
19515.3-------
19614.3-------
19713.4-------
19815.3-------
19922.1-------
20023.7-------
20122.2-------
20219.5-------
20316.616.815315.657217.97330.357800.37730
20417.315.901513.488918.31410.1280.28520.16510.0017
20519.816.135912.609319.66260.02090.25880.24120.0308
20621.216.350112.067820.63250.01320.05720.41840.0747
20721.516.016311.298820.73380.01140.01560.6170.0739
20820.615.96110.994520.92750.03360.01440.74390.0813
20919.115.07879.92920.22850.06290.01780.73860.0462
21019.615.752510.410321.09470.0790.10970.56590.0846
21123.520.867815.287126.44860.17760.67190.33260.6845
2122421.691315.828427.55430.22010.27270.25090.7681
21323.220.459414.302626.61610.19150.12980.28970.62
21421.218.499512.069624.92940.20520.0760.38020.3802

\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[202]) \tabularnewline
190 & 18.1 & - & - & - & - & - & - & - \tabularnewline
191 & 17 & - & - & - & - & - & - & - \tabularnewline
192 & 17.1 & - & - & - & - & - & - & - \tabularnewline
193 & 17.4 & - & - & - & - & - & - & - \tabularnewline
194 & 16.8 & - & - & - & - & - & - & - \tabularnewline
195 & 15.3 & - & - & - & - & - & - & - \tabularnewline
196 & 14.3 & - & - & - & - & - & - & - \tabularnewline
197 & 13.4 & - & - & - & - & - & - & - \tabularnewline
198 & 15.3 & - & - & - & - & - & - & - \tabularnewline
199 & 22.1 & - & - & - & - & - & - & - \tabularnewline
200 & 23.7 & - & - & - & - & - & - & - \tabularnewline
201 & 22.2 & - & - & - & - & - & - & - \tabularnewline
202 & 19.5 & - & - & - & - & - & - & - \tabularnewline
203 & 16.6 & 16.8153 & 15.6572 & 17.9733 & 0.3578 & 0 & 0.3773 & 0 \tabularnewline
204 & 17.3 & 15.9015 & 13.4889 & 18.3141 & 0.128 & 0.2852 & 0.1651 & 0.0017 \tabularnewline
205 & 19.8 & 16.1359 & 12.6093 & 19.6626 & 0.0209 & 0.2588 & 0.2412 & 0.0308 \tabularnewline
206 & 21.2 & 16.3501 & 12.0678 & 20.6325 & 0.0132 & 0.0572 & 0.4184 & 0.0747 \tabularnewline
207 & 21.5 & 16.0163 & 11.2988 & 20.7338 & 0.0114 & 0.0156 & 0.617 & 0.0739 \tabularnewline
208 & 20.6 & 15.961 & 10.9945 & 20.9275 & 0.0336 & 0.0144 & 0.7439 & 0.0813 \tabularnewline
209 & 19.1 & 15.0787 & 9.929 & 20.2285 & 0.0629 & 0.0178 & 0.7386 & 0.0462 \tabularnewline
210 & 19.6 & 15.7525 & 10.4103 & 21.0947 & 0.079 & 0.1097 & 0.5659 & 0.0846 \tabularnewline
211 & 23.5 & 20.8678 & 15.2871 & 26.4486 & 0.1776 & 0.6719 & 0.3326 & 0.6845 \tabularnewline
212 & 24 & 21.6913 & 15.8284 & 27.5543 & 0.2201 & 0.2727 & 0.2509 & 0.7681 \tabularnewline
213 & 23.2 & 20.4594 & 14.3026 & 26.6161 & 0.1915 & 0.1298 & 0.2897 & 0.62 \tabularnewline
214 & 21.2 & 18.4995 & 12.0696 & 24.9294 & 0.2052 & 0.076 & 0.3802 & 0.3802 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=71402&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[202])[/C][/ROW]
[ROW][C]190[/C][C]18.1[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]191[/C][C]17[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]192[/C][C]17.1[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]193[/C][C]17.4[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]194[/C][C]16.8[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]195[/C][C]15.3[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]196[/C][C]14.3[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]197[/C][C]13.4[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]198[/C][C]15.3[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]199[/C][C]22.1[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]200[/C][C]23.7[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]201[/C][C]22.2[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]202[/C][C]19.5[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]203[/C][C]16.6[/C][C]16.8153[/C][C]15.6572[/C][C]17.9733[/C][C]0.3578[/C][C]0[/C][C]0.3773[/C][C]0[/C][/ROW]
[ROW][C]204[/C][C]17.3[/C][C]15.9015[/C][C]13.4889[/C][C]18.3141[/C][C]0.128[/C][C]0.2852[/C][C]0.1651[/C][C]0.0017[/C][/ROW]
[ROW][C]205[/C][C]19.8[/C][C]16.1359[/C][C]12.6093[/C][C]19.6626[/C][C]0.0209[/C][C]0.2588[/C][C]0.2412[/C][C]0.0308[/C][/ROW]
[ROW][C]206[/C][C]21.2[/C][C]16.3501[/C][C]12.0678[/C][C]20.6325[/C][C]0.0132[/C][C]0.0572[/C][C]0.4184[/C][C]0.0747[/C][/ROW]
[ROW][C]207[/C][C]21.5[/C][C]16.0163[/C][C]11.2988[/C][C]20.7338[/C][C]0.0114[/C][C]0.0156[/C][C]0.617[/C][C]0.0739[/C][/ROW]
[ROW][C]208[/C][C]20.6[/C][C]15.961[/C][C]10.9945[/C][C]20.9275[/C][C]0.0336[/C][C]0.0144[/C][C]0.7439[/C][C]0.0813[/C][/ROW]
[ROW][C]209[/C][C]19.1[/C][C]15.0787[/C][C]9.929[/C][C]20.2285[/C][C]0.0629[/C][C]0.0178[/C][C]0.7386[/C][C]0.0462[/C][/ROW]
[ROW][C]210[/C][C]19.6[/C][C]15.7525[/C][C]10.4103[/C][C]21.0947[/C][C]0.079[/C][C]0.1097[/C][C]0.5659[/C][C]0.0846[/C][/ROW]
[ROW][C]211[/C][C]23.5[/C][C]20.8678[/C][C]15.2871[/C][C]26.4486[/C][C]0.1776[/C][C]0.6719[/C][C]0.3326[/C][C]0.6845[/C][/ROW]
[ROW][C]212[/C][C]24[/C][C]21.6913[/C][C]15.8284[/C][C]27.5543[/C][C]0.2201[/C][C]0.2727[/C][C]0.2509[/C][C]0.7681[/C][/ROW]
[ROW][C]213[/C][C]23.2[/C][C]20.4594[/C][C]14.3026[/C][C]26.6161[/C][C]0.1915[/C][C]0.1298[/C][C]0.2897[/C][C]0.62[/C][/ROW]
[ROW][C]214[/C][C]21.2[/C][C]18.4995[/C][C]12.0696[/C][C]24.9294[/C][C]0.2052[/C][C]0.076[/C][C]0.3802[/C][C]0.3802[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=71402&T=1

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=71402&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[202])
19018.1-------
19117-------
19217.1-------
19317.4-------
19416.8-------
19515.3-------
19614.3-------
19713.4-------
19815.3-------
19922.1-------
20023.7-------
20122.2-------
20219.5-------
20316.616.815315.657217.97330.357800.37730
20417.315.901513.488918.31410.1280.28520.16510.0017
20519.816.135912.609319.66260.02090.25880.24120.0308
20621.216.350112.067820.63250.01320.05720.41840.0747
20721.516.016311.298820.73380.01140.01560.6170.0739
20820.615.96110.994520.92750.03360.01440.74390.0813
20919.115.07879.92920.22850.06290.01780.73860.0462
21019.615.752510.410321.09470.0790.10970.56590.0846
21123.520.867815.287126.44860.17760.67190.33260.6845
2122421.691315.828427.55430.22010.27270.25090.7681
21323.220.459414.302626.61610.19150.12980.28970.62
21421.218.499512.069624.92940.20520.0760.38020.3802







Univariate ARIMA Extrapolation Forecast Performance
time% S.E.PEMAPESq.EMSERMSE
2030.0351-0.01280.00110.04630.00390.0621
2040.07740.08790.00731.95580.1630.4037
2050.11150.22710.018913.42541.11881.0577
2060.13360.29660.024723.5211.96011.4
2070.15030.34240.028530.07092.50591.583
2080.15880.29060.024221.52011.79331.3392
2090.17420.26670.022216.17051.34751.1608
2100.1730.24420.020414.80341.23361.1107
2110.13640.12610.01056.92830.57740.7598
2120.13790.10640.00895.32990.44420.6665
2130.15350.1340.01127.51110.62590.7912
2140.17730.1460.01227.29250.60770.7796

\begin{tabular}{lllllllll}
\hline
Univariate ARIMA Extrapolation Forecast Performance \tabularnewline
time & % S.E. & PE & MAPE & Sq.E & MSE & RMSE \tabularnewline
203 & 0.0351 & -0.0128 & 0.0011 & 0.0463 & 0.0039 & 0.0621 \tabularnewline
204 & 0.0774 & 0.0879 & 0.0073 & 1.9558 & 0.163 & 0.4037 \tabularnewline
205 & 0.1115 & 0.2271 & 0.0189 & 13.4254 & 1.1188 & 1.0577 \tabularnewline
206 & 0.1336 & 0.2966 & 0.0247 & 23.521 & 1.9601 & 1.4 \tabularnewline
207 & 0.1503 & 0.3424 & 0.0285 & 30.0709 & 2.5059 & 1.583 \tabularnewline
208 & 0.1588 & 0.2906 & 0.0242 & 21.5201 & 1.7933 & 1.3392 \tabularnewline
209 & 0.1742 & 0.2667 & 0.0222 & 16.1705 & 1.3475 & 1.1608 \tabularnewline
210 & 0.173 & 0.2442 & 0.0204 & 14.8034 & 1.2336 & 1.1107 \tabularnewline
211 & 0.1364 & 0.1261 & 0.0105 & 6.9283 & 0.5774 & 0.7598 \tabularnewline
212 & 0.1379 & 0.1064 & 0.0089 & 5.3299 & 0.4442 & 0.6665 \tabularnewline
213 & 0.1535 & 0.134 & 0.0112 & 7.5111 & 0.6259 & 0.7912 \tabularnewline
214 & 0.1773 & 0.146 & 0.0122 & 7.2925 & 0.6077 & 0.7796 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=71402&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]203[/C][C]0.0351[/C][C]-0.0128[/C][C]0.0011[/C][C]0.0463[/C][C]0.0039[/C][C]0.0621[/C][/ROW]
[ROW][C]204[/C][C]0.0774[/C][C]0.0879[/C][C]0.0073[/C][C]1.9558[/C][C]0.163[/C][C]0.4037[/C][/ROW]
[ROW][C]205[/C][C]0.1115[/C][C]0.2271[/C][C]0.0189[/C][C]13.4254[/C][C]1.1188[/C][C]1.0577[/C][/ROW]
[ROW][C]206[/C][C]0.1336[/C][C]0.2966[/C][C]0.0247[/C][C]23.521[/C][C]1.9601[/C][C]1.4[/C][/ROW]
[ROW][C]207[/C][C]0.1503[/C][C]0.3424[/C][C]0.0285[/C][C]30.0709[/C][C]2.5059[/C][C]1.583[/C][/ROW]
[ROW][C]208[/C][C]0.1588[/C][C]0.2906[/C][C]0.0242[/C][C]21.5201[/C][C]1.7933[/C][C]1.3392[/C][/ROW]
[ROW][C]209[/C][C]0.1742[/C][C]0.2667[/C][C]0.0222[/C][C]16.1705[/C][C]1.3475[/C][C]1.1608[/C][/ROW]
[ROW][C]210[/C][C]0.173[/C][C]0.2442[/C][C]0.0204[/C][C]14.8034[/C][C]1.2336[/C][C]1.1107[/C][/ROW]
[ROW][C]211[/C][C]0.1364[/C][C]0.1261[/C][C]0.0105[/C][C]6.9283[/C][C]0.5774[/C][C]0.7598[/C][/ROW]
[ROW][C]212[/C][C]0.1379[/C][C]0.1064[/C][C]0.0089[/C][C]5.3299[/C][C]0.4442[/C][C]0.6665[/C][/ROW]
[ROW][C]213[/C][C]0.1535[/C][C]0.134[/C][C]0.0112[/C][C]7.5111[/C][C]0.6259[/C][C]0.7912[/C][/ROW]
[ROW][C]214[/C][C]0.1773[/C][C]0.146[/C][C]0.0122[/C][C]7.2925[/C][C]0.6077[/C][C]0.7796[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=71402&T=2

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=71402&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
2030.0351-0.01280.00110.04630.00390.0621
2040.07740.08790.00731.95580.1630.4037
2050.11150.22710.018913.42541.11881.0577
2060.13360.29660.024723.5211.96011.4
2070.15030.34240.028530.07092.50591.583
2080.15880.29060.024221.52011.79331.3392
2090.17420.26670.022216.17051.34751.1608
2100.1730.24420.020414.80341.23361.1107
2110.13640.12610.01056.92830.57740.7598
2120.13790.10640.00895.32990.44420.6665
2130.15350.1340.01127.51110.62590.7912
2140.17730.1460.01227.29250.60770.7796



Parameters (Session):
par1 = FALSE ; par2 = 1 ; par3 = 1 ; par4 = 1 ; par5 = 12 ; par6 = 3 ; par7 = 1 ; par8 = 2 ; par9 = 1 ;
Parameters (R input):
par1 = 12 ; par2 = 1 ; par3 = 1 ; par4 = 1 ; par5 = 12 ; par6 = 3 ; par7 = 0 ; par8 = 0 ; par9 = 1 ; 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')