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 computationWed, 22 Dec 2010 16:40:18 +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/22/t1293036032rdhv4lcr5flw43v.htm/, Retrieved Sun, 05 May 2024 22:13:57 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=114390, Retrieved Sun, 05 May 2024 22:13:57 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact178
Family? (F = Feedback message, R = changed R code, M = changed R Module, P = changed Parameters, D = changed Data)
-     [Standard Deviation-Mean Plot] [SMP prof bach] [2008-12-15 22:25:20] [bc937651ef42bf891200cf0e0edc7238]
- RM    [Variance Reduction Matrix] [VRM prof bach] [2008-12-15 22:31:00] [bc937651ef42bf891200cf0e0edc7238]
- RMP     [(Partial) Autocorrelation Function] [ARIMA Prof bach A...] [2008-12-15 22:38:57] [bc937651ef42bf891200cf0e0edc7238]
- RMP       [ARIMA Backward Selection] [Arima backward se...] [2008-12-19 17:26:16] [bc937651ef42bf891200cf0e0edc7238]
- RMP         [ARIMA Forecasting] [ARIMA forecast pr...] [2008-12-20 11:34:44] [bc937651ef42bf891200cf0e0edc7238]
-  MPD          [ARIMA Forecasting] [] [2010-12-21 19:37:30] [94f4aa1c01e87d8321fffb341ed4df07]
-    D              [ARIMA Forecasting] [] [2010-12-22 16:40:18] [d1991ab4912b5ede0ff54c26afa5d84c] [Current]
Feedback Forum

Post a new message
Dataseries X:
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,10
4138,52
4199,75
4290,89
4443,91
4502,64
4356,98
4591,27
4696,96
4621,40
4562,84
4202,52
4296,49
4435,23
4105,18
4116,68
3844,49
3720,98
3674,40
3857,62
3801,06
3504,37
3032,60
3047,03
2962,34
2197,82
2014,45
1862,83
1905,41




Summary of computational transaction
Raw Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time1 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 & 1 seconds \tabularnewline
R Server & 'Gwilym Jenkins' @ 72.249.127.135 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=114390&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]1 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=114390&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=114390&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 time1 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[37])
254443.91-------
264502.64-------
274356.98-------
284591.27-------
294696.96-------
304621.4-------
314562.84-------
324202.52-------
334296.49-------
344435.23-------
354105.18-------
364116.68-------
373844.49-------
383720.983805.30863527.92844082.68880.27560.390900.3909
393674.43799.66853378.21324221.12380.28010.64280.00480.4174
403857.623798.85663267.82944329.88390.41410.6770.00170.4331
413801.063798.73983176.73444420.74510.49710.42640.00230.4427
423504.373798.72293097.38964500.05630.20540.49740.01070.4491
433032.63798.72053026.15514571.2860.0260.77240.02630.4538
443047.033798.72022960.95654636.48380.03930.96350.17240.4574
452962.343798.72012900.47814696.96210.0340.94950.13870.4602
462197.823798.72012843.82254753.61775e-040.9570.09570.4626
472014.453798.72012790.34514807.09523e-040.99910.27570.4646
481862.833798.72012739.56434857.87592e-040.99950.27810.4663
491905.413798.72012691.10924906.3314e-040.99970.46770.4677

\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[37]) \tabularnewline
25 & 4443.91 & - & - & - & - & - & - & - \tabularnewline
26 & 4502.64 & - & - & - & - & - & - & - \tabularnewline
27 & 4356.98 & - & - & - & - & - & - & - \tabularnewline
28 & 4591.27 & - & - & - & - & - & - & - \tabularnewline
29 & 4696.96 & - & - & - & - & - & - & - \tabularnewline
30 & 4621.4 & - & - & - & - & - & - & - \tabularnewline
31 & 4562.84 & - & - & - & - & - & - & - \tabularnewline
32 & 4202.52 & - & - & - & - & - & - & - \tabularnewline
33 & 4296.49 & - & - & - & - & - & - & - \tabularnewline
34 & 4435.23 & - & - & - & - & - & - & - \tabularnewline
35 & 4105.18 & - & - & - & - & - & - & - \tabularnewline
36 & 4116.68 & - & - & - & - & - & - & - \tabularnewline
37 & 3844.49 & - & - & - & - & - & - & - \tabularnewline
38 & 3720.98 & 3805.3086 & 3527.9284 & 4082.6888 & 0.2756 & 0.3909 & 0 & 0.3909 \tabularnewline
39 & 3674.4 & 3799.6685 & 3378.2132 & 4221.1238 & 0.2801 & 0.6428 & 0.0048 & 0.4174 \tabularnewline
40 & 3857.62 & 3798.8566 & 3267.8294 & 4329.8839 & 0.4141 & 0.677 & 0.0017 & 0.4331 \tabularnewline
41 & 3801.06 & 3798.7398 & 3176.7344 & 4420.7451 & 0.4971 & 0.4264 & 0.0023 & 0.4427 \tabularnewline
42 & 3504.37 & 3798.7229 & 3097.3896 & 4500.0563 & 0.2054 & 0.4974 & 0.0107 & 0.4491 \tabularnewline
43 & 3032.6 & 3798.7205 & 3026.1551 & 4571.286 & 0.026 & 0.7724 & 0.0263 & 0.4538 \tabularnewline
44 & 3047.03 & 3798.7202 & 2960.9565 & 4636.4838 & 0.0393 & 0.9635 & 0.1724 & 0.4574 \tabularnewline
45 & 2962.34 & 3798.7201 & 2900.4781 & 4696.9621 & 0.034 & 0.9495 & 0.1387 & 0.4602 \tabularnewline
46 & 2197.82 & 3798.7201 & 2843.8225 & 4753.6177 & 5e-04 & 0.957 & 0.0957 & 0.4626 \tabularnewline
47 & 2014.45 & 3798.7201 & 2790.3451 & 4807.0952 & 3e-04 & 0.9991 & 0.2757 & 0.4646 \tabularnewline
48 & 1862.83 & 3798.7201 & 2739.5643 & 4857.8759 & 2e-04 & 0.9995 & 0.2781 & 0.4663 \tabularnewline
49 & 1905.41 & 3798.7201 & 2691.1092 & 4906.331 & 4e-04 & 0.9997 & 0.4677 & 0.4677 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=114390&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[37])[/C][/ROW]
[ROW][C]25[/C][C]4443.91[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]26[/C][C]4502.64[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]27[/C][C]4356.98[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]28[/C][C]4591.27[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]29[/C][C]4696.96[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]30[/C][C]4621.4[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]31[/C][C]4562.84[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]32[/C][C]4202.52[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]33[/C][C]4296.49[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]34[/C][C]4435.23[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]35[/C][C]4105.18[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]36[/C][C]4116.68[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]37[/C][C]3844.49[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]38[/C][C]3720.98[/C][C]3805.3086[/C][C]3527.9284[/C][C]4082.6888[/C][C]0.2756[/C][C]0.3909[/C][C]0[/C][C]0.3909[/C][/ROW]
[ROW][C]39[/C][C]3674.4[/C][C]3799.6685[/C][C]3378.2132[/C][C]4221.1238[/C][C]0.2801[/C][C]0.6428[/C][C]0.0048[/C][C]0.4174[/C][/ROW]
[ROW][C]40[/C][C]3857.62[/C][C]3798.8566[/C][C]3267.8294[/C][C]4329.8839[/C][C]0.4141[/C][C]0.677[/C][C]0.0017[/C][C]0.4331[/C][/ROW]
[ROW][C]41[/C][C]3801.06[/C][C]3798.7398[/C][C]3176.7344[/C][C]4420.7451[/C][C]0.4971[/C][C]0.4264[/C][C]0.0023[/C][C]0.4427[/C][/ROW]
[ROW][C]42[/C][C]3504.37[/C][C]3798.7229[/C][C]3097.3896[/C][C]4500.0563[/C][C]0.2054[/C][C]0.4974[/C][C]0.0107[/C][C]0.4491[/C][/ROW]
[ROW][C]43[/C][C]3032.6[/C][C]3798.7205[/C][C]3026.1551[/C][C]4571.286[/C][C]0.026[/C][C]0.7724[/C][C]0.0263[/C][C]0.4538[/C][/ROW]
[ROW][C]44[/C][C]3047.03[/C][C]3798.7202[/C][C]2960.9565[/C][C]4636.4838[/C][C]0.0393[/C][C]0.9635[/C][C]0.1724[/C][C]0.4574[/C][/ROW]
[ROW][C]45[/C][C]2962.34[/C][C]3798.7201[/C][C]2900.4781[/C][C]4696.9621[/C][C]0.034[/C][C]0.9495[/C][C]0.1387[/C][C]0.4602[/C][/ROW]
[ROW][C]46[/C][C]2197.82[/C][C]3798.7201[/C][C]2843.8225[/C][C]4753.6177[/C][C]5e-04[/C][C]0.957[/C][C]0.0957[/C][C]0.4626[/C][/ROW]
[ROW][C]47[/C][C]2014.45[/C][C]3798.7201[/C][C]2790.3451[/C][C]4807.0952[/C][C]3e-04[/C][C]0.9991[/C][C]0.2757[/C][C]0.4646[/C][/ROW]
[ROW][C]48[/C][C]1862.83[/C][C]3798.7201[/C][C]2739.5643[/C][C]4857.8759[/C][C]2e-04[/C][C]0.9995[/C][C]0.2781[/C][C]0.4663[/C][/ROW]
[ROW][C]49[/C][C]1905.41[/C][C]3798.7201[/C][C]2691.1092[/C][C]4906.331[/C][C]4e-04[/C][C]0.9997[/C][C]0.4677[/C][C]0.4677[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=114390&T=1

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=114390&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[37])
254443.91-------
264502.64-------
274356.98-------
284591.27-------
294696.96-------
304621.4-------
314562.84-------
324202.52-------
334296.49-------
344435.23-------
354105.18-------
364116.68-------
373844.49-------
383720.983805.30863527.92844082.68880.27560.390900.3909
393674.43799.66853378.21324221.12380.28010.64280.00480.4174
403857.623798.85663267.82944329.88390.41410.6770.00170.4331
413801.063798.73983176.73444420.74510.49710.42640.00230.4427
423504.373798.72293097.38964500.05630.20540.49740.01070.4491
433032.63798.72053026.15514571.2860.0260.77240.02630.4538
443047.033798.72022960.95654636.48380.03930.96350.17240.4574
452962.343798.72012900.47814696.96210.0340.94950.13870.4602
462197.823798.72012843.82254753.61775e-040.9570.09570.4626
472014.453798.72012790.34514807.09523e-040.99910.27570.4646
481862.833798.72012739.56434857.87592e-040.99950.27810.4663
491905.413798.72012691.10924906.3314e-040.99970.46770.4677







Univariate ARIMA Extrapolation Forecast Performance
time% S.E.PEMAPESq.EMSERMSE
380.0372-0.02220.00187111.317592.609724.3436
390.0566-0.0330.002715692.20211307.683536.1619
400.07130.01550.00133453.1331287.761116.9635
410.08356e-041e-045.38350.44860.6698
420.0942-0.07750.006586643.65427220.304584.9724
430.1038-0.20170.0168586940.65148911.7209221.1599
440.1125-0.19790.0165565038.113647086.5095216.9943
450.1206-0.22020.0183699531.706958294.3089241.4421
460.1283-0.42140.03512562881.1746213573.4312462.1401
470.1354-0.46970.03913183619.8355265301.653515.0744
480.1423-0.50960.04253747670.5283312305.8774558.8433
490.1488-0.49840.04153584623.1827298718.5986546.5516

\begin{tabular}{lllllllll}
\hline
Univariate ARIMA Extrapolation Forecast Performance \tabularnewline
time & % S.E. & PE & MAPE & Sq.E & MSE & RMSE \tabularnewline
38 & 0.0372 & -0.0222 & 0.0018 & 7111.317 & 592.6097 & 24.3436 \tabularnewline
39 & 0.0566 & -0.033 & 0.0027 & 15692.2021 & 1307.6835 & 36.1619 \tabularnewline
40 & 0.0713 & 0.0155 & 0.0013 & 3453.1331 & 287.7611 & 16.9635 \tabularnewline
41 & 0.0835 & 6e-04 & 1e-04 & 5.3835 & 0.4486 & 0.6698 \tabularnewline
42 & 0.0942 & -0.0775 & 0.0065 & 86643.6542 & 7220.3045 & 84.9724 \tabularnewline
43 & 0.1038 & -0.2017 & 0.0168 & 586940.651 & 48911.7209 & 221.1599 \tabularnewline
44 & 0.1125 & -0.1979 & 0.0165 & 565038.1136 & 47086.5095 & 216.9943 \tabularnewline
45 & 0.1206 & -0.2202 & 0.0183 & 699531.7069 & 58294.3089 & 241.4421 \tabularnewline
46 & 0.1283 & -0.4214 & 0.0351 & 2562881.1746 & 213573.4312 & 462.1401 \tabularnewline
47 & 0.1354 & -0.4697 & 0.0391 & 3183619.8355 & 265301.653 & 515.0744 \tabularnewline
48 & 0.1423 & -0.5096 & 0.0425 & 3747670.5283 & 312305.8774 & 558.8433 \tabularnewline
49 & 0.1488 & -0.4984 & 0.0415 & 3584623.1827 & 298718.5986 & 546.5516 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=114390&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]38[/C][C]0.0372[/C][C]-0.0222[/C][C]0.0018[/C][C]7111.317[/C][C]592.6097[/C][C]24.3436[/C][/ROW]
[ROW][C]39[/C][C]0.0566[/C][C]-0.033[/C][C]0.0027[/C][C]15692.2021[/C][C]1307.6835[/C][C]36.1619[/C][/ROW]
[ROW][C]40[/C][C]0.0713[/C][C]0.0155[/C][C]0.0013[/C][C]3453.1331[/C][C]287.7611[/C][C]16.9635[/C][/ROW]
[ROW][C]41[/C][C]0.0835[/C][C]6e-04[/C][C]1e-04[/C][C]5.3835[/C][C]0.4486[/C][C]0.6698[/C][/ROW]
[ROW][C]42[/C][C]0.0942[/C][C]-0.0775[/C][C]0.0065[/C][C]86643.6542[/C][C]7220.3045[/C][C]84.9724[/C][/ROW]
[ROW][C]43[/C][C]0.1038[/C][C]-0.2017[/C][C]0.0168[/C][C]586940.651[/C][C]48911.7209[/C][C]221.1599[/C][/ROW]
[ROW][C]44[/C][C]0.1125[/C][C]-0.1979[/C][C]0.0165[/C][C]565038.1136[/C][C]47086.5095[/C][C]216.9943[/C][/ROW]
[ROW][C]45[/C][C]0.1206[/C][C]-0.2202[/C][C]0.0183[/C][C]699531.7069[/C][C]58294.3089[/C][C]241.4421[/C][/ROW]
[ROW][C]46[/C][C]0.1283[/C][C]-0.4214[/C][C]0.0351[/C][C]2562881.1746[/C][C]213573.4312[/C][C]462.1401[/C][/ROW]
[ROW][C]47[/C][C]0.1354[/C][C]-0.4697[/C][C]0.0391[/C][C]3183619.8355[/C][C]265301.653[/C][C]515.0744[/C][/ROW]
[ROW][C]48[/C][C]0.1423[/C][C]-0.5096[/C][C]0.0425[/C][C]3747670.5283[/C][C]312305.8774[/C][C]558.8433[/C][/ROW]
[ROW][C]49[/C][C]0.1488[/C][C]-0.4984[/C][C]0.0415[/C][C]3584623.1827[/C][C]298718.5986[/C][C]546.5516[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=114390&T=2

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=114390&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
380.0372-0.02220.00187111.317592.609724.3436
390.0566-0.0330.002715692.20211307.683536.1619
400.07130.01550.00133453.1331287.761116.9635
410.08356e-041e-045.38350.44860.6698
420.0942-0.07750.006586643.65427220.304584.9724
430.1038-0.20170.0168586940.65148911.7209221.1599
440.1125-0.19790.0165565038.113647086.5095216.9943
450.1206-0.22020.0183699531.706958294.3089241.4421
460.1283-0.42140.03512562881.1746213573.4312462.1401
470.1354-0.46970.03913183619.8355265301.653515.0744
480.1423-0.50960.04253747670.5283312305.8774558.8433
490.1488-0.49840.04153584623.1827298718.5986546.5516



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