Free Statistics

of Irreproducible Research!

Author's title

Author*Unverified author*
R Software Modulerwasp_arimaforecasting.wasp
Title produced by softwareARIMA Forecasting
Date of computationMon, 22 Dec 2008 07:06:40 -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/t1229954842gqdt4quruo74430.htm/, Retrieved Sun, 12 May 2024 14:46:30 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=36074, Retrieved Sun, 12 May 2024 14:46:30 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact221
Family? (F = Feedback message, R = changed R code, M = changed R Module, P = changed Parameters, D = changed Data)
-     [Central Tendency] [Central tendency:...] [2008-12-12 12:54:43] [73d6180dc45497329efd1b6934a84aba]
- RMP   [ARIMA Backward Selection] [ARIMA goudprijs] [2008-12-14 20:12:57] [73d6180dc45497329efd1b6934a84aba]
- RMPD    [ARIMA Forecasting] [ARIMA forecast: O...] [2008-12-14 22:42:36] [73d6180dc45497329efd1b6934a84aba]
-   PD      [ARIMA Forecasting] [arima forecast ol...] [2008-12-16 16:27:50] [73d6180dc45497329efd1b6934a84aba]
-   P         [ARIMA Forecasting] [Lambda -0,2 ARIMA...] [2008-12-19 21:26:09] [73d6180dc45497329efd1b6934a84aba]
- R PD            [ARIMA Forecasting] [Forecast BEL20] [2008-12-22 14:06:40] [ee28d11f695cd3bc1f8bbd77ba77987a] [Current]
- RMPD              [ARIMA Forecasting] [] [2009-12-30 23:10:28] [74be16979710d4c4e7c6647856088456]
- RMPD              [ARIMA Forecasting] [] [2009-12-30 23:10:28] [74be16979710d4c4e7c6647856088456]
Feedback Forum

Post a new message
Dataseries X:
2196.72
2350.44
2440.25
2408.64
2472.81
2407.6
2454.62
2448.05
2497.84
2645.64
2756.76
2849.27
2921.44
2981.85
3080.58
3106.22
3119.31
3061.26
3097.31
3161.69
3257.16
3277.01
3295.32
3363.99
3494.17
3667.03
3813.06
3917.96
3895.51
3801.06
3570.12
3701.61
3862.27
3970.1
4138.52
4199.75
4290.89
4443.91
4502.64
4356.98
4591.27
4696.96
4621.4
4562.84
4202.52
4296.49
4435.23
4105.18
4116.68
3844.49
3720.98
3674.4
3857.62
3801.06
3504.37
3032.6
3047.03
2962.34
2197.82
2014.45




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=36074&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=36074&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=36074&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[48])
364199.75-------
374290.89-------
384443.91-------
394502.64-------
404356.98-------
414591.27-------
424696.96-------
434621.4-------
444562.84-------
454202.52-------
464296.49-------
474435.23-------
484105.18-------
494116.683982.35123741.52364223.17880.13710.15870.0060.1587
503844.493982.35123577.99384386.70850.2520.25750.01260.2758
513720.983982.35123463.68774501.01470.16160.69880.02460.3213
523674.43982.35123370.37184594.33050.1620.79870.11510.347
533857.623982.35123289.51234675.190.36210.80820.04250.3641
543801.063982.35123217.15014747.55220.32120.62530.03360.3765
553504.373982.35123151.06334813.63910.12990.66550.06590.3861
563032.63982.35123089.85664874.84570.01850.85310.10120.3937
573047.033982.35123032.58624932.11610.02680.9750.32480.3999
582962.343982.35122978.57814986.12420.02320.96610.26980.4052
592197.823982.35122927.33115037.37125e-040.9710.20010.4097
602014.453982.35122878.46075086.24172e-040.99920.41370.4137

\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 & 4199.75 & - & - & - & - & - & - & - \tabularnewline
37 & 4290.89 & - & - & - & - & - & - & - \tabularnewline
38 & 4443.91 & - & - & - & - & - & - & - \tabularnewline
39 & 4502.64 & - & - & - & - & - & - & - \tabularnewline
40 & 4356.98 & - & - & - & - & - & - & - \tabularnewline
41 & 4591.27 & - & - & - & - & - & - & - \tabularnewline
42 & 4696.96 & - & - & - & - & - & - & - \tabularnewline
43 & 4621.4 & - & - & - & - & - & - & - \tabularnewline
44 & 4562.84 & - & - & - & - & - & - & - \tabularnewline
45 & 4202.52 & - & - & - & - & - & - & - \tabularnewline
46 & 4296.49 & - & - & - & - & - & - & - \tabularnewline
47 & 4435.23 & - & - & - & - & - & - & - \tabularnewline
48 & 4105.18 & - & - & - & - & - & - & - \tabularnewline
49 & 4116.68 & 3982.3512 & 3741.5236 & 4223.1788 & 0.1371 & 0.1587 & 0.006 & 0.1587 \tabularnewline
50 & 3844.49 & 3982.3512 & 3577.9938 & 4386.7085 & 0.252 & 0.2575 & 0.0126 & 0.2758 \tabularnewline
51 & 3720.98 & 3982.3512 & 3463.6877 & 4501.0147 & 0.1616 & 0.6988 & 0.0246 & 0.3213 \tabularnewline
52 & 3674.4 & 3982.3512 & 3370.3718 & 4594.3305 & 0.162 & 0.7987 & 0.1151 & 0.347 \tabularnewline
53 & 3857.62 & 3982.3512 & 3289.5123 & 4675.19 & 0.3621 & 0.8082 & 0.0425 & 0.3641 \tabularnewline
54 & 3801.06 & 3982.3512 & 3217.1501 & 4747.5522 & 0.3212 & 0.6253 & 0.0336 & 0.3765 \tabularnewline
55 & 3504.37 & 3982.3512 & 3151.0633 & 4813.6391 & 0.1299 & 0.6655 & 0.0659 & 0.3861 \tabularnewline
56 & 3032.6 & 3982.3512 & 3089.8566 & 4874.8457 & 0.0185 & 0.8531 & 0.1012 & 0.3937 \tabularnewline
57 & 3047.03 & 3982.3512 & 3032.5862 & 4932.1161 & 0.0268 & 0.975 & 0.3248 & 0.3999 \tabularnewline
58 & 2962.34 & 3982.3512 & 2978.5781 & 4986.1242 & 0.0232 & 0.9661 & 0.2698 & 0.4052 \tabularnewline
59 & 2197.82 & 3982.3512 & 2927.3311 & 5037.3712 & 5e-04 & 0.971 & 0.2001 & 0.4097 \tabularnewline
60 & 2014.45 & 3982.3512 & 2878.4607 & 5086.2417 & 2e-04 & 0.9992 & 0.4137 & 0.4137 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=36074&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]4199.75[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]37[/C][C]4290.89[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]38[/C][C]4443.91[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]39[/C][C]4502.64[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]40[/C][C]4356.98[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]41[/C][C]4591.27[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]42[/C][C]4696.96[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]43[/C][C]4621.4[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]44[/C][C]4562.84[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]45[/C][C]4202.52[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]46[/C][C]4296.49[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]47[/C][C]4435.23[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]48[/C][C]4105.18[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]49[/C][C]4116.68[/C][C]3982.3512[/C][C]3741.5236[/C][C]4223.1788[/C][C]0.1371[/C][C]0.1587[/C][C]0.006[/C][C]0.1587[/C][/ROW]
[ROW][C]50[/C][C]3844.49[/C][C]3982.3512[/C][C]3577.9938[/C][C]4386.7085[/C][C]0.252[/C][C]0.2575[/C][C]0.0126[/C][C]0.2758[/C][/ROW]
[ROW][C]51[/C][C]3720.98[/C][C]3982.3512[/C][C]3463.6877[/C][C]4501.0147[/C][C]0.1616[/C][C]0.6988[/C][C]0.0246[/C][C]0.3213[/C][/ROW]
[ROW][C]52[/C][C]3674.4[/C][C]3982.3512[/C][C]3370.3718[/C][C]4594.3305[/C][C]0.162[/C][C]0.7987[/C][C]0.1151[/C][C]0.347[/C][/ROW]
[ROW][C]53[/C][C]3857.62[/C][C]3982.3512[/C][C]3289.5123[/C][C]4675.19[/C][C]0.3621[/C][C]0.8082[/C][C]0.0425[/C][C]0.3641[/C][/ROW]
[ROW][C]54[/C][C]3801.06[/C][C]3982.3512[/C][C]3217.1501[/C][C]4747.5522[/C][C]0.3212[/C][C]0.6253[/C][C]0.0336[/C][C]0.3765[/C][/ROW]
[ROW][C]55[/C][C]3504.37[/C][C]3982.3512[/C][C]3151.0633[/C][C]4813.6391[/C][C]0.1299[/C][C]0.6655[/C][C]0.0659[/C][C]0.3861[/C][/ROW]
[ROW][C]56[/C][C]3032.6[/C][C]3982.3512[/C][C]3089.8566[/C][C]4874.8457[/C][C]0.0185[/C][C]0.8531[/C][C]0.1012[/C][C]0.3937[/C][/ROW]
[ROW][C]57[/C][C]3047.03[/C][C]3982.3512[/C][C]3032.5862[/C][C]4932.1161[/C][C]0.0268[/C][C]0.975[/C][C]0.3248[/C][C]0.3999[/C][/ROW]
[ROW][C]58[/C][C]2962.34[/C][C]3982.3512[/C][C]2978.5781[/C][C]4986.1242[/C][C]0.0232[/C][C]0.9661[/C][C]0.2698[/C][C]0.4052[/C][/ROW]
[ROW][C]59[/C][C]2197.82[/C][C]3982.3512[/C][C]2927.3311[/C][C]5037.3712[/C][C]5e-04[/C][C]0.971[/C][C]0.2001[/C][C]0.4097[/C][/ROW]
[ROW][C]60[/C][C]2014.45[/C][C]3982.3512[/C][C]2878.4607[/C][C]5086.2417[/C][C]2e-04[/C][C]0.9992[/C][C]0.4137[/C][C]0.4137[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=36074&T=1

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=36074&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])
364199.75-------
374290.89-------
384443.91-------
394502.64-------
404356.98-------
414591.27-------
424696.96-------
434621.4-------
444562.84-------
454202.52-------
464296.49-------
474435.23-------
484105.18-------
494116.683982.35123741.52364223.17880.13710.15870.0060.1587
503844.493982.35123577.99384386.70850.2520.25750.01260.2758
513720.983982.35123463.68774501.01470.16160.69880.02460.3213
523674.43982.35123370.37184594.33050.1620.79870.11510.347
533857.623982.35123289.51234675.190.36210.80820.04250.3641
543801.063982.35123217.15014747.55220.32120.62530.03360.3765
553504.373982.35123151.06334813.63910.12990.66550.06590.3861
563032.63982.35123089.85664874.84570.01850.85310.10120.3937
573047.033982.35123032.58624932.11610.02680.9750.32480.3999
582962.343982.35122978.57814986.12420.02320.96610.26980.4052
592197.823982.35122927.33115037.37125e-040.9710.20010.4097
602014.453982.35122878.46075086.24172e-040.99920.41370.4137







Univariate ARIMA Extrapolation Forecast Performance
time% S.E.PEMAPESq.EMSERMSE
490.03090.03370.002818044.23271503.686138.7774
500.0518-0.03460.002919005.70411583.808739.7971
510.0664-0.06560.005568314.89225692.907775.4514
520.0784-0.07730.006494833.92747902.827388.8978
530.0888-0.03130.002615557.86651296.488936.0068
540.098-0.04550.003832866.49082738.874252.3343
550.1065-0.120.01228466.005519038.8338137.9813
560.1143-0.23850.0199902027.298275168.9415274.1695
570.1217-0.23490.0196874825.704172902.142270.004
580.1286-0.25610.02131040422.801286701.9001294.4519
590.1352-0.44810.03733184551.5216265379.2935515.1498
600.1414-0.49420.04123872635.0423322719.5869568.0841

\begin{tabular}{lllllllll}
\hline
Univariate ARIMA Extrapolation Forecast Performance \tabularnewline
time & % S.E. & PE & MAPE & Sq.E & MSE & RMSE \tabularnewline
49 & 0.0309 & 0.0337 & 0.0028 & 18044.2327 & 1503.6861 & 38.7774 \tabularnewline
50 & 0.0518 & -0.0346 & 0.0029 & 19005.7041 & 1583.8087 & 39.7971 \tabularnewline
51 & 0.0664 & -0.0656 & 0.0055 & 68314.8922 & 5692.9077 & 75.4514 \tabularnewline
52 & 0.0784 & -0.0773 & 0.0064 & 94833.9274 & 7902.8273 & 88.8978 \tabularnewline
53 & 0.0888 & -0.0313 & 0.0026 & 15557.8665 & 1296.4889 & 36.0068 \tabularnewline
54 & 0.098 & -0.0455 & 0.0038 & 32866.4908 & 2738.8742 & 52.3343 \tabularnewline
55 & 0.1065 & -0.12 & 0.01 & 228466.0055 & 19038.8338 & 137.9813 \tabularnewline
56 & 0.1143 & -0.2385 & 0.0199 & 902027.2982 & 75168.9415 & 274.1695 \tabularnewline
57 & 0.1217 & -0.2349 & 0.0196 & 874825.7041 & 72902.142 & 270.004 \tabularnewline
58 & 0.1286 & -0.2561 & 0.0213 & 1040422.8012 & 86701.9001 & 294.4519 \tabularnewline
59 & 0.1352 & -0.4481 & 0.0373 & 3184551.5216 & 265379.2935 & 515.1498 \tabularnewline
60 & 0.1414 & -0.4942 & 0.0412 & 3872635.0423 & 322719.5869 & 568.0841 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=36074&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.0309[/C][C]0.0337[/C][C]0.0028[/C][C]18044.2327[/C][C]1503.6861[/C][C]38.7774[/C][/ROW]
[ROW][C]50[/C][C]0.0518[/C][C]-0.0346[/C][C]0.0029[/C][C]19005.7041[/C][C]1583.8087[/C][C]39.7971[/C][/ROW]
[ROW][C]51[/C][C]0.0664[/C][C]-0.0656[/C][C]0.0055[/C][C]68314.8922[/C][C]5692.9077[/C][C]75.4514[/C][/ROW]
[ROW][C]52[/C][C]0.0784[/C][C]-0.0773[/C][C]0.0064[/C][C]94833.9274[/C][C]7902.8273[/C][C]88.8978[/C][/ROW]
[ROW][C]53[/C][C]0.0888[/C][C]-0.0313[/C][C]0.0026[/C][C]15557.8665[/C][C]1296.4889[/C][C]36.0068[/C][/ROW]
[ROW][C]54[/C][C]0.098[/C][C]-0.0455[/C][C]0.0038[/C][C]32866.4908[/C][C]2738.8742[/C][C]52.3343[/C][/ROW]
[ROW][C]55[/C][C]0.1065[/C][C]-0.12[/C][C]0.01[/C][C]228466.0055[/C][C]19038.8338[/C][C]137.9813[/C][/ROW]
[ROW][C]56[/C][C]0.1143[/C][C]-0.2385[/C][C]0.0199[/C][C]902027.2982[/C][C]75168.9415[/C][C]274.1695[/C][/ROW]
[ROW][C]57[/C][C]0.1217[/C][C]-0.2349[/C][C]0.0196[/C][C]874825.7041[/C][C]72902.142[/C][C]270.004[/C][/ROW]
[ROW][C]58[/C][C]0.1286[/C][C]-0.2561[/C][C]0.0213[/C][C]1040422.8012[/C][C]86701.9001[/C][C]294.4519[/C][/ROW]
[ROW][C]59[/C][C]0.1352[/C][C]-0.4481[/C][C]0.0373[/C][C]3184551.5216[/C][C]265379.2935[/C][C]515.1498[/C][/ROW]
[ROW][C]60[/C][C]0.1414[/C][C]-0.4942[/C][C]0.0412[/C][C]3872635.0423[/C][C]322719.5869[/C][C]568.0841[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=36074&T=2

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=36074&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.03090.03370.002818044.23271503.686138.7774
500.0518-0.03460.002919005.70411583.808739.7971
510.0664-0.06560.005568314.89225692.907775.4514
520.0784-0.07730.006494833.92747902.827388.8978
530.0888-0.03130.002615557.86651296.488936.0068
540.098-0.04550.003832866.49082738.874252.3343
550.1065-0.120.01228466.005519038.8338137.9813
560.1143-0.23850.0199902027.298275168.9415274.1695
570.1217-0.23490.0196874825.704172902.142270.004
580.1286-0.25610.02131040422.801286701.9001294.4519
590.1352-0.44810.03733184551.5216265379.2935515.1498
600.1414-0.49420.04123872635.0423322719.5869568.0841



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