Free Statistics

of Irreproducible Research!

Author's title

Author*Unverified author*
R Software Modulerwasp_arimaforecasting.wasp
Title produced by softwareARIMA Forecasting
Date of computationThu, 20 Dec 2007 08:24:16 -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/2007/Dec/20/t1198163187tgbqnnkpy0keys6.htm/, Retrieved Thu, 31 Oct 2024 22:54:59 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=4732, Retrieved Thu, 31 Oct 2024 22:54:59 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact253
Family? (F = Feedback message, R = changed R code, M = changed R Module, P = changed Parameters, D = changed Data)
-       [ARIMA Forecasting] [ARIMA Forecast du...] [2007-12-20 15:24:16] [7c5f7a910a5108d789a748f71ee8daf4] [Current]
Feedback Forum

Post a new message
Dataseries X:
101.2
93.1
84.2
85.8
91.8
92.4
80.3
79.7
62.5
57.1
100.8
100.7
86.2
83.2
71.7
77.5
89.8
80.3
78.7
93.8
57.6
60.6
91.0
85.3
77.4
77.3
68.3
69.9
81.7
75.1
69.9
84.0
54.3
60.0
89.9
77.0
85.3
77.6
69.2
75.5
85.7
72.2
79.9
85.3
52.2
61.2
82.4
85.4
78.2
70.2
70.2
69.3
77.5
66.1
69.0
79.2
56.2
64.5
77.4
88.5




Summary of compuational 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 compuational 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=4732&T=0

[TABLE]
[ROW][C]Summary of compuational 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=4732&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=4732&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 compuational 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])
3677-------
3785.3-------
3877.6-------
3969.2-------
4075.5-------
4185.7-------
4272.2-------
4379.9-------
4485.3-------
4552.2-------
4661.2-------
4782.4-------
4885.4-------
4978.284.277373.2845101.26970.24170.44850.4530.4485
5070.277.440468.487590.46750.1380.45450.49040.1155
5170.271.63163.90882.53260.39850.60150.6690.0067
5269.375.101965.775189.14960.20910.7530.47790.0754
5377.586.982573.683109.69330.20660.93650.54410.5543
5466.173.297164.2386.92650.15030.27280.56270.0409
556980.021468.633898.55140.12190.92960.50510.2847
5679.286.440372.6935110.60880.27850.92140.53680.5336
5756.252.418248.31757.61890.07700.53280
5864.561.37655.247969.77010.23290.88660.51640
5977.483.118470.2874105.18120.30570.95090.52540.4197
6088.585.918771.9705110.83890.41960.74860.51630.5163

\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 & 77 & - & - & - & - & - & - & - \tabularnewline
37 & 85.3 & - & - & - & - & - & - & - \tabularnewline
38 & 77.6 & - & - & - & - & - & - & - \tabularnewline
39 & 69.2 & - & - & - & - & - & - & - \tabularnewline
40 & 75.5 & - & - & - & - & - & - & - \tabularnewline
41 & 85.7 & - & - & - & - & - & - & - \tabularnewline
42 & 72.2 & - & - & - & - & - & - & - \tabularnewline
43 & 79.9 & - & - & - & - & - & - & - \tabularnewline
44 & 85.3 & - & - & - & - & - & - & - \tabularnewline
45 & 52.2 & - & - & - & - & - & - & - \tabularnewline
46 & 61.2 & - & - & - & - & - & - & - \tabularnewline
47 & 82.4 & - & - & - & - & - & - & - \tabularnewline
48 & 85.4 & - & - & - & - & - & - & - \tabularnewline
49 & 78.2 & 84.2773 & 73.2845 & 101.2697 & 0.2417 & 0.4485 & 0.453 & 0.4485 \tabularnewline
50 & 70.2 & 77.4404 & 68.4875 & 90.4675 & 0.138 & 0.4545 & 0.4904 & 0.1155 \tabularnewline
51 & 70.2 & 71.631 & 63.908 & 82.5326 & 0.3985 & 0.6015 & 0.669 & 0.0067 \tabularnewline
52 & 69.3 & 75.1019 & 65.7751 & 89.1496 & 0.2091 & 0.753 & 0.4779 & 0.0754 \tabularnewline
53 & 77.5 & 86.9825 & 73.683 & 109.6933 & 0.2066 & 0.9365 & 0.5441 & 0.5543 \tabularnewline
54 & 66.1 & 73.2971 & 64.23 & 86.9265 & 0.1503 & 0.2728 & 0.5627 & 0.0409 \tabularnewline
55 & 69 & 80.0214 & 68.6338 & 98.5514 & 0.1219 & 0.9296 & 0.5051 & 0.2847 \tabularnewline
56 & 79.2 & 86.4403 & 72.6935 & 110.6088 & 0.2785 & 0.9214 & 0.5368 & 0.5336 \tabularnewline
57 & 56.2 & 52.4182 & 48.317 & 57.6189 & 0.077 & 0 & 0.5328 & 0 \tabularnewline
58 & 64.5 & 61.376 & 55.2479 & 69.7701 & 0.2329 & 0.8866 & 0.5164 & 0 \tabularnewline
59 & 77.4 & 83.1184 & 70.2874 & 105.1812 & 0.3057 & 0.9509 & 0.5254 & 0.4197 \tabularnewline
60 & 88.5 & 85.9187 & 71.9705 & 110.8389 & 0.4196 & 0.7486 & 0.5163 & 0.5163 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=4732&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]77[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]37[/C][C]85.3[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]38[/C][C]77.6[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]39[/C][C]69.2[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]40[/C][C]75.5[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]41[/C][C]85.7[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]42[/C][C]72.2[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]43[/C][C]79.9[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]44[/C][C]85.3[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]45[/C][C]52.2[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]46[/C][C]61.2[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]47[/C][C]82.4[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]48[/C][C]85.4[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]49[/C][C]78.2[/C][C]84.2773[/C][C]73.2845[/C][C]101.2697[/C][C]0.2417[/C][C]0.4485[/C][C]0.453[/C][C]0.4485[/C][/ROW]
[ROW][C]50[/C][C]70.2[/C][C]77.4404[/C][C]68.4875[/C][C]90.4675[/C][C]0.138[/C][C]0.4545[/C][C]0.4904[/C][C]0.1155[/C][/ROW]
[ROW][C]51[/C][C]70.2[/C][C]71.631[/C][C]63.908[/C][C]82.5326[/C][C]0.3985[/C][C]0.6015[/C][C]0.669[/C][C]0.0067[/C][/ROW]
[ROW][C]52[/C][C]69.3[/C][C]75.1019[/C][C]65.7751[/C][C]89.1496[/C][C]0.2091[/C][C]0.753[/C][C]0.4779[/C][C]0.0754[/C][/ROW]
[ROW][C]53[/C][C]77.5[/C][C]86.9825[/C][C]73.683[/C][C]109.6933[/C][C]0.2066[/C][C]0.9365[/C][C]0.5441[/C][C]0.5543[/C][/ROW]
[ROW][C]54[/C][C]66.1[/C][C]73.2971[/C][C]64.23[/C][C]86.9265[/C][C]0.1503[/C][C]0.2728[/C][C]0.5627[/C][C]0.0409[/C][/ROW]
[ROW][C]55[/C][C]69[/C][C]80.0214[/C][C]68.6338[/C][C]98.5514[/C][C]0.1219[/C][C]0.9296[/C][C]0.5051[/C][C]0.2847[/C][/ROW]
[ROW][C]56[/C][C]79.2[/C][C]86.4403[/C][C]72.6935[/C][C]110.6088[/C][C]0.2785[/C][C]0.9214[/C][C]0.5368[/C][C]0.5336[/C][/ROW]
[ROW][C]57[/C][C]56.2[/C][C]52.4182[/C][C]48.317[/C][C]57.6189[/C][C]0.077[/C][C]0[/C][C]0.5328[/C][C]0[/C][/ROW]
[ROW][C]58[/C][C]64.5[/C][C]61.376[/C][C]55.2479[/C][C]69.7701[/C][C]0.2329[/C][C]0.8866[/C][C]0.5164[/C][C]0[/C][/ROW]
[ROW][C]59[/C][C]77.4[/C][C]83.1184[/C][C]70.2874[/C][C]105.1812[/C][C]0.3057[/C][C]0.9509[/C][C]0.5254[/C][C]0.4197[/C][/ROW]
[ROW][C]60[/C][C]88.5[/C][C]85.9187[/C][C]71.9705[/C][C]110.8389[/C][C]0.4196[/C][C]0.7486[/C][C]0.5163[/C][C]0.5163[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=4732&T=1

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=4732&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])
3677-------
3785.3-------
3877.6-------
3969.2-------
4075.5-------
4185.7-------
4272.2-------
4379.9-------
4485.3-------
4552.2-------
4661.2-------
4782.4-------
4885.4-------
4978.284.277373.2845101.26970.24170.44850.4530.4485
5070.277.440468.487590.46750.1380.45450.49040.1155
5170.271.63163.90882.53260.39850.60150.6690.0067
5269.375.101965.775189.14960.20910.7530.47790.0754
5377.586.982573.683109.69330.20660.93650.54410.5543
5466.173.297164.2386.92650.15030.27280.56270.0409
556980.021468.633898.55140.12190.92960.50510.2847
5679.286.440372.6935110.60880.27850.92140.53680.5336
5756.252.418248.31757.61890.07700.53280
5864.561.37655.247969.77010.23290.88660.51640
5977.483.118470.2874105.18120.30570.95090.52540.4197
6088.585.918771.9705110.83890.41960.74860.51630.5163







Univariate ARIMA Extrapolation Forecast Performance
time% S.E.PEMAPESq.EMSERMSE
490.1029-0.07210.00636.93393.07781.7544
500.0858-0.09350.007852.4244.36872.0901
510.0776-0.020.00172.04790.17070.4131
520.0954-0.07730.006433.66182.80511.6749
530.1332-0.1090.009189.91717.49312.7374
540.0949-0.09820.008251.79824.31652.0776
550.1181-0.13770.0115121.471510.12263.1816
560.1427-0.08380.00752.42234.36852.0901
570.05060.07210.00614.30181.19181.0917
580.06980.05090.00429.75910.81330.9018
590.1354-0.06880.005732.69982.7251.6508
600.1480.030.00256.66330.55530.7452

\begin{tabular}{lllllllll}
\hline
Univariate ARIMA Extrapolation Forecast Performance \tabularnewline
time & % S.E. & PE & MAPE & Sq.E & MSE & RMSE \tabularnewline
49 & 0.1029 & -0.0721 & 0.006 & 36.9339 & 3.0778 & 1.7544 \tabularnewline
50 & 0.0858 & -0.0935 & 0.0078 & 52.424 & 4.3687 & 2.0901 \tabularnewline
51 & 0.0776 & -0.02 & 0.0017 & 2.0479 & 0.1707 & 0.4131 \tabularnewline
52 & 0.0954 & -0.0773 & 0.0064 & 33.6618 & 2.8051 & 1.6749 \tabularnewline
53 & 0.1332 & -0.109 & 0.0091 & 89.9171 & 7.4931 & 2.7374 \tabularnewline
54 & 0.0949 & -0.0982 & 0.0082 & 51.7982 & 4.3165 & 2.0776 \tabularnewline
55 & 0.1181 & -0.1377 & 0.0115 & 121.4715 & 10.1226 & 3.1816 \tabularnewline
56 & 0.1427 & -0.0838 & 0.007 & 52.4223 & 4.3685 & 2.0901 \tabularnewline
57 & 0.0506 & 0.0721 & 0.006 & 14.3018 & 1.1918 & 1.0917 \tabularnewline
58 & 0.0698 & 0.0509 & 0.0042 & 9.7591 & 0.8133 & 0.9018 \tabularnewline
59 & 0.1354 & -0.0688 & 0.0057 & 32.6998 & 2.725 & 1.6508 \tabularnewline
60 & 0.148 & 0.03 & 0.0025 & 6.6633 & 0.5553 & 0.7452 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=4732&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.1029[/C][C]-0.0721[/C][C]0.006[/C][C]36.9339[/C][C]3.0778[/C][C]1.7544[/C][/ROW]
[ROW][C]50[/C][C]0.0858[/C][C]-0.0935[/C][C]0.0078[/C][C]52.424[/C][C]4.3687[/C][C]2.0901[/C][/ROW]
[ROW][C]51[/C][C]0.0776[/C][C]-0.02[/C][C]0.0017[/C][C]2.0479[/C][C]0.1707[/C][C]0.4131[/C][/ROW]
[ROW][C]52[/C][C]0.0954[/C][C]-0.0773[/C][C]0.0064[/C][C]33.6618[/C][C]2.8051[/C][C]1.6749[/C][/ROW]
[ROW][C]53[/C][C]0.1332[/C][C]-0.109[/C][C]0.0091[/C][C]89.9171[/C][C]7.4931[/C][C]2.7374[/C][/ROW]
[ROW][C]54[/C][C]0.0949[/C][C]-0.0982[/C][C]0.0082[/C][C]51.7982[/C][C]4.3165[/C][C]2.0776[/C][/ROW]
[ROW][C]55[/C][C]0.1181[/C][C]-0.1377[/C][C]0.0115[/C][C]121.4715[/C][C]10.1226[/C][C]3.1816[/C][/ROW]
[ROW][C]56[/C][C]0.1427[/C][C]-0.0838[/C][C]0.007[/C][C]52.4223[/C][C]4.3685[/C][C]2.0901[/C][/ROW]
[ROW][C]57[/C][C]0.0506[/C][C]0.0721[/C][C]0.006[/C][C]14.3018[/C][C]1.1918[/C][C]1.0917[/C][/ROW]
[ROW][C]58[/C][C]0.0698[/C][C]0.0509[/C][C]0.0042[/C][C]9.7591[/C][C]0.8133[/C][C]0.9018[/C][/ROW]
[ROW][C]59[/C][C]0.1354[/C][C]-0.0688[/C][C]0.0057[/C][C]32.6998[/C][C]2.725[/C][C]1.6508[/C][/ROW]
[ROW][C]60[/C][C]0.148[/C][C]0.03[/C][C]0.0025[/C][C]6.6633[/C][C]0.5553[/C][C]0.7452[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=4732&T=2

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=4732&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.1029-0.07210.00636.93393.07781.7544
500.0858-0.09350.007852.4244.36872.0901
510.0776-0.020.00172.04790.17070.4131
520.0954-0.07730.006433.66182.80511.6749
530.1332-0.1090.009189.91717.49312.7374
540.0949-0.09820.008251.79824.31652.0776
550.1181-0.13770.0115121.471510.12263.1816
560.1427-0.08380.00752.42234.36852.0901
570.05060.07210.00614.30181.19181.0917
580.06980.05090.00429.75910.81330.9018
590.1354-0.06880.005732.69982.7251.6508
600.1480.030.00256.66330.55530.7452



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