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 computationSat, 25 Dec 2010 18:15:26 +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/25/t1293300781xgepyll0qga9dzb.htm/, Retrieved Sun, 28 Apr 2024 21:09:24 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=115432, Retrieved Sun, 28 Apr 2024 21:09:24 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact131
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] [ARIMA Forecasting...] [2010-12-06 13:02:50] [f4dc4aa51d65be851b8508203d9f6001]
-   PD        [ARIMA Forecasting] [ARIMA Forecasting...] [2010-12-19 20:46:40] [f4dc4aa51d65be851b8508203d9f6001]
-    D          [ARIMA Forecasting] [ARIMA FORECAST] [2010-12-25 16:51:28] [f9eaed74daea918f73b9f505c5b1f19e]
-    D              [ARIMA Forecasting] [Arima forecasting...] [2010-12-25 18:15:26] [2e49bff66bb3e1f5d7fa8957e12fbb12] [Current]
-   P                 [ARIMA Forecasting] [Arima forecasting...] [2010-12-25 18:35:08] [f9eaed74daea918f73b9f505c5b1f19e]
Feedback Forum

Post a new message
Dataseries X:
25.22
27.63
27.47
22.54
27.4
29.68
28.51
29.89
32.62
30.93
32.52
25.28
25.64
27.41
24.4
25.55
28.45
27.72
24.54
25.67
25.54
20.48
18.94
18.6
19.49
20.29
23.69
25.65
25.43
24.13
25.77
26.63
28.34
27.55
24.5
28.52
31.29
32.65
30.34
25.02
25.81
27.55
28.4
29.83
27.1
29.59
28.77
29.88
31.18
30.87
33.8
33.36
37.92
35.19
38.37
43.03
43.38
49.77
43.05
39.65
44.28
45.56
53.08
51.86
48.67
54.31
57.58
64.09
62.98
58.52
55.54
56.75
63.57
59.92
62.25
70.44
70.19
68.86
73.9
73.61
62.77
58.38
58.48
62.31
54.3
57.76
62.14
67.4
67.48
71.32
77.2
70.8
77.13
83.04
92.53
91.45
91.92
94.82
103.28
110.44
123.94
133.05
133.9
113.85
99.06
72.84
53.24
41.58
44.86
43.24
46.84
50.85
57.94
68.59
64.92
72.5
67.69
73.19
77.04
74.67 




Summary of computational transaction
Raw Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time2 seconds
R Server'RServer@AstonUniversity' @ vre.aston.ac.uk

\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 & 'RServer@AstonUniversity' @ vre.aston.ac.uk \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=115432&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]'RServer@AstonUniversity' @ vre.aston.ac.uk[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=115432&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=115432&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'RServer@AstonUniversity' @ vre.aston.ac.uk







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[108])
9691.45-------
9791.92-------
9894.82-------
99103.28-------
100110.44-------
101123.94-------
102133.05-------
103133.9-------
104113.85-------
10599.06-------
10672.84-------
10753.24-------
10841.58-------
10944.8634.494723.519445.470.03210.102900.1029
11043.2431.584312.511450.65710.11550.086200.1522
11146.8433.9317.417160.44480.170.245700.2859
11250.8536.67483.381669.96810.2020.274800.3864
11357.9440.3720.91179.83290.19140.301400.4761
11468.5943.919-1.173689.01170.14180.27111e-040.5405
11564.9246.4256-3.840396.69140.23540.19373e-040.5749
11672.539.1376-15.912894.1880.11750.17930.00390.4654
11767.6933.7475-25.758393.25330.13180.10090.01570.3982
11873.1925.4675-38.213989.14880.07090.09690.07240.31
11977.0420.099-47.518487.71630.04940.06190.16840.2668
12074.6716.4111-54.935787.75780.05470.04790.24460.2446

\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[108]) \tabularnewline
96 & 91.45 & - & - & - & - & - & - & - \tabularnewline
97 & 91.92 & - & - & - & - & - & - & - \tabularnewline
98 & 94.82 & - & - & - & - & - & - & - \tabularnewline
99 & 103.28 & - & - & - & - & - & - & - \tabularnewline
100 & 110.44 & - & - & - & - & - & - & - \tabularnewline
101 & 123.94 & - & - & - & - & - & - & - \tabularnewline
102 & 133.05 & - & - & - & - & - & - & - \tabularnewline
103 & 133.9 & - & - & - & - & - & - & - \tabularnewline
104 & 113.85 & - & - & - & - & - & - & - \tabularnewline
105 & 99.06 & - & - & - & - & - & - & - \tabularnewline
106 & 72.84 & - & - & - & - & - & - & - \tabularnewline
107 & 53.24 & - & - & - & - & - & - & - \tabularnewline
108 & 41.58 & - & - & - & - & - & - & - \tabularnewline
109 & 44.86 & 34.4947 & 23.5194 & 45.47 & 0.0321 & 0.1029 & 0 & 0.1029 \tabularnewline
110 & 43.24 & 31.5843 & 12.5114 & 50.6571 & 0.1155 & 0.0862 & 0 & 0.1522 \tabularnewline
111 & 46.84 & 33.931 & 7.4171 & 60.4448 & 0.17 & 0.2457 & 0 & 0.2859 \tabularnewline
112 & 50.85 & 36.6748 & 3.3816 & 69.9681 & 0.202 & 0.2748 & 0 & 0.3864 \tabularnewline
113 & 57.94 & 40.372 & 0.911 & 79.8329 & 0.1914 & 0.3014 & 0 & 0.4761 \tabularnewline
114 & 68.59 & 43.919 & -1.1736 & 89.0117 & 0.1418 & 0.2711 & 1e-04 & 0.5405 \tabularnewline
115 & 64.92 & 46.4256 & -3.8403 & 96.6914 & 0.2354 & 0.1937 & 3e-04 & 0.5749 \tabularnewline
116 & 72.5 & 39.1376 & -15.9128 & 94.188 & 0.1175 & 0.1793 & 0.0039 & 0.4654 \tabularnewline
117 & 67.69 & 33.7475 & -25.7583 & 93.2533 & 0.1318 & 0.1009 & 0.0157 & 0.3982 \tabularnewline
118 & 73.19 & 25.4675 & -38.2139 & 89.1488 & 0.0709 & 0.0969 & 0.0724 & 0.31 \tabularnewline
119 & 77.04 & 20.099 & -47.5184 & 87.7163 & 0.0494 & 0.0619 & 0.1684 & 0.2668 \tabularnewline
120 & 74.67 & 16.4111 & -54.9357 & 87.7578 & 0.0547 & 0.0479 & 0.2446 & 0.2446 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=115432&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[108])[/C][/ROW]
[ROW][C]96[/C][C]91.45[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]97[/C][C]91.92[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]98[/C][C]94.82[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]99[/C][C]103.28[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]100[/C][C]110.44[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]101[/C][C]123.94[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]102[/C][C]133.05[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]103[/C][C]133.9[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]104[/C][C]113.85[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]105[/C][C]99.06[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]106[/C][C]72.84[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]107[/C][C]53.24[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]108[/C][C]41.58[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]109[/C][C]44.86[/C][C]34.4947[/C][C]23.5194[/C][C]45.47[/C][C]0.0321[/C][C]0.1029[/C][C]0[/C][C]0.1029[/C][/ROW]
[ROW][C]110[/C][C]43.24[/C][C]31.5843[/C][C]12.5114[/C][C]50.6571[/C][C]0.1155[/C][C]0.0862[/C][C]0[/C][C]0.1522[/C][/ROW]
[ROW][C]111[/C][C]46.84[/C][C]33.931[/C][C]7.4171[/C][C]60.4448[/C][C]0.17[/C][C]0.2457[/C][C]0[/C][C]0.2859[/C][/ROW]
[ROW][C]112[/C][C]50.85[/C][C]36.6748[/C][C]3.3816[/C][C]69.9681[/C][C]0.202[/C][C]0.2748[/C][C]0[/C][C]0.3864[/C][/ROW]
[ROW][C]113[/C][C]57.94[/C][C]40.372[/C][C]0.911[/C][C]79.8329[/C][C]0.1914[/C][C]0.3014[/C][C]0[/C][C]0.4761[/C][/ROW]
[ROW][C]114[/C][C]68.59[/C][C]43.919[/C][C]-1.1736[/C][C]89.0117[/C][C]0.1418[/C][C]0.2711[/C][C]1e-04[/C][C]0.5405[/C][/ROW]
[ROW][C]115[/C][C]64.92[/C][C]46.4256[/C][C]-3.8403[/C][C]96.6914[/C][C]0.2354[/C][C]0.1937[/C][C]3e-04[/C][C]0.5749[/C][/ROW]
[ROW][C]116[/C][C]72.5[/C][C]39.1376[/C][C]-15.9128[/C][C]94.188[/C][C]0.1175[/C][C]0.1793[/C][C]0.0039[/C][C]0.4654[/C][/ROW]
[ROW][C]117[/C][C]67.69[/C][C]33.7475[/C][C]-25.7583[/C][C]93.2533[/C][C]0.1318[/C][C]0.1009[/C][C]0.0157[/C][C]0.3982[/C][/ROW]
[ROW][C]118[/C][C]73.19[/C][C]25.4675[/C][C]-38.2139[/C][C]89.1488[/C][C]0.0709[/C][C]0.0969[/C][C]0.0724[/C][C]0.31[/C][/ROW]
[ROW][C]119[/C][C]77.04[/C][C]20.099[/C][C]-47.5184[/C][C]87.7163[/C][C]0.0494[/C][C]0.0619[/C][C]0.1684[/C][C]0.2668[/C][/ROW]
[ROW][C]120[/C][C]74.67[/C][C]16.4111[/C][C]-54.9357[/C][C]87.7578[/C][C]0.0547[/C][C]0.0479[/C][C]0.2446[/C][C]0.2446[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=115432&T=1

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=115432&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[108])
9691.45-------
9791.92-------
9894.82-------
99103.28-------
100110.44-------
101123.94-------
102133.05-------
103133.9-------
104113.85-------
10599.06-------
10672.84-------
10753.24-------
10841.58-------
10944.8634.494723.519445.470.03210.102900.1029
11043.2431.584312.511450.65710.11550.086200.1522
11146.8433.9317.417160.44480.170.245700.2859
11250.8536.67483.381669.96810.2020.274800.3864
11357.9440.3720.91179.83290.19140.301400.4761
11468.5943.919-1.173689.01170.14180.27111e-040.5405
11564.9246.4256-3.840396.69140.23540.19373e-040.5749
11672.539.1376-15.912894.1880.11750.17930.00390.4654
11767.6933.7475-25.758393.25330.13180.10090.01570.3982
11873.1925.4675-38.213989.14880.07090.09690.07240.31
11977.0420.099-47.518487.71630.04940.06190.16840.2668
12074.6716.4111-54.935787.75780.05470.04790.24460.2446







Univariate ARIMA Extrapolation Forecast Performance
time% S.E.PEMAPESq.EMSERMSE
1090.16230.30050107.439500
1100.30810.3690.3348135.8565121.64811.0294
1110.39870.38040.35166.6427136.646211.6896
1120.46320.38650.3591200.936152.718612.3579
1130.49870.43520.3743308.636183.902113.5611
1140.52380.56170.4056608.6567254.694515.9592
1150.55240.39840.4045342.044267.17316.3454
1160.71760.85240.46051113.0521372.907919.3108
1170.89961.00580.52111152.0943459.484221.4356
1181.27581.87390.65642277.4379641.279625.3235
1191.71642.8330.85433242.2796877.734129.6266
1202.21813.551.07893394.1051087.431732.9762

\begin{tabular}{lllllllll}
\hline
Univariate ARIMA Extrapolation Forecast Performance \tabularnewline
time & % S.E. & PE & MAPE & Sq.E & MSE & RMSE \tabularnewline
109 & 0.1623 & 0.3005 & 0 & 107.4395 & 0 & 0 \tabularnewline
110 & 0.3081 & 0.369 & 0.3348 & 135.8565 & 121.648 & 11.0294 \tabularnewline
111 & 0.3987 & 0.3804 & 0.35 & 166.6427 & 136.6462 & 11.6896 \tabularnewline
112 & 0.4632 & 0.3865 & 0.3591 & 200.936 & 152.7186 & 12.3579 \tabularnewline
113 & 0.4987 & 0.4352 & 0.3743 & 308.636 & 183.9021 & 13.5611 \tabularnewline
114 & 0.5238 & 0.5617 & 0.4056 & 608.6567 & 254.6945 & 15.9592 \tabularnewline
115 & 0.5524 & 0.3984 & 0.4045 & 342.044 & 267.173 & 16.3454 \tabularnewline
116 & 0.7176 & 0.8524 & 0.4605 & 1113.0521 & 372.9079 & 19.3108 \tabularnewline
117 & 0.8996 & 1.0058 & 0.5211 & 1152.0943 & 459.4842 & 21.4356 \tabularnewline
118 & 1.2758 & 1.8739 & 0.6564 & 2277.4379 & 641.2796 & 25.3235 \tabularnewline
119 & 1.7164 & 2.833 & 0.8543 & 3242.2796 & 877.7341 & 29.6266 \tabularnewline
120 & 2.2181 & 3.55 & 1.0789 & 3394.105 & 1087.4317 & 32.9762 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=115432&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]109[/C][C]0.1623[/C][C]0.3005[/C][C]0[/C][C]107.4395[/C][C]0[/C][C]0[/C][/ROW]
[ROW][C]110[/C][C]0.3081[/C][C]0.369[/C][C]0.3348[/C][C]135.8565[/C][C]121.648[/C][C]11.0294[/C][/ROW]
[ROW][C]111[/C][C]0.3987[/C][C]0.3804[/C][C]0.35[/C][C]166.6427[/C][C]136.6462[/C][C]11.6896[/C][/ROW]
[ROW][C]112[/C][C]0.4632[/C][C]0.3865[/C][C]0.3591[/C][C]200.936[/C][C]152.7186[/C][C]12.3579[/C][/ROW]
[ROW][C]113[/C][C]0.4987[/C][C]0.4352[/C][C]0.3743[/C][C]308.636[/C][C]183.9021[/C][C]13.5611[/C][/ROW]
[ROW][C]114[/C][C]0.5238[/C][C]0.5617[/C][C]0.4056[/C][C]608.6567[/C][C]254.6945[/C][C]15.9592[/C][/ROW]
[ROW][C]115[/C][C]0.5524[/C][C]0.3984[/C][C]0.4045[/C][C]342.044[/C][C]267.173[/C][C]16.3454[/C][/ROW]
[ROW][C]116[/C][C]0.7176[/C][C]0.8524[/C][C]0.4605[/C][C]1113.0521[/C][C]372.9079[/C][C]19.3108[/C][/ROW]
[ROW][C]117[/C][C]0.8996[/C][C]1.0058[/C][C]0.5211[/C][C]1152.0943[/C][C]459.4842[/C][C]21.4356[/C][/ROW]
[ROW][C]118[/C][C]1.2758[/C][C]1.8739[/C][C]0.6564[/C][C]2277.4379[/C][C]641.2796[/C][C]25.3235[/C][/ROW]
[ROW][C]119[/C][C]1.7164[/C][C]2.833[/C][C]0.8543[/C][C]3242.2796[/C][C]877.7341[/C][C]29.6266[/C][/ROW]
[ROW][C]120[/C][C]2.2181[/C][C]3.55[/C][C]1.0789[/C][C]3394.105[/C][C]1087.4317[/C][C]32.9762[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=115432&T=2

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=115432&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
1090.16230.30050107.439500
1100.30810.3690.3348135.8565121.64811.0294
1110.39870.38040.35166.6427136.646211.6896
1120.46320.38650.3591200.936152.718612.3579
1130.49870.43520.3743308.636183.902113.5611
1140.52380.56170.4056608.6567254.694515.9592
1150.55240.39840.4045342.044267.17316.3454
1160.71760.85240.46051113.0521372.907919.3108
1170.89961.00580.52111152.0943459.484221.4356
1181.27581.87390.65642277.4379641.279625.3235
1191.71642.8330.85433242.2796877.734129.6266
1202.21813.551.07893394.1051087.431732.9762



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