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 computationSat, 10 Dec 2011 09:43:17 -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/10/t13235282418ucxn6v5gfsg91o.htm/, Retrieved Sun, 05 May 2024 06:36:28 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=153562, Retrieved Sun, 05 May 2024 06:36:28 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact147
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]
- R P               [ARIMA Forecasting] [] [2011-12-02 16:20:33] [b1eb71d4db1ceb5d347df987feb4a25e]
- R PD                  [ARIMA Forecasting] [] [2011-12-10 14:43:17] [a1e1d0bae7c18896aaea36b6ddc51406] [Current]
Feedback Forum

Post a new message
Dataseries X:
12008,00
9169,00
8788,00
8417,00
8247,00
8197,00
8236,00
8253,00
7733,00
8366,00
8626,00
8863,00
10102,00
8463,00
9114,00
8563,00
8872,00
8301,00
8301,00
8278,00
7736,00
7973,00
8268,00
9476,00
11100,00
8962,00
9173,00
8738,00
8459,00
8078,00
8411,00
8291,00
7810,00
8616,00
8312,00
9692,00
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'Gertrude Mary Cox' @ cox.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 & 'Gertrude Mary Cox' @ cox.wessa.net \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=153562&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]'Gertrude Mary Cox' @ cox.wessa.net[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=153562&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=153562&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'Gertrude Mary Cox' @ cox.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[84])
729383-------
739706-------
748579-------
759474-------
768318-------
778213-------
788059-------
799111-------
807708-------
817680-------
828014-------
838007-------
848718-------
8594869544.16798744.018710344.31710.44330.97850.34590.9785
8691138973.32948102.7939843.86580.37660.12420.81270.7173
87902510074.50749188.012110961.00270.01020.98320.90790.9986
8884768419.23577528.97729309.49410.45030.09120.58820.2553
8979528385.54587494.39249276.69920.17020.42120.64780.2323
9077598111.19157219.82489002.55820.21930.63680.54570.0911
9178358322.14327430.72579213.56070.14210.89220.04140.192
9276007614.19366722.7648505.62330.48760.31370.41830.0076
9376517598.01296706.58048489.44540.45360.49830.42850.0069
9483198145.22687253.79369036.660.35120.86140.61350.104
9588128042.25617150.82278933.68940.04530.27140.53090.0687
9686309101.76948210.33619993.20260.14980.7380.80060.8006

\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[84]) \tabularnewline
72 & 9383 & - & - & - & - & - & - & - \tabularnewline
73 & 9706 & - & - & - & - & - & - & - \tabularnewline
74 & 8579 & - & - & - & - & - & - & - \tabularnewline
75 & 9474 & - & - & - & - & - & - & - \tabularnewline
76 & 8318 & - & - & - & - & - & - & - \tabularnewline
77 & 8213 & - & - & - & - & - & - & - \tabularnewline
78 & 8059 & - & - & - & - & - & - & - \tabularnewline
79 & 9111 & - & - & - & - & - & - & - \tabularnewline
80 & 7708 & - & - & - & - & - & - & - \tabularnewline
81 & 7680 & - & - & - & - & - & - & - \tabularnewline
82 & 8014 & - & - & - & - & - & - & - \tabularnewline
83 & 8007 & - & - & - & - & - & - & - \tabularnewline
84 & 8718 & - & - & - & - & - & - & - \tabularnewline
85 & 9486 & 9544.1679 & 8744.0187 & 10344.3171 & 0.4433 & 0.9785 & 0.3459 & 0.9785 \tabularnewline
86 & 9113 & 8973.3294 & 8102.793 & 9843.8658 & 0.3766 & 0.1242 & 0.8127 & 0.7173 \tabularnewline
87 & 9025 & 10074.5074 & 9188.0121 & 10961.0027 & 0.0102 & 0.9832 & 0.9079 & 0.9986 \tabularnewline
88 & 8476 & 8419.2357 & 7528.9772 & 9309.4941 & 0.4503 & 0.0912 & 0.5882 & 0.2553 \tabularnewline
89 & 7952 & 8385.5458 & 7494.3924 & 9276.6992 & 0.1702 & 0.4212 & 0.6478 & 0.2323 \tabularnewline
90 & 7759 & 8111.1915 & 7219.8248 & 9002.5582 & 0.2193 & 0.6368 & 0.5457 & 0.0911 \tabularnewline
91 & 7835 & 8322.1432 & 7430.7257 & 9213.5607 & 0.1421 & 0.8922 & 0.0414 & 0.192 \tabularnewline
92 & 7600 & 7614.1936 & 6722.764 & 8505.6233 & 0.4876 & 0.3137 & 0.4183 & 0.0076 \tabularnewline
93 & 7651 & 7598.0129 & 6706.5804 & 8489.4454 & 0.4536 & 0.4983 & 0.4285 & 0.0069 \tabularnewline
94 & 8319 & 8145.2268 & 7253.7936 & 9036.66 & 0.3512 & 0.8614 & 0.6135 & 0.104 \tabularnewline
95 & 8812 & 8042.2561 & 7150.8227 & 8933.6894 & 0.0453 & 0.2714 & 0.5309 & 0.0687 \tabularnewline
96 & 8630 & 9101.7694 & 8210.3361 & 9993.2026 & 0.1498 & 0.738 & 0.8006 & 0.8006 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=153562&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[84])[/C][/ROW]
[ROW][C]72[/C][C]9383[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]73[/C][C]9706[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]74[/C][C]8579[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]75[/C][C]9474[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]76[/C][C]8318[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]77[/C][C]8213[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]78[/C][C]8059[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]79[/C][C]9111[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]80[/C][C]7708[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]81[/C][C]7680[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]82[/C][C]8014[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]83[/C][C]8007[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]84[/C][C]8718[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]85[/C][C]9486[/C][C]9544.1679[/C][C]8744.0187[/C][C]10344.3171[/C][C]0.4433[/C][C]0.9785[/C][C]0.3459[/C][C]0.9785[/C][/ROW]
[ROW][C]86[/C][C]9113[/C][C]8973.3294[/C][C]8102.793[/C][C]9843.8658[/C][C]0.3766[/C][C]0.1242[/C][C]0.8127[/C][C]0.7173[/C][/ROW]
[ROW][C]87[/C][C]9025[/C][C]10074.5074[/C][C]9188.0121[/C][C]10961.0027[/C][C]0.0102[/C][C]0.9832[/C][C]0.9079[/C][C]0.9986[/C][/ROW]
[ROW][C]88[/C][C]8476[/C][C]8419.2357[/C][C]7528.9772[/C][C]9309.4941[/C][C]0.4503[/C][C]0.0912[/C][C]0.5882[/C][C]0.2553[/C][/ROW]
[ROW][C]89[/C][C]7952[/C][C]8385.5458[/C][C]7494.3924[/C][C]9276.6992[/C][C]0.1702[/C][C]0.4212[/C][C]0.6478[/C][C]0.2323[/C][/ROW]
[ROW][C]90[/C][C]7759[/C][C]8111.1915[/C][C]7219.8248[/C][C]9002.5582[/C][C]0.2193[/C][C]0.6368[/C][C]0.5457[/C][C]0.0911[/C][/ROW]
[ROW][C]91[/C][C]7835[/C][C]8322.1432[/C][C]7430.7257[/C][C]9213.5607[/C][C]0.1421[/C][C]0.8922[/C][C]0.0414[/C][C]0.192[/C][/ROW]
[ROW][C]92[/C][C]7600[/C][C]7614.1936[/C][C]6722.764[/C][C]8505.6233[/C][C]0.4876[/C][C]0.3137[/C][C]0.4183[/C][C]0.0076[/C][/ROW]
[ROW][C]93[/C][C]7651[/C][C]7598.0129[/C][C]6706.5804[/C][C]8489.4454[/C][C]0.4536[/C][C]0.4983[/C][C]0.4285[/C][C]0.0069[/C][/ROW]
[ROW][C]94[/C][C]8319[/C][C]8145.2268[/C][C]7253.7936[/C][C]9036.66[/C][C]0.3512[/C][C]0.8614[/C][C]0.6135[/C][C]0.104[/C][/ROW]
[ROW][C]95[/C][C]8812[/C][C]8042.2561[/C][C]7150.8227[/C][C]8933.6894[/C][C]0.0453[/C][C]0.2714[/C][C]0.5309[/C][C]0.0687[/C][/ROW]
[ROW][C]96[/C][C]8630[/C][C]9101.7694[/C][C]8210.3361[/C][C]9993.2026[/C][C]0.1498[/C][C]0.738[/C][C]0.8006[/C][C]0.8006[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=153562&T=1

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=153562&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[84])
729383-------
739706-------
748579-------
759474-------
768318-------
778213-------
788059-------
799111-------
807708-------
817680-------
828014-------
838007-------
848718-------
8594869544.16798744.018710344.31710.44330.97850.34590.9785
8691138973.32948102.7939843.86580.37660.12420.81270.7173
87902510074.50749188.012110961.00270.01020.98320.90790.9986
8884768419.23577528.97729309.49410.45030.09120.58820.2553
8979528385.54587494.39249276.69920.17020.42120.64780.2323
9077598111.19157219.82489002.55820.21930.63680.54570.0911
9178358322.14327430.72579213.56070.14210.89220.04140.192
9276007614.19366722.7648505.62330.48760.31370.41830.0076
9376517598.01296706.58048489.44540.45360.49830.42850.0069
9483198145.22687253.79369036.660.35120.86140.61350.104
9588128042.25617150.82278933.68940.04530.27140.53090.0687
9686309101.76948210.33619993.20260.14980.7380.80060.8006







Univariate ARIMA Extrapolation Forecast Performance
time% S.E.PEMAPESq.EMSERMSE
850.0428-0.006103383.500800
860.04950.01560.010819507.870611445.6857106.9845
870.0449-0.10420.04191101465.826374785.7325612.1975
880.05390.00670.03313222.1906281894.847530.9377
890.0542-0.05170.0369187961.9872263108.2751512.9408
900.0561-0.04340.0379124038.848239930.0372489.8265
910.0546-0.05850.0409237308.501239555.532489.4441
920.0597-0.00190.036201.4595209636.273457.8605
930.05990.0070.03282807.6312186655.3128432.0362
940.05580.02130.031630197.1121171009.4927413.5329
950.05660.09570.0375592505.7453209327.3338457.523
960.05-0.05180.0387222566.3215210430.5828458.7271

\begin{tabular}{lllllllll}
\hline
Univariate ARIMA Extrapolation Forecast Performance \tabularnewline
time & % S.E. & PE & MAPE & Sq.E & MSE & RMSE \tabularnewline
85 & 0.0428 & -0.0061 & 0 & 3383.5008 & 0 & 0 \tabularnewline
86 & 0.0495 & 0.0156 & 0.0108 & 19507.8706 & 11445.6857 & 106.9845 \tabularnewline
87 & 0.0449 & -0.1042 & 0.0419 & 1101465.826 & 374785.7325 & 612.1975 \tabularnewline
88 & 0.0539 & 0.0067 & 0.0331 & 3222.1906 & 281894.847 & 530.9377 \tabularnewline
89 & 0.0542 & -0.0517 & 0.0369 & 187961.9872 & 263108.2751 & 512.9408 \tabularnewline
90 & 0.0561 & -0.0434 & 0.0379 & 124038.848 & 239930.0372 & 489.8265 \tabularnewline
91 & 0.0546 & -0.0585 & 0.0409 & 237308.501 & 239555.532 & 489.4441 \tabularnewline
92 & 0.0597 & -0.0019 & 0.036 & 201.4595 & 209636.273 & 457.8605 \tabularnewline
93 & 0.0599 & 0.007 & 0.0328 & 2807.6312 & 186655.3128 & 432.0362 \tabularnewline
94 & 0.0558 & 0.0213 & 0.0316 & 30197.1121 & 171009.4927 & 413.5329 \tabularnewline
95 & 0.0566 & 0.0957 & 0.0375 & 592505.7453 & 209327.3338 & 457.523 \tabularnewline
96 & 0.05 & -0.0518 & 0.0387 & 222566.3215 & 210430.5828 & 458.7271 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=153562&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]85[/C][C]0.0428[/C][C]-0.0061[/C][C]0[/C][C]3383.5008[/C][C]0[/C][C]0[/C][/ROW]
[ROW][C]86[/C][C]0.0495[/C][C]0.0156[/C][C]0.0108[/C][C]19507.8706[/C][C]11445.6857[/C][C]106.9845[/C][/ROW]
[ROW][C]87[/C][C]0.0449[/C][C]-0.1042[/C][C]0.0419[/C][C]1101465.826[/C][C]374785.7325[/C][C]612.1975[/C][/ROW]
[ROW][C]88[/C][C]0.0539[/C][C]0.0067[/C][C]0.0331[/C][C]3222.1906[/C][C]281894.847[/C][C]530.9377[/C][/ROW]
[ROW][C]89[/C][C]0.0542[/C][C]-0.0517[/C][C]0.0369[/C][C]187961.9872[/C][C]263108.2751[/C][C]512.9408[/C][/ROW]
[ROW][C]90[/C][C]0.0561[/C][C]-0.0434[/C][C]0.0379[/C][C]124038.848[/C][C]239930.0372[/C][C]489.8265[/C][/ROW]
[ROW][C]91[/C][C]0.0546[/C][C]-0.0585[/C][C]0.0409[/C][C]237308.501[/C][C]239555.532[/C][C]489.4441[/C][/ROW]
[ROW][C]92[/C][C]0.0597[/C][C]-0.0019[/C][C]0.036[/C][C]201.4595[/C][C]209636.273[/C][C]457.8605[/C][/ROW]
[ROW][C]93[/C][C]0.0599[/C][C]0.007[/C][C]0.0328[/C][C]2807.6312[/C][C]186655.3128[/C][C]432.0362[/C][/ROW]
[ROW][C]94[/C][C]0.0558[/C][C]0.0213[/C][C]0.0316[/C][C]30197.1121[/C][C]171009.4927[/C][C]413.5329[/C][/ROW]
[ROW][C]95[/C][C]0.0566[/C][C]0.0957[/C][C]0.0375[/C][C]592505.7453[/C][C]209327.3338[/C][C]457.523[/C][/ROW]
[ROW][C]96[/C][C]0.05[/C][C]-0.0518[/C][C]0.0387[/C][C]222566.3215[/C][C]210430.5828[/C][C]458.7271[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=153562&T=2

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=153562&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
850.0428-0.006103383.500800
860.04950.01560.010819507.870611445.6857106.9845
870.0449-0.10420.04191101465.826374785.7325612.1975
880.05390.00670.03313222.1906281894.847530.9377
890.0542-0.05170.0369187961.9872263108.2751512.9408
900.0561-0.04340.0379124038.848239930.0372489.8265
910.0546-0.05850.0409237308.501239555.532489.4441
920.0597-0.00190.036201.4595209636.273457.8605
930.05990.0070.03282807.6312186655.3128432.0362
940.05580.02130.031630197.1121171009.4927413.5329
950.05660.09570.0375592505.7453209327.3338457.523
960.05-0.05180.0387222566.3215210430.5828458.7271



Parameters (Session):
par1 = FALSE ; par2 = 1 ; par3 = 0 ; 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 = 1 ; par7 = 1 ; par8 = 2 ; par9 = 1 ; 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')