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, 17 Dec 2010 14:53:25 +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/17/t1292597503c9cqt4clw8nwbye.htm/, Retrieved Thu, 02 May 2024 12:07:23 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=111501, Retrieved Thu, 02 May 2024 12:07:23 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact163
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]
- R PD        [ARIMA Forecasting] [Apple Inc - ARIMA...] [2010-12-17 14:53:25] [aa6b599ccd367bc74fed0d8f67004a46] [Current]
- R PD          [ARIMA Forecasting] [] [2012-12-20 14:10:52] [d1865ed705b6ad9ba3d459a02c528b22]
- R PD          [ARIMA Forecasting] [] [2012-12-20 14:13:43] [d1865ed705b6ad9ba3d459a02c528b22]
Feedback Forum

Post a new message
Dataseries X:
10.81
9.12
11.03
12.74
9.98
11.62
9.40
9.27
7.76
8.78
10.65
10.95
12.36
10.85
11.84
12.14
11.65
8.86
7.63
7.38
7.25
8.03
7.75
7.16
7.18
7.51
7.07
7.11
8.98
9.53
10.54
11.31
10.36
11.44
10.45
10.69
11.28
11.96
13.52
12.89
14.03
16.27
16.17
17.25
19.38
26.20
33.53
32.20
38.45
44.86
41.67
36.06
39.76
36.81
42.65
46.89
53.61
57.59
67.82
71.89
75.51
68.49
62.72
70.39
59.77
57.27
67.96
67.85
76.98
81.08
91.66
84.84
85.73
84.61
92.91
99.80
121.19
122.04
131.76
138.48
153.47
189.95
182.22
198.08
135.36
125.02
143.50
173.95
188.75
167.44
158.95
169.53
113.66
107.59
92.67
85.35
90.13
89.31
105.12
125.83
135.81
142.43
163.39
168.21
185.35
188.50
199.91
210.73
192.06
204.62
235.00
261.09
256.88
251.53
257.25
243.10
283.75




Summary of computational transaction
Raw Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time2 seconds
R Server'Sir Ronald Aylmer Fisher' @ 193.190.124.24

\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 & 'Sir Ronald Aylmer Fisher' @ 193.190.124.24 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=111501&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]'Sir Ronald Aylmer Fisher' @ 193.190.124.24[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=111501&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=111501&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'Sir Ronald Aylmer Fisher' @ 193.190.124.24







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[105])
93113.66-------
94107.59-------
9592.67-------
9685.35-------
9790.13-------
9889.31-------
99105.12-------
100125.83-------
101135.81-------
102142.43-------
103163.39-------
104168.21-------
105185.35-------
106188.5189.6452141.4433256.53650.48660.55010.99190.5501
107199.91192.7553124.6425304.07390.44990.52990.9610.5519
108210.73194.9934111.9891350.75880.42150.47530.91620.5483
109192.06196.5968101.7033398.12850.48240.44530.84980.5435
110204.62197.741893.0907446.64680.47840.51780.80340.5389
111235198.557785.7579496.52310.40530.48410.73060.5346
112261.09199.138279.44547.89180.36390.42010.65980.5309
113256.88199.550773.9434600.86510.38970.38190.62220.5276
114251.53199.843669.1204655.550.4120.40310.59750.5249
115257.25200.051564.8562712.0540.41330.42190.55580.5224
116243.1200.198961.0596770.48590.44140.42230.54380.5204
117283.75200.303557.6579830.95590.39770.44710.51850.5185

\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[105]) \tabularnewline
93 & 113.66 & - & - & - & - & - & - & - \tabularnewline
94 & 107.59 & - & - & - & - & - & - & - \tabularnewline
95 & 92.67 & - & - & - & - & - & - & - \tabularnewline
96 & 85.35 & - & - & - & - & - & - & - \tabularnewline
97 & 90.13 & - & - & - & - & - & - & - \tabularnewline
98 & 89.31 & - & - & - & - & - & - & - \tabularnewline
99 & 105.12 & - & - & - & - & - & - & - \tabularnewline
100 & 125.83 & - & - & - & - & - & - & - \tabularnewline
101 & 135.81 & - & - & - & - & - & - & - \tabularnewline
102 & 142.43 & - & - & - & - & - & - & - \tabularnewline
103 & 163.39 & - & - & - & - & - & - & - \tabularnewline
104 & 168.21 & - & - & - & - & - & - & - \tabularnewline
105 & 185.35 & - & - & - & - & - & - & - \tabularnewline
106 & 188.5 & 189.6452 & 141.4433 & 256.5365 & 0.4866 & 0.5501 & 0.9919 & 0.5501 \tabularnewline
107 & 199.91 & 192.7553 & 124.6425 & 304.0739 & 0.4499 & 0.5299 & 0.961 & 0.5519 \tabularnewline
108 & 210.73 & 194.9934 & 111.9891 & 350.7588 & 0.4215 & 0.4753 & 0.9162 & 0.5483 \tabularnewline
109 & 192.06 & 196.5968 & 101.7033 & 398.1285 & 0.4824 & 0.4453 & 0.8498 & 0.5435 \tabularnewline
110 & 204.62 & 197.7418 & 93.0907 & 446.6468 & 0.4784 & 0.5178 & 0.8034 & 0.5389 \tabularnewline
111 & 235 & 198.5577 & 85.7579 & 496.5231 & 0.4053 & 0.4841 & 0.7306 & 0.5346 \tabularnewline
112 & 261.09 & 199.1382 & 79.44 & 547.8918 & 0.3639 & 0.4201 & 0.6598 & 0.5309 \tabularnewline
113 & 256.88 & 199.5507 & 73.9434 & 600.8651 & 0.3897 & 0.3819 & 0.6222 & 0.5276 \tabularnewline
114 & 251.53 & 199.8436 & 69.1204 & 655.55 & 0.412 & 0.4031 & 0.5975 & 0.5249 \tabularnewline
115 & 257.25 & 200.0515 & 64.8562 & 712.054 & 0.4133 & 0.4219 & 0.5558 & 0.5224 \tabularnewline
116 & 243.1 & 200.1989 & 61.0596 & 770.4859 & 0.4414 & 0.4223 & 0.5438 & 0.5204 \tabularnewline
117 & 283.75 & 200.3035 & 57.6579 & 830.9559 & 0.3977 & 0.4471 & 0.5185 & 0.5185 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=111501&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[105])[/C][/ROW]
[ROW][C]93[/C][C]113.66[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]94[/C][C]107.59[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]95[/C][C]92.67[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]96[/C][C]85.35[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]97[/C][C]90.13[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]98[/C][C]89.31[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]99[/C][C]105.12[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]100[/C][C]125.83[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]101[/C][C]135.81[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]102[/C][C]142.43[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]103[/C][C]163.39[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]104[/C][C]168.21[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]105[/C][C]185.35[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]106[/C][C]188.5[/C][C]189.6452[/C][C]141.4433[/C][C]256.5365[/C][C]0.4866[/C][C]0.5501[/C][C]0.9919[/C][C]0.5501[/C][/ROW]
[ROW][C]107[/C][C]199.91[/C][C]192.7553[/C][C]124.6425[/C][C]304.0739[/C][C]0.4499[/C][C]0.5299[/C][C]0.961[/C][C]0.5519[/C][/ROW]
[ROW][C]108[/C][C]210.73[/C][C]194.9934[/C][C]111.9891[/C][C]350.7588[/C][C]0.4215[/C][C]0.4753[/C][C]0.9162[/C][C]0.5483[/C][/ROW]
[ROW][C]109[/C][C]192.06[/C][C]196.5968[/C][C]101.7033[/C][C]398.1285[/C][C]0.4824[/C][C]0.4453[/C][C]0.8498[/C][C]0.5435[/C][/ROW]
[ROW][C]110[/C][C]204.62[/C][C]197.7418[/C][C]93.0907[/C][C]446.6468[/C][C]0.4784[/C][C]0.5178[/C][C]0.8034[/C][C]0.5389[/C][/ROW]
[ROW][C]111[/C][C]235[/C][C]198.5577[/C][C]85.7579[/C][C]496.5231[/C][C]0.4053[/C][C]0.4841[/C][C]0.7306[/C][C]0.5346[/C][/ROW]
[ROW][C]112[/C][C]261.09[/C][C]199.1382[/C][C]79.44[/C][C]547.8918[/C][C]0.3639[/C][C]0.4201[/C][C]0.6598[/C][C]0.5309[/C][/ROW]
[ROW][C]113[/C][C]256.88[/C][C]199.5507[/C][C]73.9434[/C][C]600.8651[/C][C]0.3897[/C][C]0.3819[/C][C]0.6222[/C][C]0.5276[/C][/ROW]
[ROW][C]114[/C][C]251.53[/C][C]199.8436[/C][C]69.1204[/C][C]655.55[/C][C]0.412[/C][C]0.4031[/C][C]0.5975[/C][C]0.5249[/C][/ROW]
[ROW][C]115[/C][C]257.25[/C][C]200.0515[/C][C]64.8562[/C][C]712.054[/C][C]0.4133[/C][C]0.4219[/C][C]0.5558[/C][C]0.5224[/C][/ROW]
[ROW][C]116[/C][C]243.1[/C][C]200.1989[/C][C]61.0596[/C][C]770.4859[/C][C]0.4414[/C][C]0.4223[/C][C]0.5438[/C][C]0.5204[/C][/ROW]
[ROW][C]117[/C][C]283.75[/C][C]200.3035[/C][C]57.6579[/C][C]830.9559[/C][C]0.3977[/C][C]0.4471[/C][C]0.5185[/C][C]0.5185[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=111501&T=1

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=111501&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[105])
93113.66-------
94107.59-------
9592.67-------
9685.35-------
9790.13-------
9889.31-------
99105.12-------
100125.83-------
101135.81-------
102142.43-------
103163.39-------
104168.21-------
105185.35-------
106188.5189.6452141.4433256.53650.48660.55010.99190.5501
107199.91192.7553124.6425304.07390.44990.52990.9610.5519
108210.73194.9934111.9891350.75880.42150.47530.91620.5483
109192.06196.5968101.7033398.12850.48240.44530.84980.5435
110204.62197.741893.0907446.64680.47840.51780.80340.5389
111235198.557785.7579496.52310.40530.48410.73060.5346
112261.09199.138279.44547.89180.36390.42010.65980.5309
113256.88199.550773.9434600.86510.38970.38190.62220.5276
114251.53199.843669.1204655.550.4120.40310.59750.5249
115257.25200.051564.8562712.0540.41330.42190.55580.5224
116243.1200.198961.0596770.48590.44140.42230.54380.5204
117283.75200.303557.6579830.95590.39770.44710.51850.5185







Univariate ARIMA Extrapolation Forecast Performance
time% S.E.PEMAPESq.EMSERMSE
1060.18-0.00601.311400
1070.29460.03710.021651.189326.25045.1235
1080.40760.08070.0413247.6407100.047110.0024
1090.523-0.02310.036720.582380.18098.9544
1100.64220.03480.036347.309273.60668.5794
1110.76560.18350.06091328.0377282.678416.813
1120.89350.31110.09663838.0236790.584928.1173
1131.02610.28730.12053286.64741102.592733.2053
1141.16340.25860.13582671.48331276.913935.7339
1151.30580.28590.15083271.67281476.389838.4238
1161.45340.21430.15661840.50371509.49138.8522
1171.60640.41660.17836963.32291963.97744.3168

\begin{tabular}{lllllllll}
\hline
Univariate ARIMA Extrapolation Forecast Performance \tabularnewline
time & % S.E. & PE & MAPE & Sq.E & MSE & RMSE \tabularnewline
106 & 0.18 & -0.006 & 0 & 1.3114 & 0 & 0 \tabularnewline
107 & 0.2946 & 0.0371 & 0.0216 & 51.1893 & 26.2504 & 5.1235 \tabularnewline
108 & 0.4076 & 0.0807 & 0.0413 & 247.6407 & 100.0471 & 10.0024 \tabularnewline
109 & 0.523 & -0.0231 & 0.0367 & 20.5823 & 80.1809 & 8.9544 \tabularnewline
110 & 0.6422 & 0.0348 & 0.0363 & 47.3092 & 73.6066 & 8.5794 \tabularnewline
111 & 0.7656 & 0.1835 & 0.0609 & 1328.0377 & 282.6784 & 16.813 \tabularnewline
112 & 0.8935 & 0.3111 & 0.0966 & 3838.0236 & 790.5849 & 28.1173 \tabularnewline
113 & 1.0261 & 0.2873 & 0.1205 & 3286.6474 & 1102.5927 & 33.2053 \tabularnewline
114 & 1.1634 & 0.2586 & 0.1358 & 2671.4833 & 1276.9139 & 35.7339 \tabularnewline
115 & 1.3058 & 0.2859 & 0.1508 & 3271.6728 & 1476.3898 & 38.4238 \tabularnewline
116 & 1.4534 & 0.2143 & 0.1566 & 1840.5037 & 1509.491 & 38.8522 \tabularnewline
117 & 1.6064 & 0.4166 & 0.1783 & 6963.3229 & 1963.977 & 44.3168 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=111501&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]106[/C][C]0.18[/C][C]-0.006[/C][C]0[/C][C]1.3114[/C][C]0[/C][C]0[/C][/ROW]
[ROW][C]107[/C][C]0.2946[/C][C]0.0371[/C][C]0.0216[/C][C]51.1893[/C][C]26.2504[/C][C]5.1235[/C][/ROW]
[ROW][C]108[/C][C]0.4076[/C][C]0.0807[/C][C]0.0413[/C][C]247.6407[/C][C]100.0471[/C][C]10.0024[/C][/ROW]
[ROW][C]109[/C][C]0.523[/C][C]-0.0231[/C][C]0.0367[/C][C]20.5823[/C][C]80.1809[/C][C]8.9544[/C][/ROW]
[ROW][C]110[/C][C]0.6422[/C][C]0.0348[/C][C]0.0363[/C][C]47.3092[/C][C]73.6066[/C][C]8.5794[/C][/ROW]
[ROW][C]111[/C][C]0.7656[/C][C]0.1835[/C][C]0.0609[/C][C]1328.0377[/C][C]282.6784[/C][C]16.813[/C][/ROW]
[ROW][C]112[/C][C]0.8935[/C][C]0.3111[/C][C]0.0966[/C][C]3838.0236[/C][C]790.5849[/C][C]28.1173[/C][/ROW]
[ROW][C]113[/C][C]1.0261[/C][C]0.2873[/C][C]0.1205[/C][C]3286.6474[/C][C]1102.5927[/C][C]33.2053[/C][/ROW]
[ROW][C]114[/C][C]1.1634[/C][C]0.2586[/C][C]0.1358[/C][C]2671.4833[/C][C]1276.9139[/C][C]35.7339[/C][/ROW]
[ROW][C]115[/C][C]1.3058[/C][C]0.2859[/C][C]0.1508[/C][C]3271.6728[/C][C]1476.3898[/C][C]38.4238[/C][/ROW]
[ROW][C]116[/C][C]1.4534[/C][C]0.2143[/C][C]0.1566[/C][C]1840.5037[/C][C]1509.491[/C][C]38.8522[/C][/ROW]
[ROW][C]117[/C][C]1.6064[/C][C]0.4166[/C][C]0.1783[/C][C]6963.3229[/C][C]1963.977[/C][C]44.3168[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=111501&T=2

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=111501&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
1060.18-0.00601.311400
1070.29460.03710.021651.189326.25045.1235
1080.40760.08070.0413247.6407100.047110.0024
1090.523-0.02310.036720.582380.18098.9544
1100.64220.03480.036347.309273.60668.5794
1110.76560.18350.06091328.0377282.678416.813
1120.89350.31110.09663838.0236790.584928.1173
1131.02610.28730.12053286.64741102.592733.2053
1141.16340.25860.13582671.48331276.913935.7339
1151.30580.28590.15083271.67281476.389838.4238
1161.45340.21430.15661840.50371509.49138.8522
1171.60640.41660.17836963.32291963.97744.3168



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