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:35:08 +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/t1293301963z8dgkrpdhok16z6.htm/, Retrieved Mon, 29 Apr 2024 00:48:27 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=115434, Retrieved Mon, 29 Apr 2024 00:48:27 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact132
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] [f9eaed74daea918f73b9f505c5b1f19e]
-   P                 [ARIMA Forecasting] [Arima forecasting...] [2010-12-25 18:35:08] [2e49bff66bb3e1f5d7fa8957e12fbb12] [Current]
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=115434&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=115434&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=115434&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.8640.650431.865253.64090.26270.444200.4442
11043.2442.359829.339266.44930.47150.419400.5253
11146.8444.093828.292978.05350.4370.51973e-040.5577
11250.8546.671127.637495.11080.43290.49730.00490.5816
11357.9449.727227.5306115.54310.40340.48670.01360.5959
11468.5952.447527.1786140.55750.35980.45140.03650.5955
11564.9252.302225.9776154.90390.40480.37780.05950.5811
11672.547.425523.271144.73370.30680.36230.09050.5469
11767.6943.141321.0326133.80910.29780.26280.11340.5135
11873.1935.128817.6285101.47890.13040.16810.13260.4244
11977.0428.060814.61374.36930.01910.02810.14330.2836
12074.6723.412412.505358.66790.00220.00140.15620.1562

\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 & 40.6504 & 31.8652 & 53.6409 & 0.2627 & 0.4442 & 0 & 0.4442 \tabularnewline
110 & 43.24 & 42.3598 & 29.3392 & 66.4493 & 0.4715 & 0.4194 & 0 & 0.5253 \tabularnewline
111 & 46.84 & 44.0938 & 28.2929 & 78.0535 & 0.437 & 0.5197 & 3e-04 & 0.5577 \tabularnewline
112 & 50.85 & 46.6711 & 27.6374 & 95.1108 & 0.4329 & 0.4973 & 0.0049 & 0.5816 \tabularnewline
113 & 57.94 & 49.7272 & 27.5306 & 115.5431 & 0.4034 & 0.4867 & 0.0136 & 0.5959 \tabularnewline
114 & 68.59 & 52.4475 & 27.1786 & 140.5575 & 0.3598 & 0.4514 & 0.0365 & 0.5955 \tabularnewline
115 & 64.92 & 52.3022 & 25.9776 & 154.9039 & 0.4048 & 0.3778 & 0.0595 & 0.5811 \tabularnewline
116 & 72.5 & 47.4255 & 23.271 & 144.7337 & 0.3068 & 0.3623 & 0.0905 & 0.5469 \tabularnewline
117 & 67.69 & 43.1413 & 21.0326 & 133.8091 & 0.2978 & 0.2628 & 0.1134 & 0.5135 \tabularnewline
118 & 73.19 & 35.1288 & 17.6285 & 101.4789 & 0.1304 & 0.1681 & 0.1326 & 0.4244 \tabularnewline
119 & 77.04 & 28.0608 & 14.613 & 74.3693 & 0.0191 & 0.0281 & 0.1433 & 0.2836 \tabularnewline
120 & 74.67 & 23.4124 & 12.5053 & 58.6679 & 0.0022 & 0.0014 & 0.1562 & 0.1562 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=115434&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]40.6504[/C][C]31.8652[/C][C]53.6409[/C][C]0.2627[/C][C]0.4442[/C][C]0[/C][C]0.4442[/C][/ROW]
[ROW][C]110[/C][C]43.24[/C][C]42.3598[/C][C]29.3392[/C][C]66.4493[/C][C]0.4715[/C][C]0.4194[/C][C]0[/C][C]0.5253[/C][/ROW]
[ROW][C]111[/C][C]46.84[/C][C]44.0938[/C][C]28.2929[/C][C]78.0535[/C][C]0.437[/C][C]0.5197[/C][C]3e-04[/C][C]0.5577[/C][/ROW]
[ROW][C]112[/C][C]50.85[/C][C]46.6711[/C][C]27.6374[/C][C]95.1108[/C][C]0.4329[/C][C]0.4973[/C][C]0.0049[/C][C]0.5816[/C][/ROW]
[ROW][C]113[/C][C]57.94[/C][C]49.7272[/C][C]27.5306[/C][C]115.5431[/C][C]0.4034[/C][C]0.4867[/C][C]0.0136[/C][C]0.5959[/C][/ROW]
[ROW][C]114[/C][C]68.59[/C][C]52.4475[/C][C]27.1786[/C][C]140.5575[/C][C]0.3598[/C][C]0.4514[/C][C]0.0365[/C][C]0.5955[/C][/ROW]
[ROW][C]115[/C][C]64.92[/C][C]52.3022[/C][C]25.9776[/C][C]154.9039[/C][C]0.4048[/C][C]0.3778[/C][C]0.0595[/C][C]0.5811[/C][/ROW]
[ROW][C]116[/C][C]72.5[/C][C]47.4255[/C][C]23.271[/C][C]144.7337[/C][C]0.3068[/C][C]0.3623[/C][C]0.0905[/C][C]0.5469[/C][/ROW]
[ROW][C]117[/C][C]67.69[/C][C]43.1413[/C][C]21.0326[/C][C]133.8091[/C][C]0.2978[/C][C]0.2628[/C][C]0.1134[/C][C]0.5135[/C][/ROW]
[ROW][C]118[/C][C]73.19[/C][C]35.1288[/C][C]17.6285[/C][C]101.4789[/C][C]0.1304[/C][C]0.1681[/C][C]0.1326[/C][C]0.4244[/C][/ROW]
[ROW][C]119[/C][C]77.04[/C][C]28.0608[/C][C]14.613[/C][C]74.3693[/C][C]0.0191[/C][C]0.0281[/C][C]0.1433[/C][C]0.2836[/C][/ROW]
[ROW][C]120[/C][C]74.67[/C][C]23.4124[/C][C]12.5053[/C][C]58.6679[/C][C]0.0022[/C][C]0.0014[/C][C]0.1562[/C][C]0.1562[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=115434&T=1

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=115434&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.8640.650431.865253.64090.26270.444200.4442
11043.2442.359829.339266.44930.47150.419400.5253
11146.8444.093828.292978.05350.4370.51973e-040.5577
11250.8546.671127.637495.11080.43290.49730.00490.5816
11357.9449.727227.5306115.54310.40340.48670.01360.5959
11468.5952.447527.1786140.55750.35980.45140.03650.5955
11564.9252.302225.9776154.90390.40480.37780.05950.5811
11672.547.425523.271144.73370.30680.36230.09050.5469
11767.6943.141321.0326133.80910.29780.26280.11340.5135
11873.1935.128817.6285101.47890.13040.16810.13260.4244
11977.0428.060814.61374.36930.01910.02810.14330.2836
12074.6723.412412.505358.66790.00220.00140.15620.1562







Univariate ARIMA Extrapolation Forecast Performance
time% S.E.PEMAPESq.EMSERMSE
1090.1630.1036017.720500
1100.29010.02080.06220.77489.24773.041
1110.39290.06230.06227.54178.6792.946
1120.52950.08950.06917.462810.8753.2977
1130.67530.16520.088367.450622.19014.7106
1140.85710.30780.1248260.580461.92187.869
1151.00090.24120.1415159.208875.81998.7075
1161.04680.52870.1899628.7323144.93412.0389
1171.07230.5690.232602.6388195.790113.9925
1180.96371.08350.31721448.6577321.076817.9186
1190.8421.74550.4472398.9572509.975122.5826
1200.76832.18930.59222627.3453686.422626.1997

\begin{tabular}{lllllllll}
\hline
Univariate ARIMA Extrapolation Forecast Performance \tabularnewline
time & % S.E. & PE & MAPE & Sq.E & MSE & RMSE \tabularnewline
109 & 0.163 & 0.1036 & 0 & 17.7205 & 0 & 0 \tabularnewline
110 & 0.2901 & 0.0208 & 0.0622 & 0.7748 & 9.2477 & 3.041 \tabularnewline
111 & 0.3929 & 0.0623 & 0.0622 & 7.5417 & 8.679 & 2.946 \tabularnewline
112 & 0.5295 & 0.0895 & 0.069 & 17.4628 & 10.875 & 3.2977 \tabularnewline
113 & 0.6753 & 0.1652 & 0.0883 & 67.4506 & 22.1901 & 4.7106 \tabularnewline
114 & 0.8571 & 0.3078 & 0.1248 & 260.5804 & 61.9218 & 7.869 \tabularnewline
115 & 1.0009 & 0.2412 & 0.1415 & 159.2088 & 75.8199 & 8.7075 \tabularnewline
116 & 1.0468 & 0.5287 & 0.1899 & 628.7323 & 144.934 & 12.0389 \tabularnewline
117 & 1.0723 & 0.569 & 0.232 & 602.6388 & 195.7901 & 13.9925 \tabularnewline
118 & 0.9637 & 1.0835 & 0.3172 & 1448.6577 & 321.0768 & 17.9186 \tabularnewline
119 & 0.842 & 1.7455 & 0.447 & 2398.9572 & 509.9751 & 22.5826 \tabularnewline
120 & 0.7683 & 2.1893 & 0.5922 & 2627.3453 & 686.4226 & 26.1997 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=115434&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.163[/C][C]0.1036[/C][C]0[/C][C]17.7205[/C][C]0[/C][C]0[/C][/ROW]
[ROW][C]110[/C][C]0.2901[/C][C]0.0208[/C][C]0.0622[/C][C]0.7748[/C][C]9.2477[/C][C]3.041[/C][/ROW]
[ROW][C]111[/C][C]0.3929[/C][C]0.0623[/C][C]0.0622[/C][C]7.5417[/C][C]8.679[/C][C]2.946[/C][/ROW]
[ROW][C]112[/C][C]0.5295[/C][C]0.0895[/C][C]0.069[/C][C]17.4628[/C][C]10.875[/C][C]3.2977[/C][/ROW]
[ROW][C]113[/C][C]0.6753[/C][C]0.1652[/C][C]0.0883[/C][C]67.4506[/C][C]22.1901[/C][C]4.7106[/C][/ROW]
[ROW][C]114[/C][C]0.8571[/C][C]0.3078[/C][C]0.1248[/C][C]260.5804[/C][C]61.9218[/C][C]7.869[/C][/ROW]
[ROW][C]115[/C][C]1.0009[/C][C]0.2412[/C][C]0.1415[/C][C]159.2088[/C][C]75.8199[/C][C]8.7075[/C][/ROW]
[ROW][C]116[/C][C]1.0468[/C][C]0.5287[/C][C]0.1899[/C][C]628.7323[/C][C]144.934[/C][C]12.0389[/C][/ROW]
[ROW][C]117[/C][C]1.0723[/C][C]0.569[/C][C]0.232[/C][C]602.6388[/C][C]195.7901[/C][C]13.9925[/C][/ROW]
[ROW][C]118[/C][C]0.9637[/C][C]1.0835[/C][C]0.3172[/C][C]1448.6577[/C][C]321.0768[/C][C]17.9186[/C][/ROW]
[ROW][C]119[/C][C]0.842[/C][C]1.7455[/C][C]0.447[/C][C]2398.9572[/C][C]509.9751[/C][C]22.5826[/C][/ROW]
[ROW][C]120[/C][C]0.7683[/C][C]2.1893[/C][C]0.5922[/C][C]2627.3453[/C][C]686.4226[/C][C]26.1997[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=115434&T=2

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=115434&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.1630.1036017.720500
1100.29010.02080.06220.77489.24773.041
1110.39290.06230.06227.54178.6792.946
1120.52950.08950.06917.462810.8753.2977
1130.67530.16520.088367.450622.19014.7106
1140.85710.30780.1248260.580461.92187.869
1151.00090.24120.1415159.208875.81998.7075
1161.04680.52870.1899628.7323144.93412.0389
1171.07230.5690.232602.6388195.790113.9925
1180.96371.08350.31721448.6577321.076817.9186
1190.8421.74550.4472398.9572509.975122.5826
1200.76832.18930.59222627.3453686.422626.1997



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