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, 24 Dec 2010 21:10:37 +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/24/t1293225091eiw4hfx2di01ryn.htm/, Retrieved Tue, 30 Apr 2024 04:00:22 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=115288, Retrieved Tue, 30 Apr 2024 04:00:22 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact139
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]
-   PD      [ARIMA Forecasting] [ARIMA forecast ol...] [2010-12-22 22:41:36] [a8a0ff0853b70f438be515083758c362]
-   P         [ARIMA Forecasting] [Arima Forecast ol...] [2010-12-24 09:42:48] [a8a0ff0853b70f438be515083758c362]
-   P             [ARIMA Forecasting] [ARIMA forecasting...] [2010-12-24 21:10:37] [8f110cf3e3846d42560df9b5835185a6] [Current]
Feedback Forum

Post a new message
Dataseries X:
78.33
78.21
78.94
77.94
77.31
75.75
77.73
77.90
77.45
77.46
77.97
77.23
76.56
76.70
76.51
76.03
76.69
76.38
76.80
76.63
77.17
78.63
78.89
76.94
77.50
79.27
79.77
78.62
78.60
77.88
78.71
79.27
80.12
81.12
81.48
82.81
82.39
82.41
82.20
81.99
81.61
83.51
84.05
82.99
83.54
84.44
84.24
83.88
84.17
84.59
84.76
85.14
85.22
84.77
84.50
84.56
83.79
83.96
84.80
84.89
84.78
84.80
84.44
84.65
84.22
84.08
85.29
85.00
84.63
84.92
84.61
84.50
84.29
84.50
84.41
84.71
84.21
83.86
84.40
83.71
84.42
85.26
85.08
85.65
85.74
85.89
86.08
85.49
85.97
85.84
86.72
85.42
83.87
85.45
85.35
84.27
83.13
83.79
83.70
83.76
83.47
83.78
84.83
84.43
84.90
85.36
85.49
85.29




Summary of computational transaction
Raw Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time5 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 & 5 seconds \tabularnewline
R Server & 'Sir Ronald Aylmer Fisher' @ 193.190.124.24 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=115288&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]5 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=115288&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=115288&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 time5 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[96])
8485.65-------
8585.74-------
8685.89-------
8786.08-------
8885.49-------
8985.97-------
9085.84-------
9186.72-------
9285.42-------
9383.87-------
9485.45-------
9585.35-------
9684.27-------
9783.1384.342783.040185.64540.0340.54360.01780.5436
9883.7984.694882.949686.44010.15480.96060.08980.6834
9983.784.531982.610586.45330.1980.77540.05710.6053
10083.7684.454382.29786.61160.26410.75340.17340.5665
10183.4784.378781.940886.81660.23250.69050.10040.5348
10283.7884.285481.610486.96040.35560.72490.12730.5045
10384.8384.409381.516487.30220.38780.66510.05870.5376
10484.4384.159481.043787.27520.43240.33660.21390.4723
10584.984.261980.927787.59610.35380.46070.59110.4981
10685.3684.519380.976488.06220.32090.41660.30330.5548
10785.4984.452480.706188.19860.29360.31740.31930.538
10885.2984.536180.590188.4820.3540.31780.55260.5526

\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[96]) \tabularnewline
84 & 85.65 & - & - & - & - & - & - & - \tabularnewline
85 & 85.74 & - & - & - & - & - & - & - \tabularnewline
86 & 85.89 & - & - & - & - & - & - & - \tabularnewline
87 & 86.08 & - & - & - & - & - & - & - \tabularnewline
88 & 85.49 & - & - & - & - & - & - & - \tabularnewline
89 & 85.97 & - & - & - & - & - & - & - \tabularnewline
90 & 85.84 & - & - & - & - & - & - & - \tabularnewline
91 & 86.72 & - & - & - & - & - & - & - \tabularnewline
92 & 85.42 & - & - & - & - & - & - & - \tabularnewline
93 & 83.87 & - & - & - & - & - & - & - \tabularnewline
94 & 85.45 & - & - & - & - & - & - & - \tabularnewline
95 & 85.35 & - & - & - & - & - & - & - \tabularnewline
96 & 84.27 & - & - & - & - & - & - & - \tabularnewline
97 & 83.13 & 84.3427 & 83.0401 & 85.6454 & 0.034 & 0.5436 & 0.0178 & 0.5436 \tabularnewline
98 & 83.79 & 84.6948 & 82.9496 & 86.4401 & 0.1548 & 0.9606 & 0.0898 & 0.6834 \tabularnewline
99 & 83.7 & 84.5319 & 82.6105 & 86.4533 & 0.198 & 0.7754 & 0.0571 & 0.6053 \tabularnewline
100 & 83.76 & 84.4543 & 82.297 & 86.6116 & 0.2641 & 0.7534 & 0.1734 & 0.5665 \tabularnewline
101 & 83.47 & 84.3787 & 81.9408 & 86.8166 & 0.2325 & 0.6905 & 0.1004 & 0.5348 \tabularnewline
102 & 83.78 & 84.2854 & 81.6104 & 86.9604 & 0.3556 & 0.7249 & 0.1273 & 0.5045 \tabularnewline
103 & 84.83 & 84.4093 & 81.5164 & 87.3022 & 0.3878 & 0.6651 & 0.0587 & 0.5376 \tabularnewline
104 & 84.43 & 84.1594 & 81.0437 & 87.2752 & 0.4324 & 0.3366 & 0.2139 & 0.4723 \tabularnewline
105 & 84.9 & 84.2619 & 80.9277 & 87.5961 & 0.3538 & 0.4607 & 0.5911 & 0.4981 \tabularnewline
106 & 85.36 & 84.5193 & 80.9764 & 88.0622 & 0.3209 & 0.4166 & 0.3033 & 0.5548 \tabularnewline
107 & 85.49 & 84.4524 & 80.7061 & 88.1986 & 0.2936 & 0.3174 & 0.3193 & 0.538 \tabularnewline
108 & 85.29 & 84.5361 & 80.5901 & 88.482 & 0.354 & 0.3178 & 0.5526 & 0.5526 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=115288&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[96])[/C][/ROW]
[ROW][C]84[/C][C]85.65[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]85[/C][C]85.74[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]86[/C][C]85.89[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]87[/C][C]86.08[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]88[/C][C]85.49[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]89[/C][C]85.97[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]90[/C][C]85.84[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]91[/C][C]86.72[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]92[/C][C]85.42[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]93[/C][C]83.87[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]94[/C][C]85.45[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]95[/C][C]85.35[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]96[/C][C]84.27[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]97[/C][C]83.13[/C][C]84.3427[/C][C]83.0401[/C][C]85.6454[/C][C]0.034[/C][C]0.5436[/C][C]0.0178[/C][C]0.5436[/C][/ROW]
[ROW][C]98[/C][C]83.79[/C][C]84.6948[/C][C]82.9496[/C][C]86.4401[/C][C]0.1548[/C][C]0.9606[/C][C]0.0898[/C][C]0.6834[/C][/ROW]
[ROW][C]99[/C][C]83.7[/C][C]84.5319[/C][C]82.6105[/C][C]86.4533[/C][C]0.198[/C][C]0.7754[/C][C]0.0571[/C][C]0.6053[/C][/ROW]
[ROW][C]100[/C][C]83.76[/C][C]84.4543[/C][C]82.297[/C][C]86.6116[/C][C]0.2641[/C][C]0.7534[/C][C]0.1734[/C][C]0.5665[/C][/ROW]
[ROW][C]101[/C][C]83.47[/C][C]84.3787[/C][C]81.9408[/C][C]86.8166[/C][C]0.2325[/C][C]0.6905[/C][C]0.1004[/C][C]0.5348[/C][/ROW]
[ROW][C]102[/C][C]83.78[/C][C]84.2854[/C][C]81.6104[/C][C]86.9604[/C][C]0.3556[/C][C]0.7249[/C][C]0.1273[/C][C]0.5045[/C][/ROW]
[ROW][C]103[/C][C]84.83[/C][C]84.4093[/C][C]81.5164[/C][C]87.3022[/C][C]0.3878[/C][C]0.6651[/C][C]0.0587[/C][C]0.5376[/C][/ROW]
[ROW][C]104[/C][C]84.43[/C][C]84.1594[/C][C]81.0437[/C][C]87.2752[/C][C]0.4324[/C][C]0.3366[/C][C]0.2139[/C][C]0.4723[/C][/ROW]
[ROW][C]105[/C][C]84.9[/C][C]84.2619[/C][C]80.9277[/C][C]87.5961[/C][C]0.3538[/C][C]0.4607[/C][C]0.5911[/C][C]0.4981[/C][/ROW]
[ROW][C]106[/C][C]85.36[/C][C]84.5193[/C][C]80.9764[/C][C]88.0622[/C][C]0.3209[/C][C]0.4166[/C][C]0.3033[/C][C]0.5548[/C][/ROW]
[ROW][C]107[/C][C]85.49[/C][C]84.4524[/C][C]80.7061[/C][C]88.1986[/C][C]0.2936[/C][C]0.3174[/C][C]0.3193[/C][C]0.538[/C][/ROW]
[ROW][C]108[/C][C]85.29[/C][C]84.5361[/C][C]80.5901[/C][C]88.482[/C][C]0.354[/C][C]0.3178[/C][C]0.5526[/C][C]0.5526[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=115288&T=1

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=115288&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[96])
8485.65-------
8585.74-------
8685.89-------
8786.08-------
8885.49-------
8985.97-------
9085.84-------
9186.72-------
9285.42-------
9383.87-------
9485.45-------
9585.35-------
9684.27-------
9783.1384.342783.040185.64540.0340.54360.01780.5436
9883.7984.694882.949686.44010.15480.96060.08980.6834
9983.784.531982.610586.45330.1980.77540.05710.6053
10083.7684.454382.29786.61160.26410.75340.17340.5665
10183.4784.378781.940886.81660.23250.69050.10040.5348
10283.7884.285481.610486.96040.35560.72490.12730.5045
10384.8384.409381.516487.30220.38780.66510.05870.5376
10484.4384.159481.043787.27520.43240.33660.21390.4723
10584.984.261980.927787.59610.35380.46070.59110.4981
10685.3684.519380.976488.06220.32090.41660.30330.5548
10785.4984.452480.706188.19860.29360.31740.31930.538
10885.2984.536180.590188.4820.3540.31780.55260.5526







Univariate ARIMA Extrapolation Forecast Performance
time% S.E.PEMAPESq.EMSERMSE
970.0079-0.014401.470700
980.0105-0.01070.01250.81871.14471.0699
990.0116-0.00980.01160.69210.99390.9969
1000.013-0.00820.01080.4820.86590.9305
1010.0147-0.01080.01080.82570.85790.9262
1020.0162-0.0060.010.25540.75740.8703
1030.01750.0050.00930.1770.67450.8213
1040.01890.00320.00850.07320.59940.7742
1050.02020.00760.00840.40710.5780.7603
1060.02140.00990.00860.70680.59090.7687
1070.02260.01230.00891.07670.6350.7969
1080.02380.00890.00890.56840.62950.7934

\begin{tabular}{lllllllll}
\hline
Univariate ARIMA Extrapolation Forecast Performance \tabularnewline
time & % S.E. & PE & MAPE & Sq.E & MSE & RMSE \tabularnewline
97 & 0.0079 & -0.0144 & 0 & 1.4707 & 0 & 0 \tabularnewline
98 & 0.0105 & -0.0107 & 0.0125 & 0.8187 & 1.1447 & 1.0699 \tabularnewline
99 & 0.0116 & -0.0098 & 0.0116 & 0.6921 & 0.9939 & 0.9969 \tabularnewline
100 & 0.013 & -0.0082 & 0.0108 & 0.482 & 0.8659 & 0.9305 \tabularnewline
101 & 0.0147 & -0.0108 & 0.0108 & 0.8257 & 0.8579 & 0.9262 \tabularnewline
102 & 0.0162 & -0.006 & 0.01 & 0.2554 & 0.7574 & 0.8703 \tabularnewline
103 & 0.0175 & 0.005 & 0.0093 & 0.177 & 0.6745 & 0.8213 \tabularnewline
104 & 0.0189 & 0.0032 & 0.0085 & 0.0732 & 0.5994 & 0.7742 \tabularnewline
105 & 0.0202 & 0.0076 & 0.0084 & 0.4071 & 0.578 & 0.7603 \tabularnewline
106 & 0.0214 & 0.0099 & 0.0086 & 0.7068 & 0.5909 & 0.7687 \tabularnewline
107 & 0.0226 & 0.0123 & 0.0089 & 1.0767 & 0.635 & 0.7969 \tabularnewline
108 & 0.0238 & 0.0089 & 0.0089 & 0.5684 & 0.6295 & 0.7934 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=115288&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]97[/C][C]0.0079[/C][C]-0.0144[/C][C]0[/C][C]1.4707[/C][C]0[/C][C]0[/C][/ROW]
[ROW][C]98[/C][C]0.0105[/C][C]-0.0107[/C][C]0.0125[/C][C]0.8187[/C][C]1.1447[/C][C]1.0699[/C][/ROW]
[ROW][C]99[/C][C]0.0116[/C][C]-0.0098[/C][C]0.0116[/C][C]0.6921[/C][C]0.9939[/C][C]0.9969[/C][/ROW]
[ROW][C]100[/C][C]0.013[/C][C]-0.0082[/C][C]0.0108[/C][C]0.482[/C][C]0.8659[/C][C]0.9305[/C][/ROW]
[ROW][C]101[/C][C]0.0147[/C][C]-0.0108[/C][C]0.0108[/C][C]0.8257[/C][C]0.8579[/C][C]0.9262[/C][/ROW]
[ROW][C]102[/C][C]0.0162[/C][C]-0.006[/C][C]0.01[/C][C]0.2554[/C][C]0.7574[/C][C]0.8703[/C][/ROW]
[ROW][C]103[/C][C]0.0175[/C][C]0.005[/C][C]0.0093[/C][C]0.177[/C][C]0.6745[/C][C]0.8213[/C][/ROW]
[ROW][C]104[/C][C]0.0189[/C][C]0.0032[/C][C]0.0085[/C][C]0.0732[/C][C]0.5994[/C][C]0.7742[/C][/ROW]
[ROW][C]105[/C][C]0.0202[/C][C]0.0076[/C][C]0.0084[/C][C]0.4071[/C][C]0.578[/C][C]0.7603[/C][/ROW]
[ROW][C]106[/C][C]0.0214[/C][C]0.0099[/C][C]0.0086[/C][C]0.7068[/C][C]0.5909[/C][C]0.7687[/C][/ROW]
[ROW][C]107[/C][C]0.0226[/C][C]0.0123[/C][C]0.0089[/C][C]1.0767[/C][C]0.635[/C][C]0.7969[/C][/ROW]
[ROW][C]108[/C][C]0.0238[/C][C]0.0089[/C][C]0.0089[/C][C]0.5684[/C][C]0.6295[/C][C]0.7934[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=115288&T=2

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=115288&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
970.0079-0.014401.470700
980.0105-0.01070.01250.81871.14471.0699
990.0116-0.00980.01160.69210.99390.9969
1000.013-0.00820.01080.4820.86590.9305
1010.0147-0.01080.01080.82570.85790.9262
1020.0162-0.0060.010.25540.75740.8703
1030.01750.0050.00930.1770.67450.8213
1040.01890.00320.00850.07320.59940.7742
1050.02020.00760.00840.40710.5780.7603
1060.02140.00990.00860.70680.59090.7687
1070.02260.01230.00891.07670.6350.7969
1080.02380.00890.00890.56840.62950.7934



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