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, 02 Dec 2013 07:01:37 -0500
Cite this page as followsStatistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?v=date/2013/Dec/02/t13859857211j259wjsi81luy5.htm/, Retrieved Thu, 28 Mar 2024 12:48:59 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=229972, Retrieved Thu, 28 Mar 2024 12:48:59 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact73
Family? (F = Feedback message, R = changed R code, M = changed R Module, P = changed Parameters, D = changed Data)
-       [ARIMA Forecasting] [WS9 Aremi Forecast] [2013-12-02 12:01:37] [59f7ebe53b87b0acbb2aecff589db592] [Current]
Feedback Forum

Post a new message
Dataseries X:
46
62
66
59
58
61
41
27
58
70
49
59
44
36
72
45
56
54
53
35
61
52
47
51
52
63
74
45
51
64
36
30
55
64
39
40
63
45
59
55
40
64
27
28
45
57
45
69
60
56
58
50
51
53
37
22
55
70
62
58
39
49
58
47
42
62
39
40
72
70
54
65




Summary of computational transaction
Raw Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time4 seconds
R Server'Sir Maurice George Kendall' @ kendall.wessa.net

\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 & 4 seconds \tabularnewline
R Server & 'Sir Maurice George Kendall' @ kendall.wessa.net \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=229972&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]4 seconds[/C][/ROW]
[ROW][C]R Server[/C][C]'Sir Maurice George Kendall' @ kendall.wessa.net[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=229972&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=229972&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 time4 seconds
R Server'Sir Maurice George Kendall' @ kendall.wessa.net







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[60])
4869-------
4960-------
5056-------
5158-------
5250-------
5351-------
5453-------
5537-------
5622-------
5755-------
5870-------
5962-------
6058-------
613960.697838.151583.24410.02960.59270.52420.5927
62495633.395578.60450.27190.92980.50.4312
63585835.395580.60450.50.78240.50.5
64475027.395572.60450.39740.24390.50.2439
65425128.395573.60450.21760.63560.50.2719
66625330.395575.60450.21760.82990.50.3323
67393714.395559.60450.43120.01510.50.0343
684022-0.604544.60450.05930.07020.59e-04
69725532.395577.60450.07020.90330.50.3974
70707047.395592.60450.50.43120.50.8509
71546239.395584.60450.24390.24390.50.6356
72655835.395580.60450.27190.63560.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[60]) \tabularnewline
48 & 69 & - & - & - & - & - & - & - \tabularnewline
49 & 60 & - & - & - & - & - & - & - \tabularnewline
50 & 56 & - & - & - & - & - & - & - \tabularnewline
51 & 58 & - & - & - & - & - & - & - \tabularnewline
52 & 50 & - & - & - & - & - & - & - \tabularnewline
53 & 51 & - & - & - & - & - & - & - \tabularnewline
54 & 53 & - & - & - & - & - & - & - \tabularnewline
55 & 37 & - & - & - & - & - & - & - \tabularnewline
56 & 22 & - & - & - & - & - & - & - \tabularnewline
57 & 55 & - & - & - & - & - & - & - \tabularnewline
58 & 70 & - & - & - & - & - & - & - \tabularnewline
59 & 62 & - & - & - & - & - & - & - \tabularnewline
60 & 58 & - & - & - & - & - & - & - \tabularnewline
61 & 39 & 60.6978 & 38.1515 & 83.2441 & 0.0296 & 0.5927 & 0.5242 & 0.5927 \tabularnewline
62 & 49 & 56 & 33.3955 & 78.6045 & 0.2719 & 0.9298 & 0.5 & 0.4312 \tabularnewline
63 & 58 & 58 & 35.3955 & 80.6045 & 0.5 & 0.7824 & 0.5 & 0.5 \tabularnewline
64 & 47 & 50 & 27.3955 & 72.6045 & 0.3974 & 0.2439 & 0.5 & 0.2439 \tabularnewline
65 & 42 & 51 & 28.3955 & 73.6045 & 0.2176 & 0.6356 & 0.5 & 0.2719 \tabularnewline
66 & 62 & 53 & 30.3955 & 75.6045 & 0.2176 & 0.8299 & 0.5 & 0.3323 \tabularnewline
67 & 39 & 37 & 14.3955 & 59.6045 & 0.4312 & 0.0151 & 0.5 & 0.0343 \tabularnewline
68 & 40 & 22 & -0.6045 & 44.6045 & 0.0593 & 0.0702 & 0.5 & 9e-04 \tabularnewline
69 & 72 & 55 & 32.3955 & 77.6045 & 0.0702 & 0.9033 & 0.5 & 0.3974 \tabularnewline
70 & 70 & 70 & 47.3955 & 92.6045 & 0.5 & 0.4312 & 0.5 & 0.8509 \tabularnewline
71 & 54 & 62 & 39.3955 & 84.6045 & 0.2439 & 0.2439 & 0.5 & 0.6356 \tabularnewline
72 & 65 & 58 & 35.3955 & 80.6045 & 0.2719 & 0.6356 & 0.5 & 0.5 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=229972&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[60])[/C][/ROW]
[ROW][C]48[/C][C]69[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]49[/C][C]60[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]50[/C][C]56[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]51[/C][C]58[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]52[/C][C]50[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]53[/C][C]51[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]54[/C][C]53[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]55[/C][C]37[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]56[/C][C]22[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]57[/C][C]55[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]58[/C][C]70[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]59[/C][C]62[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]60[/C][C]58[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]61[/C][C]39[/C][C]60.6978[/C][C]38.1515[/C][C]83.2441[/C][C]0.0296[/C][C]0.5927[/C][C]0.5242[/C][C]0.5927[/C][/ROW]
[ROW][C]62[/C][C]49[/C][C]56[/C][C]33.3955[/C][C]78.6045[/C][C]0.2719[/C][C]0.9298[/C][C]0.5[/C][C]0.4312[/C][/ROW]
[ROW][C]63[/C][C]58[/C][C]58[/C][C]35.3955[/C][C]80.6045[/C][C]0.5[/C][C]0.7824[/C][C]0.5[/C][C]0.5[/C][/ROW]
[ROW][C]64[/C][C]47[/C][C]50[/C][C]27.3955[/C][C]72.6045[/C][C]0.3974[/C][C]0.2439[/C][C]0.5[/C][C]0.2439[/C][/ROW]
[ROW][C]65[/C][C]42[/C][C]51[/C][C]28.3955[/C][C]73.6045[/C][C]0.2176[/C][C]0.6356[/C][C]0.5[/C][C]0.2719[/C][/ROW]
[ROW][C]66[/C][C]62[/C][C]53[/C][C]30.3955[/C][C]75.6045[/C][C]0.2176[/C][C]0.8299[/C][C]0.5[/C][C]0.3323[/C][/ROW]
[ROW][C]67[/C][C]39[/C][C]37[/C][C]14.3955[/C][C]59.6045[/C][C]0.4312[/C][C]0.0151[/C][C]0.5[/C][C]0.0343[/C][/ROW]
[ROW][C]68[/C][C]40[/C][C]22[/C][C]-0.6045[/C][C]44.6045[/C][C]0.0593[/C][C]0.0702[/C][C]0.5[/C][C]9e-04[/C][/ROW]
[ROW][C]69[/C][C]72[/C][C]55[/C][C]32.3955[/C][C]77.6045[/C][C]0.0702[/C][C]0.9033[/C][C]0.5[/C][C]0.3974[/C][/ROW]
[ROW][C]70[/C][C]70[/C][C]70[/C][C]47.3955[/C][C]92.6045[/C][C]0.5[/C][C]0.4312[/C][C]0.5[/C][C]0.8509[/C][/ROW]
[ROW][C]71[/C][C]54[/C][C]62[/C][C]39.3955[/C][C]84.6045[/C][C]0.2439[/C][C]0.2439[/C][C]0.5[/C][C]0.6356[/C][/ROW]
[ROW][C]72[/C][C]65[/C][C]58[/C][C]35.3955[/C][C]80.6045[/C][C]0.2719[/C][C]0.6356[/C][C]0.5[/C][C]0.5[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=229972&T=1

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=229972&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[60])
4869-------
4960-------
5056-------
5158-------
5250-------
5351-------
5453-------
5537-------
5622-------
5755-------
5870-------
5962-------
6058-------
613960.697838.151583.24410.02960.59270.52420.5927
62495633.395578.60450.27190.92980.50.4312
63585835.395580.60450.50.78240.50.5
64475027.395572.60450.39740.24390.50.2439
65425128.395573.60450.21760.63560.50.2719
66625330.395575.60450.21760.82990.50.3323
67393714.395559.60450.43120.01510.50.0343
684022-0.604544.60450.05930.07020.59e-04
69725532.395577.60450.07020.90330.50.3974
70707047.395592.60450.50.43120.50.8509
71546239.395584.60450.24390.24390.50.6356
72655835.395580.60450.27190.63560.50.5







Univariate ARIMA Extrapolation Forecast Performance
time% S.E.PEMAPEsMAPESq.EMSERMSEScaledEMASE
610.1895-0.55640.55640.4353470.794800-1.70481.7048
620.2059-0.14290.34960.284349259.897416.1213-0.551.1274
630.198800.23310.18950173.264913.16300.7516
640.2307-0.06380.19080.15769132.198711.4978-0.23570.6226
650.2261-0.21430.19550.164881121.95911.0435-0.70710.6395
660.21760.14520.18710.163481115.132510.730.70710.6508
670.31170.05130.16770.1476499.25649.96280.15710.5803
680.52420.450.2030.2017324127.349311.28491.41430.6845
690.20970.23610.20670.2091289145.310512.05451.33570.7569
700.164800.1860.18820130.779511.435900.6812
710.186-0.14810.18250.183664124.708611.1673-0.62860.6764
720.19880.10770.17630.177849118.399610.88120.550.6659

\begin{tabular}{lllllllll}
\hline
Univariate ARIMA Extrapolation Forecast Performance \tabularnewline
time & % S.E. & PE & MAPE & sMAPE & Sq.E & MSE & RMSE & ScaledE & MASE \tabularnewline
61 & 0.1895 & -0.5564 & 0.5564 & 0.4353 & 470.7948 & 0 & 0 & -1.7048 & 1.7048 \tabularnewline
62 & 0.2059 & -0.1429 & 0.3496 & 0.2843 & 49 & 259.8974 & 16.1213 & -0.55 & 1.1274 \tabularnewline
63 & 0.1988 & 0 & 0.2331 & 0.1895 & 0 & 173.2649 & 13.163 & 0 & 0.7516 \tabularnewline
64 & 0.2307 & -0.0638 & 0.1908 & 0.1576 & 9 & 132.1987 & 11.4978 & -0.2357 & 0.6226 \tabularnewline
65 & 0.2261 & -0.2143 & 0.1955 & 0.1648 & 81 & 121.959 & 11.0435 & -0.7071 & 0.6395 \tabularnewline
66 & 0.2176 & 0.1452 & 0.1871 & 0.1634 & 81 & 115.1325 & 10.73 & 0.7071 & 0.6508 \tabularnewline
67 & 0.3117 & 0.0513 & 0.1677 & 0.1476 & 4 & 99.2564 & 9.9628 & 0.1571 & 0.5803 \tabularnewline
68 & 0.5242 & 0.45 & 0.203 & 0.2017 & 324 & 127.3493 & 11.2849 & 1.4143 & 0.6845 \tabularnewline
69 & 0.2097 & 0.2361 & 0.2067 & 0.2091 & 289 & 145.3105 & 12.0545 & 1.3357 & 0.7569 \tabularnewline
70 & 0.1648 & 0 & 0.186 & 0.1882 & 0 & 130.7795 & 11.4359 & 0 & 0.6812 \tabularnewline
71 & 0.186 & -0.1481 & 0.1825 & 0.1836 & 64 & 124.7086 & 11.1673 & -0.6286 & 0.6764 \tabularnewline
72 & 0.1988 & 0.1077 & 0.1763 & 0.1778 & 49 & 118.3996 & 10.8812 & 0.55 & 0.6659 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=229972&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]sMAPE[/C][C]Sq.E[/C][C]MSE[/C][C]RMSE[/C][C]ScaledE[/C][C]MASE[/C][/ROW]
[ROW][C]61[/C][C]0.1895[/C][C]-0.5564[/C][C]0.5564[/C][C]0.4353[/C][C]470.7948[/C][C]0[/C][C]0[/C][C]-1.7048[/C][C]1.7048[/C][/ROW]
[ROW][C]62[/C][C]0.2059[/C][C]-0.1429[/C][C]0.3496[/C][C]0.2843[/C][C]49[/C][C]259.8974[/C][C]16.1213[/C][C]-0.55[/C][C]1.1274[/C][/ROW]
[ROW][C]63[/C][C]0.1988[/C][C]0[/C][C]0.2331[/C][C]0.1895[/C][C]0[/C][C]173.2649[/C][C]13.163[/C][C]0[/C][C]0.7516[/C][/ROW]
[ROW][C]64[/C][C]0.2307[/C][C]-0.0638[/C][C]0.1908[/C][C]0.1576[/C][C]9[/C][C]132.1987[/C][C]11.4978[/C][C]-0.2357[/C][C]0.6226[/C][/ROW]
[ROW][C]65[/C][C]0.2261[/C][C]-0.2143[/C][C]0.1955[/C][C]0.1648[/C][C]81[/C][C]121.959[/C][C]11.0435[/C][C]-0.7071[/C][C]0.6395[/C][/ROW]
[ROW][C]66[/C][C]0.2176[/C][C]0.1452[/C][C]0.1871[/C][C]0.1634[/C][C]81[/C][C]115.1325[/C][C]10.73[/C][C]0.7071[/C][C]0.6508[/C][/ROW]
[ROW][C]67[/C][C]0.3117[/C][C]0.0513[/C][C]0.1677[/C][C]0.1476[/C][C]4[/C][C]99.2564[/C][C]9.9628[/C][C]0.1571[/C][C]0.5803[/C][/ROW]
[ROW][C]68[/C][C]0.5242[/C][C]0.45[/C][C]0.203[/C][C]0.2017[/C][C]324[/C][C]127.3493[/C][C]11.2849[/C][C]1.4143[/C][C]0.6845[/C][/ROW]
[ROW][C]69[/C][C]0.2097[/C][C]0.2361[/C][C]0.2067[/C][C]0.2091[/C][C]289[/C][C]145.3105[/C][C]12.0545[/C][C]1.3357[/C][C]0.7569[/C][/ROW]
[ROW][C]70[/C][C]0.1648[/C][C]0[/C][C]0.186[/C][C]0.1882[/C][C]0[/C][C]130.7795[/C][C]11.4359[/C][C]0[/C][C]0.6812[/C][/ROW]
[ROW][C]71[/C][C]0.186[/C][C]-0.1481[/C][C]0.1825[/C][C]0.1836[/C][C]64[/C][C]124.7086[/C][C]11.1673[/C][C]-0.6286[/C][C]0.6764[/C][/ROW]
[ROW][C]72[/C][C]0.1988[/C][C]0.1077[/C][C]0.1763[/C][C]0.1778[/C][C]49[/C][C]118.3996[/C][C]10.8812[/C][C]0.55[/C][C]0.6659[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=229972&T=2

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=229972&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.PEMAPEsMAPESq.EMSERMSEScaledEMASE
610.1895-0.55640.55640.4353470.794800-1.70481.7048
620.2059-0.14290.34960.284349259.897416.1213-0.551.1274
630.198800.23310.18950173.264913.16300.7516
640.2307-0.06380.19080.15769132.198711.4978-0.23570.6226
650.2261-0.21430.19550.164881121.95911.0435-0.70710.6395
660.21760.14520.18710.163481115.132510.730.70710.6508
670.31170.05130.16770.1476499.25649.96280.15710.5803
680.52420.450.2030.2017324127.349311.28491.41430.6845
690.20970.23610.20670.2091289145.310512.05451.33570.7569
700.164800.1860.18820130.779511.435900.6812
710.186-0.14810.18250.183664124.708611.1673-0.62860.6764
720.19880.10770.17630.177849118.399610.88120.550.6659



Parameters (Session):
par1 = 12 ; par2 = 1.0 ; par3 = 0 ; par4 = 1 ; par5 = 12 ; par6 = 0 ; par7 = 1 ; par8 = 0 ; par9 = 0 ; par10 = FALSE ;
Parameters (R input):
par1 = 12 ; par2 = 1.0 ; par3 = 0 ; par4 = 1 ; 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,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.spe <- array(0, dim=fx)
perf.scalederr <- array(0, dim=fx)
perf.mase <- array(0, dim=fx)
perf.mase1 <- array(0, dim=fx)
perf.mape <- array(0, dim=fx)
perf.smape <- array(0, dim=fx)
perf.mape1 <- array(0, dim=fx)
perf.smape1 <- 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)
perf.scaleddenom <- 0
for (i in 2:fx) {
perf.scaleddenom = perf.scaleddenom + abs(x[nx+i] - x[nx+i-1])
}
perf.scaleddenom = perf.scaleddenom / (fx-1)
for (i in 1:fx) {
locSD <- (ub[i] - forecast$pred[i]) / 1.96
perf.scalederr[i] = (x[nx+i] - forecast$pred[i]) / perf.scaleddenom
perf.pe[i] = (x[nx+i] - forecast$pred[i]) / x[nx+i]
perf.spe[i] = 2*(x[nx+i] - forecast$pred[i]) / (x[nx+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.smape[1] = abs(perf.spe[1])
perf.mape1[1] = perf.mape[1]
perf.smape1[1] = perf.smape[1]
perf.mse[1] = perf.se[1]
perf.mase[1] = abs(perf.scalederr[1])
perf.mase1[1] = perf.mase[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.smape[i] = perf.smape[i-1] + abs(perf.spe[i])
perf.smape1[i] = perf.smape[i] / i
perf.mse[i] = perf.mse[i-1] + perf.se[i]
perf.mse1[i] = perf.mse[i] / i
perf.mase[i] = perf.mase[i-1] + abs(perf.scalederr[i])
perf.mase1[i] = perf.mase[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',10,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,'sMAPE',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.element(a,'ScaledE',1,header=TRUE)
a<-table.element(a,'MASE',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.smape1[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.element(a,round(perf.scalederr[i],4))
a<-table.element(a,round(perf.mase1[i],4))
a<-table.row.end(a)
}
a<-table.end(a)
table.save(a,file='mytable1.tab')