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 computationThu, 10 Dec 2009 10:03:37 -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/2009/Dec/10/t1260464714owe2vdyt0m3pkwx.htm/, Retrieved Thu, 28 Mar 2024 14:25:10 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=65598, Retrieved Thu, 28 Mar 2024 14:25:10 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact124
Family? (F = Feedback message, R = changed R code, M = changed R Module, P = changed Parameters, D = changed Data)
-     [ARIMA Forecasting] [] [2009-12-07 09:54:52] [b98453cac15ba1066b407e146608df68]
- R PD    [ARIMA Forecasting] [] [2009-12-10 17:03:37] [bcaf453a09027aa0f995cb78bdc3c98a] [Current]
Feedback Forum

Post a new message
Dataseries X:
9.3
8.7
8.2
8.3
8.5
8.6
8.5
8.2
8.1
7.9
8.6
8.7
8.7
8.5
8.4
8.5
8.7
8.7
8.6
8.5
8.3
8
8.2
8.1
8.1
8
7.9
7.9
8
8
7.9
8
7.7
7.2
7.5
7.3
7
7
7
7.2
7.3
7.1
6.8
6.4
6.1
6.5
7.7
7.9
7.5
6.9
6.6
6.9
7.7
8
8
7.7
7.3
7.4
8.1
8.3
8.2




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

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=65598&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[49])
377-------
387-------
397-------
407.2-------
417.3-------
427.1-------
436.8-------
446.4-------
456.1-------
466.5-------
477.7-------
487.9-------
497.5-------
506.97.38896.81327.96470.0480.35270.90730.3527
516.67.35816.4248.29220.05580.83180.77380.3829
526.97.34956.13268.56650.23450.88630.59520.4043
537.77.34725.8958.79930.3170.72690.52540.4183
5487.34655.69069.00240.21960.33780.61480.4279
5587.34635.50879.18390.24280.24280.720.4349
567.77.34635.34339.34920.36460.26120.82280.4402
577.37.34625.19059.5020.48320.37390.87140.4444
587.47.34625.04799.64460.48170.51570.76470.4478
598.17.34624.91369.77890.27180.48270.38780.4507
608.37.34624.78639.90610.23260.28190.33580.4531
618.27.34624.665110.02740.26630.24280.45530.4553

\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[49]) \tabularnewline
37 & 7 & - & - & - & - & - & - & - \tabularnewline
38 & 7 & - & - & - & - & - & - & - \tabularnewline
39 & 7 & - & - & - & - & - & - & - \tabularnewline
40 & 7.2 & - & - & - & - & - & - & - \tabularnewline
41 & 7.3 & - & - & - & - & - & - & - \tabularnewline
42 & 7.1 & - & - & - & - & - & - & - \tabularnewline
43 & 6.8 & - & - & - & - & - & - & - \tabularnewline
44 & 6.4 & - & - & - & - & - & - & - \tabularnewline
45 & 6.1 & - & - & - & - & - & - & - \tabularnewline
46 & 6.5 & - & - & - & - & - & - & - \tabularnewline
47 & 7.7 & - & - & - & - & - & - & - \tabularnewline
48 & 7.9 & - & - & - & - & - & - & - \tabularnewline
49 & 7.5 & - & - & - & - & - & - & - \tabularnewline
50 & 6.9 & 7.3889 & 6.8132 & 7.9647 & 0.048 & 0.3527 & 0.9073 & 0.3527 \tabularnewline
51 & 6.6 & 7.3581 & 6.424 & 8.2922 & 0.0558 & 0.8318 & 0.7738 & 0.3829 \tabularnewline
52 & 6.9 & 7.3495 & 6.1326 & 8.5665 & 0.2345 & 0.8863 & 0.5952 & 0.4043 \tabularnewline
53 & 7.7 & 7.3472 & 5.895 & 8.7993 & 0.317 & 0.7269 & 0.5254 & 0.4183 \tabularnewline
54 & 8 & 7.3465 & 5.6906 & 9.0024 & 0.2196 & 0.3378 & 0.6148 & 0.4279 \tabularnewline
55 & 8 & 7.3463 & 5.5087 & 9.1839 & 0.2428 & 0.2428 & 0.72 & 0.4349 \tabularnewline
56 & 7.7 & 7.3463 & 5.3433 & 9.3492 & 0.3646 & 0.2612 & 0.8228 & 0.4402 \tabularnewline
57 & 7.3 & 7.3462 & 5.1905 & 9.502 & 0.4832 & 0.3739 & 0.8714 & 0.4444 \tabularnewline
58 & 7.4 & 7.3462 & 5.0479 & 9.6446 & 0.4817 & 0.5157 & 0.7647 & 0.4478 \tabularnewline
59 & 8.1 & 7.3462 & 4.9136 & 9.7789 & 0.2718 & 0.4827 & 0.3878 & 0.4507 \tabularnewline
60 & 8.3 & 7.3462 & 4.7863 & 9.9061 & 0.2326 & 0.2819 & 0.3358 & 0.4531 \tabularnewline
61 & 8.2 & 7.3462 & 4.6651 & 10.0274 & 0.2663 & 0.2428 & 0.4553 & 0.4553 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=65598&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[49])[/C][/ROW]
[ROW][C]37[/C][C]7[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]38[/C][C]7[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]39[/C][C]7[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]40[/C][C]7.2[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]41[/C][C]7.3[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]42[/C][C]7.1[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]43[/C][C]6.8[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]44[/C][C]6.4[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]45[/C][C]6.1[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]46[/C][C]6.5[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]47[/C][C]7.7[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]48[/C][C]7.9[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]49[/C][C]7.5[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]50[/C][C]6.9[/C][C]7.3889[/C][C]6.8132[/C][C]7.9647[/C][C]0.048[/C][C]0.3527[/C][C]0.9073[/C][C]0.3527[/C][/ROW]
[ROW][C]51[/C][C]6.6[/C][C]7.3581[/C][C]6.424[/C][C]8.2922[/C][C]0.0558[/C][C]0.8318[/C][C]0.7738[/C][C]0.3829[/C][/ROW]
[ROW][C]52[/C][C]6.9[/C][C]7.3495[/C][C]6.1326[/C][C]8.5665[/C][C]0.2345[/C][C]0.8863[/C][C]0.5952[/C][C]0.4043[/C][/ROW]
[ROW][C]53[/C][C]7.7[/C][C]7.3472[/C][C]5.895[/C][C]8.7993[/C][C]0.317[/C][C]0.7269[/C][C]0.5254[/C][C]0.4183[/C][/ROW]
[ROW][C]54[/C][C]8[/C][C]7.3465[/C][C]5.6906[/C][C]9.0024[/C][C]0.2196[/C][C]0.3378[/C][C]0.6148[/C][C]0.4279[/C][/ROW]
[ROW][C]55[/C][C]8[/C][C]7.3463[/C][C]5.5087[/C][C]9.1839[/C][C]0.2428[/C][C]0.2428[/C][C]0.72[/C][C]0.4349[/C][/ROW]
[ROW][C]56[/C][C]7.7[/C][C]7.3463[/C][C]5.3433[/C][C]9.3492[/C][C]0.3646[/C][C]0.2612[/C][C]0.8228[/C][C]0.4402[/C][/ROW]
[ROW][C]57[/C][C]7.3[/C][C]7.3462[/C][C]5.1905[/C][C]9.502[/C][C]0.4832[/C][C]0.3739[/C][C]0.8714[/C][C]0.4444[/C][/ROW]
[ROW][C]58[/C][C]7.4[/C][C]7.3462[/C][C]5.0479[/C][C]9.6446[/C][C]0.4817[/C][C]0.5157[/C][C]0.7647[/C][C]0.4478[/C][/ROW]
[ROW][C]59[/C][C]8.1[/C][C]7.3462[/C][C]4.9136[/C][C]9.7789[/C][C]0.2718[/C][C]0.4827[/C][C]0.3878[/C][C]0.4507[/C][/ROW]
[ROW][C]60[/C][C]8.3[/C][C]7.3462[/C][C]4.7863[/C][C]9.9061[/C][C]0.2326[/C][C]0.2819[/C][C]0.3358[/C][C]0.4531[/C][/ROW]
[ROW][C]61[/C][C]8.2[/C][C]7.3462[/C][C]4.6651[/C][C]10.0274[/C][C]0.2663[/C][C]0.2428[/C][C]0.4553[/C][C]0.4553[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=65598&T=1

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=65598&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[49])
377-------
387-------
397-------
407.2-------
417.3-------
427.1-------
436.8-------
446.4-------
456.1-------
466.5-------
477.7-------
487.9-------
497.5-------
506.97.38896.81327.96470.0480.35270.90730.3527
516.67.35816.4248.29220.05580.83180.77380.3829
526.97.34956.13268.56650.23450.88630.59520.4043
537.77.34725.8958.79930.3170.72690.52540.4183
5487.34655.69069.00240.21960.33780.61480.4279
5587.34635.50879.18390.24280.24280.720.4349
567.77.34635.34339.34920.36460.26120.82280.4402
577.37.34625.19059.5020.48320.37390.87140.4444
587.47.34625.04799.64460.48170.51570.76470.4478
598.17.34624.91369.77890.27180.48270.38780.4507
608.37.34624.78639.90610.23260.28190.33580.4531
618.27.34624.665110.02740.26630.24280.45530.4553







Univariate ARIMA Extrapolation Forecast Performance
time% S.E.PEMAPESq.EMSERMSE
500.0398-0.066200.239100
510.0648-0.1030.08460.57470.40690.6379
520.0845-0.06120.07680.20210.33860.5819
530.10080.0480.06960.12450.28510.5339
540.1150.0890.07350.42710.31350.5599
550.12760.0890.07610.42730.33250.5766
560.13910.04820.07210.12510.30280.5503
570.1497-0.00630.06380.00210.26520.515
580.15960.00730.05760.00290.23610.4859
590.16890.10260.06210.56820.26930.5189
600.17780.12980.06820.90970.32750.5723
610.18620.11620.07220.72890.3610.6008

\begin{tabular}{lllllllll}
\hline
Univariate ARIMA Extrapolation Forecast Performance \tabularnewline
time & % S.E. & PE & MAPE & Sq.E & MSE & RMSE \tabularnewline
50 & 0.0398 & -0.0662 & 0 & 0.2391 & 0 & 0 \tabularnewline
51 & 0.0648 & -0.103 & 0.0846 & 0.5747 & 0.4069 & 0.6379 \tabularnewline
52 & 0.0845 & -0.0612 & 0.0768 & 0.2021 & 0.3386 & 0.5819 \tabularnewline
53 & 0.1008 & 0.048 & 0.0696 & 0.1245 & 0.2851 & 0.5339 \tabularnewline
54 & 0.115 & 0.089 & 0.0735 & 0.4271 & 0.3135 & 0.5599 \tabularnewline
55 & 0.1276 & 0.089 & 0.0761 & 0.4273 & 0.3325 & 0.5766 \tabularnewline
56 & 0.1391 & 0.0482 & 0.0721 & 0.1251 & 0.3028 & 0.5503 \tabularnewline
57 & 0.1497 & -0.0063 & 0.0638 & 0.0021 & 0.2652 & 0.515 \tabularnewline
58 & 0.1596 & 0.0073 & 0.0576 & 0.0029 & 0.2361 & 0.4859 \tabularnewline
59 & 0.1689 & 0.1026 & 0.0621 & 0.5682 & 0.2693 & 0.5189 \tabularnewline
60 & 0.1778 & 0.1298 & 0.0682 & 0.9097 & 0.3275 & 0.5723 \tabularnewline
61 & 0.1862 & 0.1162 & 0.0722 & 0.7289 & 0.361 & 0.6008 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=65598&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]50[/C][C]0.0398[/C][C]-0.0662[/C][C]0[/C][C]0.2391[/C][C]0[/C][C]0[/C][/ROW]
[ROW][C]51[/C][C]0.0648[/C][C]-0.103[/C][C]0.0846[/C][C]0.5747[/C][C]0.4069[/C][C]0.6379[/C][/ROW]
[ROW][C]52[/C][C]0.0845[/C][C]-0.0612[/C][C]0.0768[/C][C]0.2021[/C][C]0.3386[/C][C]0.5819[/C][/ROW]
[ROW][C]53[/C][C]0.1008[/C][C]0.048[/C][C]0.0696[/C][C]0.1245[/C][C]0.2851[/C][C]0.5339[/C][/ROW]
[ROW][C]54[/C][C]0.115[/C][C]0.089[/C][C]0.0735[/C][C]0.4271[/C][C]0.3135[/C][C]0.5599[/C][/ROW]
[ROW][C]55[/C][C]0.1276[/C][C]0.089[/C][C]0.0761[/C][C]0.4273[/C][C]0.3325[/C][C]0.5766[/C][/ROW]
[ROW][C]56[/C][C]0.1391[/C][C]0.0482[/C][C]0.0721[/C][C]0.1251[/C][C]0.3028[/C][C]0.5503[/C][/ROW]
[ROW][C]57[/C][C]0.1497[/C][C]-0.0063[/C][C]0.0638[/C][C]0.0021[/C][C]0.2652[/C][C]0.515[/C][/ROW]
[ROW][C]58[/C][C]0.1596[/C][C]0.0073[/C][C]0.0576[/C][C]0.0029[/C][C]0.2361[/C][C]0.4859[/C][/ROW]
[ROW][C]59[/C][C]0.1689[/C][C]0.1026[/C][C]0.0621[/C][C]0.5682[/C][C]0.2693[/C][C]0.5189[/C][/ROW]
[ROW][C]60[/C][C]0.1778[/C][C]0.1298[/C][C]0.0682[/C][C]0.9097[/C][C]0.3275[/C][C]0.5723[/C][/ROW]
[ROW][C]61[/C][C]0.1862[/C][C]0.1162[/C][C]0.0722[/C][C]0.7289[/C][C]0.361[/C][C]0.6008[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=65598&T=2

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=65598&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
500.0398-0.066200.239100
510.0648-0.1030.08460.57470.40690.6379
520.0845-0.06120.07680.20210.33860.5819
530.10080.0480.06960.12450.28510.5339
540.1150.0890.07350.42710.31350.5599
550.12760.0890.07610.42730.33250.5766
560.13910.04820.07210.12510.30280.5503
570.1497-0.00630.06380.00210.26520.515
580.15960.00730.05760.00290.23610.4859
590.16890.10260.06210.56820.26930.5189
600.17780.12980.06820.90970.32750.5723
610.18620.11620.07220.72890.3610.6008



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,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')