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, 16 Dec 2011 12:16:12 -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/2011/Dec/16/t1324057671o71gj99kgu5t7yl.htm/, Retrieved Sun, 05 May 2024 18:28:01 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=156091, Retrieved Sun, 05 May 2024 18:28:01 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact141
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]
-    D      [ARIMA Forecasting] [WS 9 Forecasting ...] [2010-12-03 22:01:04] [8081b8996d5947580de3eb171e82db4f]
-   PD        [ARIMA Forecasting] [Workshop 9, Forecast] [2010-12-05 20:21:31] [3635fb7041b1998c5a1332cf9de22bce]
-   P           [ARIMA Forecasting] [ARIMA Extrapolati...] [2010-12-06 22:58:10] [3635fb7041b1998c5a1332cf9de22bce]
-   P             [ARIMA Forecasting] [Verbetering WS9] [2010-12-14 19:20:19] [3635fb7041b1998c5a1332cf9de22bce]
-   PD              [ARIMA Forecasting] [Paper Forecast] [2010-12-19 18:06:55] [3635fb7041b1998c5a1332cf9de22bce]
-   PD                [ARIMA Forecasting] [Paper Forecast 2] [2010-12-19 21:47:07] [3635fb7041b1998c5a1332cf9de22bce]
- R PD                    [ARIMA Forecasting] [ARIMA forecasting] [2011-12-16 17:16:12] [274a40ad31da88f12aea425a159a1f93] [Current]
Feedback Forum

Post a new message
Dataseries X:
9911.00
8915.00
9452.00
9112.00
8472.00
8230.00
8384.00
8625.00
8221.00
8649.00
8625.00
10443.00
10357.00
8586.00
8892.00
8329.00
8101.00
7922.00
8120.00
7838.00
7735.00
8406.00
8209.00
9451.00
10041.00
9411.00
10405.00
8467.00
8464.00
8102.00
7627.00
7513.00
7510.00
8291.00
8064.00
9383.00
9706.00
8579.00
9474.00
8318.00
8213.00
8059.00
9111.00
7708.00
7680.00
8014.00
8007.00
8718.00
9486.00
9113.00
9025.00
8476.00
7952.00
7759.00
7835.00
7600.00
7651.00
8319.00
8812.00
8630.00




Summary of computational transaction
Raw Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time2 seconds
R Server'AstonUniversity' @ aston.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 & 2 seconds \tabularnewline
R Server & 'AstonUniversity' @ aston.wessa.net \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=156091&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]2 seconds[/C][/ROW]
[ROW][C]R Server[/C][C]'AstonUniversity' @ aston.wessa.net[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=156091&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=156091&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 time2 seconds
R Server'AstonUniversity' @ aston.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[48])
369383-------
379706-------
388579-------
399474-------
408318-------
418213-------
428059-------
439111-------
447708-------
457680-------
468014-------
478007-------
488718-------
4994869581.68228691.61610471.74840.41660.97140.39210.9714
5091138964.87588008.77349920.97820.38070.14270.78550.6936
5190259905.79148949.68910861.89380.03550.94790.8120.9926
5284768387.10527431.00289343.20760.42770.09550.55630.2488
5379528329.41217373.30979285.51450.21960.38190.59430.2128
5477598078.94317122.84079035.04550.2560.60270.51630.0951
5578358422.73117466.62879378.83350.11410.91320.07910.2725
5676007617.56036661.45798573.66280.48560.32790.42650.012
5776517601.15526645.05288557.25760.45930.50090.43580.011
5883198142.47077186.36839098.57310.35870.84320.60390.119
5988128033.43627077.33388989.53860.05520.27910.52160.0803
6086309026.42248070.329982.52480.20820.66990.73640.7364

\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 & 9383 & - & - & - & - & - & - & - \tabularnewline
37 & 9706 & - & - & - & - & - & - & - \tabularnewline
38 & 8579 & - & - & - & - & - & - & - \tabularnewline
39 & 9474 & - & - & - & - & - & - & - \tabularnewline
40 & 8318 & - & - & - & - & - & - & - \tabularnewline
41 & 8213 & - & - & - & - & - & - & - \tabularnewline
42 & 8059 & - & - & - & - & - & - & - \tabularnewline
43 & 9111 & - & - & - & - & - & - & - \tabularnewline
44 & 7708 & - & - & - & - & - & - & - \tabularnewline
45 & 7680 & - & - & - & - & - & - & - \tabularnewline
46 & 8014 & - & - & - & - & - & - & - \tabularnewline
47 & 8007 & - & - & - & - & - & - & - \tabularnewline
48 & 8718 & - & - & - & - & - & - & - \tabularnewline
49 & 9486 & 9581.6822 & 8691.616 & 10471.7484 & 0.4166 & 0.9714 & 0.3921 & 0.9714 \tabularnewline
50 & 9113 & 8964.8758 & 8008.7734 & 9920.9782 & 0.3807 & 0.1427 & 0.7855 & 0.6936 \tabularnewline
51 & 9025 & 9905.7914 & 8949.689 & 10861.8938 & 0.0355 & 0.9479 & 0.812 & 0.9926 \tabularnewline
52 & 8476 & 8387.1052 & 7431.0028 & 9343.2076 & 0.4277 & 0.0955 & 0.5563 & 0.2488 \tabularnewline
53 & 7952 & 8329.4121 & 7373.3097 & 9285.5145 & 0.2196 & 0.3819 & 0.5943 & 0.2128 \tabularnewline
54 & 7759 & 8078.9431 & 7122.8407 & 9035.0455 & 0.256 & 0.6027 & 0.5163 & 0.0951 \tabularnewline
55 & 7835 & 8422.7311 & 7466.6287 & 9378.8335 & 0.1141 & 0.9132 & 0.0791 & 0.2725 \tabularnewline
56 & 7600 & 7617.5603 & 6661.4579 & 8573.6628 & 0.4856 & 0.3279 & 0.4265 & 0.012 \tabularnewline
57 & 7651 & 7601.1552 & 6645.0528 & 8557.2576 & 0.4593 & 0.5009 & 0.4358 & 0.011 \tabularnewline
58 & 8319 & 8142.4707 & 7186.3683 & 9098.5731 & 0.3587 & 0.8432 & 0.6039 & 0.119 \tabularnewline
59 & 8812 & 8033.4362 & 7077.3338 & 8989.5386 & 0.0552 & 0.2791 & 0.5216 & 0.0803 \tabularnewline
60 & 8630 & 9026.4224 & 8070.32 & 9982.5248 & 0.2082 & 0.6699 & 0.7364 & 0.7364 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=156091&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]9383[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]37[/C][C]9706[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]38[/C][C]8579[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]39[/C][C]9474[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]40[/C][C]8318[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]41[/C][C]8213[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]42[/C][C]8059[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]43[/C][C]9111[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]44[/C][C]7708[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]45[/C][C]7680[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]46[/C][C]8014[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]47[/C][C]8007[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]48[/C][C]8718[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]49[/C][C]9486[/C][C]9581.6822[/C][C]8691.616[/C][C]10471.7484[/C][C]0.4166[/C][C]0.9714[/C][C]0.3921[/C][C]0.9714[/C][/ROW]
[ROW][C]50[/C][C]9113[/C][C]8964.8758[/C][C]8008.7734[/C][C]9920.9782[/C][C]0.3807[/C][C]0.1427[/C][C]0.7855[/C][C]0.6936[/C][/ROW]
[ROW][C]51[/C][C]9025[/C][C]9905.7914[/C][C]8949.689[/C][C]10861.8938[/C][C]0.0355[/C][C]0.9479[/C][C]0.812[/C][C]0.9926[/C][/ROW]
[ROW][C]52[/C][C]8476[/C][C]8387.1052[/C][C]7431.0028[/C][C]9343.2076[/C][C]0.4277[/C][C]0.0955[/C][C]0.5563[/C][C]0.2488[/C][/ROW]
[ROW][C]53[/C][C]7952[/C][C]8329.4121[/C][C]7373.3097[/C][C]9285.5145[/C][C]0.2196[/C][C]0.3819[/C][C]0.5943[/C][C]0.2128[/C][/ROW]
[ROW][C]54[/C][C]7759[/C][C]8078.9431[/C][C]7122.8407[/C][C]9035.0455[/C][C]0.256[/C][C]0.6027[/C][C]0.5163[/C][C]0.0951[/C][/ROW]
[ROW][C]55[/C][C]7835[/C][C]8422.7311[/C][C]7466.6287[/C][C]9378.8335[/C][C]0.1141[/C][C]0.9132[/C][C]0.0791[/C][C]0.2725[/C][/ROW]
[ROW][C]56[/C][C]7600[/C][C]7617.5603[/C][C]6661.4579[/C][C]8573.6628[/C][C]0.4856[/C][C]0.3279[/C][C]0.4265[/C][C]0.012[/C][/ROW]
[ROW][C]57[/C][C]7651[/C][C]7601.1552[/C][C]6645.0528[/C][C]8557.2576[/C][C]0.4593[/C][C]0.5009[/C][C]0.4358[/C][C]0.011[/C][/ROW]
[ROW][C]58[/C][C]8319[/C][C]8142.4707[/C][C]7186.3683[/C][C]9098.5731[/C][C]0.3587[/C][C]0.8432[/C][C]0.6039[/C][C]0.119[/C][/ROW]
[ROW][C]59[/C][C]8812[/C][C]8033.4362[/C][C]7077.3338[/C][C]8989.5386[/C][C]0.0552[/C][C]0.2791[/C][C]0.5216[/C][C]0.0803[/C][/ROW]
[ROW][C]60[/C][C]8630[/C][C]9026.4224[/C][C]8070.32[/C][C]9982.5248[/C][C]0.2082[/C][C]0.6699[/C][C]0.7364[/C][C]0.7364[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=156091&T=1

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=156091&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])
369383-------
379706-------
388579-------
399474-------
408318-------
418213-------
428059-------
439111-------
447708-------
457680-------
468014-------
478007-------
488718-------
4994869581.68228691.61610471.74840.41660.97140.39210.9714
5091138964.87588008.77349920.97820.38070.14270.78550.6936
5190259905.79148949.68910861.89380.03550.94790.8120.9926
5284768387.10527431.00289343.20760.42770.09550.55630.2488
5379528329.41217373.30979285.51450.21960.38190.59430.2128
5477598078.94317122.84079035.04550.2560.60270.51630.0951
5578358422.73117466.62879378.83350.11410.91320.07910.2725
5676007617.56036661.45798573.66280.48560.32790.42650.012
5776517601.15526645.05288557.25760.45930.50090.43580.011
5883198142.47077186.36839098.57310.35870.84320.60390.119
5988128033.43627077.33388989.53860.05520.27910.52160.0803
6086309026.42248070.329982.52480.20820.66990.73640.7364







Univariate ARIMA Extrapolation Forecast Performance
time% S.E.PEMAPESq.EMSERMSE
490.0474-0.0109155.081100
500.05440.01650.013321940.765815547.9235124.6913
510.0492-0.08890.0385775793.4167268963.0879518.6165
520.05820.01060.03157902.291203697.8886451.329
530.0586-0.04530.0343142439.8655191446.284437.5458
540.0604-0.03960.0352102363.5888176599.1682420.237
550.0579-0.06980.0401345427.8084200717.5453448.0151
560.064-0.00230.0354308.3659175666.3979419.1258
570.06420.00660.03222484.5065156423.9655395.5047
580.05990.02170.031131162.5996143897.8289379.3387
590.06070.09690.0371606161.5819185921.8065431.1865
600.054-0.04390.0377157150.7182183524.2158428.3973

\begin{tabular}{lllllllll}
\hline
Univariate ARIMA Extrapolation Forecast Performance \tabularnewline
time & % S.E. & PE & MAPE & Sq.E & MSE & RMSE \tabularnewline
49 & 0.0474 & -0.01 & 0 & 9155.0811 & 0 & 0 \tabularnewline
50 & 0.0544 & 0.0165 & 0.0133 & 21940.7658 & 15547.9235 & 124.6913 \tabularnewline
51 & 0.0492 & -0.0889 & 0.0385 & 775793.4167 & 268963.0879 & 518.6165 \tabularnewline
52 & 0.0582 & 0.0106 & 0.0315 & 7902.291 & 203697.8886 & 451.329 \tabularnewline
53 & 0.0586 & -0.0453 & 0.0343 & 142439.8655 & 191446.284 & 437.5458 \tabularnewline
54 & 0.0604 & -0.0396 & 0.0352 & 102363.5888 & 176599.1682 & 420.237 \tabularnewline
55 & 0.0579 & -0.0698 & 0.0401 & 345427.8084 & 200717.5453 & 448.0151 \tabularnewline
56 & 0.064 & -0.0023 & 0.0354 & 308.3659 & 175666.3979 & 419.1258 \tabularnewline
57 & 0.0642 & 0.0066 & 0.0322 & 2484.5065 & 156423.9655 & 395.5047 \tabularnewline
58 & 0.0599 & 0.0217 & 0.0311 & 31162.5996 & 143897.8289 & 379.3387 \tabularnewline
59 & 0.0607 & 0.0969 & 0.0371 & 606161.5819 & 185921.8065 & 431.1865 \tabularnewline
60 & 0.054 & -0.0439 & 0.0377 & 157150.7182 & 183524.2158 & 428.3973 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=156091&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.0474[/C][C]-0.01[/C][C]0[/C][C]9155.0811[/C][C]0[/C][C]0[/C][/ROW]
[ROW][C]50[/C][C]0.0544[/C][C]0.0165[/C][C]0.0133[/C][C]21940.7658[/C][C]15547.9235[/C][C]124.6913[/C][/ROW]
[ROW][C]51[/C][C]0.0492[/C][C]-0.0889[/C][C]0.0385[/C][C]775793.4167[/C][C]268963.0879[/C][C]518.6165[/C][/ROW]
[ROW][C]52[/C][C]0.0582[/C][C]0.0106[/C][C]0.0315[/C][C]7902.291[/C][C]203697.8886[/C][C]451.329[/C][/ROW]
[ROW][C]53[/C][C]0.0586[/C][C]-0.0453[/C][C]0.0343[/C][C]142439.8655[/C][C]191446.284[/C][C]437.5458[/C][/ROW]
[ROW][C]54[/C][C]0.0604[/C][C]-0.0396[/C][C]0.0352[/C][C]102363.5888[/C][C]176599.1682[/C][C]420.237[/C][/ROW]
[ROW][C]55[/C][C]0.0579[/C][C]-0.0698[/C][C]0.0401[/C][C]345427.8084[/C][C]200717.5453[/C][C]448.0151[/C][/ROW]
[ROW][C]56[/C][C]0.064[/C][C]-0.0023[/C][C]0.0354[/C][C]308.3659[/C][C]175666.3979[/C][C]419.1258[/C][/ROW]
[ROW][C]57[/C][C]0.0642[/C][C]0.0066[/C][C]0.0322[/C][C]2484.5065[/C][C]156423.9655[/C][C]395.5047[/C][/ROW]
[ROW][C]58[/C][C]0.0599[/C][C]0.0217[/C][C]0.0311[/C][C]31162.5996[/C][C]143897.8289[/C][C]379.3387[/C][/ROW]
[ROW][C]59[/C][C]0.0607[/C][C]0.0969[/C][C]0.0371[/C][C]606161.5819[/C][C]185921.8065[/C][C]431.1865[/C][/ROW]
[ROW][C]60[/C][C]0.054[/C][C]-0.0439[/C][C]0.0377[/C][C]157150.7182[/C][C]183524.2158[/C][C]428.3973[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=156091&T=2

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=156091&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.0474-0.0109155.081100
500.05440.01650.013321940.765815547.9235124.6913
510.0492-0.08890.0385775793.4167268963.0879518.6165
520.05820.01060.03157902.291203697.8886451.329
530.0586-0.04530.0343142439.8655191446.284437.5458
540.0604-0.03960.0352102363.5888176599.1682420.237
550.0579-0.06980.0401345427.8084200717.5453448.0151
560.064-0.00230.0354308.3659175666.3979419.1258
570.06420.00660.03222484.5065156423.9655395.5047
580.05990.02170.031131162.5996143897.8289379.3387
590.06070.09690.0371606161.5819185921.8065431.1865
600.054-0.04390.0377157150.7182183524.2158428.3973



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