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 computationMon, 22 Dec 2008 12:52:23 -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/22/t12299756157m5h3n8drwngnvn.htm/, Retrieved Sun, 12 May 2024 14:46:15 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=36191, Retrieved Sun, 12 May 2024 14:46:15 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact151
Family? (F = Feedback message, R = changed R code, M = changed R Module, P = changed Parameters, D = changed Data)
-     [Standard Deviation-Mean Plot] [] [2008-12-12 12:13:32] [fad8a251ac01c156a8ae23a83577546f]
- RMPD  [(Partial) Autocorrelation Function] [Consumptiegoederen] [2008-12-12 13:39:25] [fad8a251ac01c156a8ae23a83577546f]
-   P     [(Partial) Autocorrelation Function] [auto corr cons] [2008-12-19 10:53:37] [fad8a251ac01c156a8ae23a83577546f]
-   P       [(Partial) Autocorrelation Function] [autocorr cons D] [2008-12-21 18:04:22] [fad8a251ac01c156a8ae23a83577546f]
- RMPD        [ARIMA Backward Selection] [Arima backw sel n...] [2008-12-22 10:23:57] [fad8a251ac01c156a8ae23a83577546f]
-    D          [ARIMA Backward Selection] [arima backw sel d...] [2008-12-22 10:29:20] [fad8a251ac01c156a8ae23a83577546f]
- RMPD            [ARIMA Forecasting] [] [2008-12-22 19:10:36] [b98453cac15ba1066b407e146608df68]
-                     [ARIMA Forecasting] [forecasting duur ...] [2008-12-22 19:52:23] [fa8b44cd657c07c6ee11bb2476ca3f8d] [Current]
Feedback Forum

Post a new message
Dataseries X:
72.5
72.0
98.8
75.2
81.2
88.0
54.6
68.6
101.5
93.4
84.5
91.4
64.5
64.5
117.3
73.5
79.7
102.6
57.9
73.1
102.4
82.3
89.1
84.7
81.4
67.5
113.9
83.8
73.9
103.9
67.9
62.5
125.4
79.1
106.3
96.2
94.3
85.6
117.4
88.5
124.2
119.3
76.8
70.6
122.1
109.5
119.9
102.3
79.6
78.2
103.6
77.8
99.1
105.7
84.1
88.7
108.0
98.1
101.0
82.0




Summary of computational transaction
Raw Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time3 seconds
R Server'Herman Ole Andreas Wold' @ 193.190.124.10:1001

\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 & 3 seconds \tabularnewline
R Server & 'Herman Ole Andreas Wold' @ 193.190.124.10:1001 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=36191&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]3 seconds[/C][/ROW]
[ROW][C]R Server[/C][C]'Herman Ole Andreas Wold' @ 193.190.124.10:1001[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=36191&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=36191&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 time3 seconds
R Server'Herman Ole Andreas Wold' @ 193.190.124.10:1001







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[48])
3696.2-------
3794.3-------
3885.6-------
39117.4-------
4088.5-------
41124.2-------
42119.3-------
4376.8-------
4470.6-------
45122.1-------
46109.5-------
47119.9-------
48102.3-------
4979.694.366.7224121.87760.14810.28480.50.2848
5078.285.658.0224113.17760.29950.66510.50.1176
51103.6117.489.8224144.97760.16330.99730.50.8584
5277.888.560.9224116.07760.22350.14160.50.1633
5399.1124.296.6224151.77760.03720.99950.50.9402
54105.7119.391.7224146.87760.16690.92450.50.8865
5584.176.849.2224104.37760.30190.020.50.035
5688.770.643.022498.17760.09920.16870.50.0121
57108122.194.5224149.67760.15810.99120.50.9203
5898.1109.581.9224137.07760.20890.54250.50.6956
59101119.992.3224147.47760.08960.93940.50.8945
6082102.374.7224129.87760.07450.53680.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[48]) \tabularnewline
36 & 96.2 & - & - & - & - & - & - & - \tabularnewline
37 & 94.3 & - & - & - & - & - & - & - \tabularnewline
38 & 85.6 & - & - & - & - & - & - & - \tabularnewline
39 & 117.4 & - & - & - & - & - & - & - \tabularnewline
40 & 88.5 & - & - & - & - & - & - & - \tabularnewline
41 & 124.2 & - & - & - & - & - & - & - \tabularnewline
42 & 119.3 & - & - & - & - & - & - & - \tabularnewline
43 & 76.8 & - & - & - & - & - & - & - \tabularnewline
44 & 70.6 & - & - & - & - & - & - & - \tabularnewline
45 & 122.1 & - & - & - & - & - & - & - \tabularnewline
46 & 109.5 & - & - & - & - & - & - & - \tabularnewline
47 & 119.9 & - & - & - & - & - & - & - \tabularnewline
48 & 102.3 & - & - & - & - & - & - & - \tabularnewline
49 & 79.6 & 94.3 & 66.7224 & 121.8776 & 0.1481 & 0.2848 & 0.5 & 0.2848 \tabularnewline
50 & 78.2 & 85.6 & 58.0224 & 113.1776 & 0.2995 & 0.6651 & 0.5 & 0.1176 \tabularnewline
51 & 103.6 & 117.4 & 89.8224 & 144.9776 & 0.1633 & 0.9973 & 0.5 & 0.8584 \tabularnewline
52 & 77.8 & 88.5 & 60.9224 & 116.0776 & 0.2235 & 0.1416 & 0.5 & 0.1633 \tabularnewline
53 & 99.1 & 124.2 & 96.6224 & 151.7776 & 0.0372 & 0.9995 & 0.5 & 0.9402 \tabularnewline
54 & 105.7 & 119.3 & 91.7224 & 146.8776 & 0.1669 & 0.9245 & 0.5 & 0.8865 \tabularnewline
55 & 84.1 & 76.8 & 49.2224 & 104.3776 & 0.3019 & 0.02 & 0.5 & 0.035 \tabularnewline
56 & 88.7 & 70.6 & 43.0224 & 98.1776 & 0.0992 & 0.1687 & 0.5 & 0.0121 \tabularnewline
57 & 108 & 122.1 & 94.5224 & 149.6776 & 0.1581 & 0.9912 & 0.5 & 0.9203 \tabularnewline
58 & 98.1 & 109.5 & 81.9224 & 137.0776 & 0.2089 & 0.5425 & 0.5 & 0.6956 \tabularnewline
59 & 101 & 119.9 & 92.3224 & 147.4776 & 0.0896 & 0.9394 & 0.5 & 0.8945 \tabularnewline
60 & 82 & 102.3 & 74.7224 & 129.8776 & 0.0745 & 0.5368 & 0.5 & 0.5 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=36191&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[48])[/C][/ROW]
[ROW][C]36[/C][C]96.2[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]37[/C][C]94.3[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]38[/C][C]85.6[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]39[/C][C]117.4[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]40[/C][C]88.5[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]41[/C][C]124.2[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]42[/C][C]119.3[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]43[/C][C]76.8[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]44[/C][C]70.6[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]45[/C][C]122.1[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]46[/C][C]109.5[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]47[/C][C]119.9[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]48[/C][C]102.3[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]49[/C][C]79.6[/C][C]94.3[/C][C]66.7224[/C][C]121.8776[/C][C]0.1481[/C][C]0.2848[/C][C]0.5[/C][C]0.2848[/C][/ROW]
[ROW][C]50[/C][C]78.2[/C][C]85.6[/C][C]58.0224[/C][C]113.1776[/C][C]0.2995[/C][C]0.6651[/C][C]0.5[/C][C]0.1176[/C][/ROW]
[ROW][C]51[/C][C]103.6[/C][C]117.4[/C][C]89.8224[/C][C]144.9776[/C][C]0.1633[/C][C]0.9973[/C][C]0.5[/C][C]0.8584[/C][/ROW]
[ROW][C]52[/C][C]77.8[/C][C]88.5[/C][C]60.9224[/C][C]116.0776[/C][C]0.2235[/C][C]0.1416[/C][C]0.5[/C][C]0.1633[/C][/ROW]
[ROW][C]53[/C][C]99.1[/C][C]124.2[/C][C]96.6224[/C][C]151.7776[/C][C]0.0372[/C][C]0.9995[/C][C]0.5[/C][C]0.9402[/C][/ROW]
[ROW][C]54[/C][C]105.7[/C][C]119.3[/C][C]91.7224[/C][C]146.8776[/C][C]0.1669[/C][C]0.9245[/C][C]0.5[/C][C]0.8865[/C][/ROW]
[ROW][C]55[/C][C]84.1[/C][C]76.8[/C][C]49.2224[/C][C]104.3776[/C][C]0.3019[/C][C]0.02[/C][C]0.5[/C][C]0.035[/C][/ROW]
[ROW][C]56[/C][C]88.7[/C][C]70.6[/C][C]43.0224[/C][C]98.1776[/C][C]0.0992[/C][C]0.1687[/C][C]0.5[/C][C]0.0121[/C][/ROW]
[ROW][C]57[/C][C]108[/C][C]122.1[/C][C]94.5224[/C][C]149.6776[/C][C]0.1581[/C][C]0.9912[/C][C]0.5[/C][C]0.9203[/C][/ROW]
[ROW][C]58[/C][C]98.1[/C][C]109.5[/C][C]81.9224[/C][C]137.0776[/C][C]0.2089[/C][C]0.5425[/C][C]0.5[/C][C]0.6956[/C][/ROW]
[ROW][C]59[/C][C]101[/C][C]119.9[/C][C]92.3224[/C][C]147.4776[/C][C]0.0896[/C][C]0.9394[/C][C]0.5[/C][C]0.8945[/C][/ROW]
[ROW][C]60[/C][C]82[/C][C]102.3[/C][C]74.7224[/C][C]129.8776[/C][C]0.0745[/C][C]0.5368[/C][C]0.5[/C][C]0.5[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=36191&T=1

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=36191&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[48])
3696.2-------
3794.3-------
3885.6-------
39117.4-------
4088.5-------
41124.2-------
42119.3-------
4376.8-------
4470.6-------
45122.1-------
46109.5-------
47119.9-------
48102.3-------
4979.694.366.7224121.87760.14810.28480.50.2848
5078.285.658.0224113.17760.29950.66510.50.1176
51103.6117.489.8224144.97760.16330.99730.50.8584
5277.888.560.9224116.07760.22350.14160.50.1633
5399.1124.296.6224151.77760.03720.99950.50.9402
54105.7119.391.7224146.87760.16690.92450.50.8865
5584.176.849.2224104.37760.30190.020.50.035
5688.770.643.022498.17760.09920.16870.50.0121
57108122.194.5224149.67760.15810.99120.50.9203
5898.1109.581.9224137.07760.20890.54250.50.6956
59101119.992.3224147.47760.08960.93940.50.8945
6082102.374.7224129.87760.07450.53680.50.5







Univariate ARIMA Extrapolation Forecast Performance
time% S.E.PEMAPESq.EMSERMSE
490.1492-0.15590.013216.0918.00754.2435
500.1644-0.08640.007254.764.56332.1362
510.1198-0.11750.0098190.4415.873.9837
520.159-0.12090.0101114.499.54083.0888
530.1133-0.20210.0168630.0152.50087.2457
540.1179-0.1140.0095184.9615.41333.926
550.18320.09510.007953.294.44082.1073
560.19930.25640.0214327.6127.30085.225
570.1152-0.11550.0096198.8116.56754.0703
580.1285-0.10410.0087129.9610.833.2909
590.1173-0.15760.0131357.2129.76755.456
600.1375-0.19840.0165412.0934.34085.8601

\begin{tabular}{lllllllll}
\hline
Univariate ARIMA Extrapolation Forecast Performance \tabularnewline
time & % S.E. & PE & MAPE & Sq.E & MSE & RMSE \tabularnewline
49 & 0.1492 & -0.1559 & 0.013 & 216.09 & 18.0075 & 4.2435 \tabularnewline
50 & 0.1644 & -0.0864 & 0.0072 & 54.76 & 4.5633 & 2.1362 \tabularnewline
51 & 0.1198 & -0.1175 & 0.0098 & 190.44 & 15.87 & 3.9837 \tabularnewline
52 & 0.159 & -0.1209 & 0.0101 & 114.49 & 9.5408 & 3.0888 \tabularnewline
53 & 0.1133 & -0.2021 & 0.0168 & 630.01 & 52.5008 & 7.2457 \tabularnewline
54 & 0.1179 & -0.114 & 0.0095 & 184.96 & 15.4133 & 3.926 \tabularnewline
55 & 0.1832 & 0.0951 & 0.0079 & 53.29 & 4.4408 & 2.1073 \tabularnewline
56 & 0.1993 & 0.2564 & 0.0214 & 327.61 & 27.3008 & 5.225 \tabularnewline
57 & 0.1152 & -0.1155 & 0.0096 & 198.81 & 16.5675 & 4.0703 \tabularnewline
58 & 0.1285 & -0.1041 & 0.0087 & 129.96 & 10.83 & 3.2909 \tabularnewline
59 & 0.1173 & -0.1576 & 0.0131 & 357.21 & 29.7675 & 5.456 \tabularnewline
60 & 0.1375 & -0.1984 & 0.0165 & 412.09 & 34.3408 & 5.8601 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=36191&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]49[/C][C]0.1492[/C][C]-0.1559[/C][C]0.013[/C][C]216.09[/C][C]18.0075[/C][C]4.2435[/C][/ROW]
[ROW][C]50[/C][C]0.1644[/C][C]-0.0864[/C][C]0.0072[/C][C]54.76[/C][C]4.5633[/C][C]2.1362[/C][/ROW]
[ROW][C]51[/C][C]0.1198[/C][C]-0.1175[/C][C]0.0098[/C][C]190.44[/C][C]15.87[/C][C]3.9837[/C][/ROW]
[ROW][C]52[/C][C]0.159[/C][C]-0.1209[/C][C]0.0101[/C][C]114.49[/C][C]9.5408[/C][C]3.0888[/C][/ROW]
[ROW][C]53[/C][C]0.1133[/C][C]-0.2021[/C][C]0.0168[/C][C]630.01[/C][C]52.5008[/C][C]7.2457[/C][/ROW]
[ROW][C]54[/C][C]0.1179[/C][C]-0.114[/C][C]0.0095[/C][C]184.96[/C][C]15.4133[/C][C]3.926[/C][/ROW]
[ROW][C]55[/C][C]0.1832[/C][C]0.0951[/C][C]0.0079[/C][C]53.29[/C][C]4.4408[/C][C]2.1073[/C][/ROW]
[ROW][C]56[/C][C]0.1993[/C][C]0.2564[/C][C]0.0214[/C][C]327.61[/C][C]27.3008[/C][C]5.225[/C][/ROW]
[ROW][C]57[/C][C]0.1152[/C][C]-0.1155[/C][C]0.0096[/C][C]198.81[/C][C]16.5675[/C][C]4.0703[/C][/ROW]
[ROW][C]58[/C][C]0.1285[/C][C]-0.1041[/C][C]0.0087[/C][C]129.96[/C][C]10.83[/C][C]3.2909[/C][/ROW]
[ROW][C]59[/C][C]0.1173[/C][C]-0.1576[/C][C]0.0131[/C][C]357.21[/C][C]29.7675[/C][C]5.456[/C][/ROW]
[ROW][C]60[/C][C]0.1375[/C][C]-0.1984[/C][C]0.0165[/C][C]412.09[/C][C]34.3408[/C][C]5.8601[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=36191&T=2

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=36191&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
490.1492-0.15590.013216.0918.00754.2435
500.1644-0.08640.007254.764.56332.1362
510.1198-0.11750.0098190.4415.873.9837
520.159-0.12090.0101114.499.54083.0888
530.1133-0.20210.0168630.0152.50087.2457
540.1179-0.1140.0095184.9615.41333.926
550.18320.09510.007953.294.44082.1073
560.19930.25640.0214327.6127.30085.225
570.1152-0.11550.0096198.8116.56754.0703
580.1285-0.10410.0087129.9610.833.2909
590.1173-0.15760.0131357.2129.76755.456
600.1375-0.19840.0165412.0934.34085.8601



Parameters (Session):
par1 = 12 ; par2 = 1 ; par3 = 0 ; par4 = 1 ; par5 = 12 ; par6 = 0 ; par7 = 0 ; par8 = 0 ; par9 = 0 ; par10 = FALSE ;
Parameters (R input):
par1 = 12 ; par2 = 1 ; par3 = 0 ; par4 = 1 ; par5 = 12 ; par6 = 0 ; par7 = 0 ; par8 = 0 ; par9 = 0 ; par10 = FALSE ; par11 = ; par12 = ; par13 = ; par14 = ; par15 = ; par16 = ; par17 = ; par18 = ; par19 = ; par20 = ;
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')