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 computationTue, 21 Dec 2010 19:37:30 +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/21/t1292960214znnwkg57arr0tv6.htm/, Retrieved Sun, 19 May 2024 18:22:56 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=113887, Retrieved Sun, 19 May 2024 18:22:56 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact154
Family? (F = Feedback message, R = changed R code, M = changed R Module, P = changed Parameters, D = changed Data)
-     [Standard Deviation-Mean Plot] [SMP prof bach] [2008-12-15 22:25:20] [bc937651ef42bf891200cf0e0edc7238]
- RM    [Variance Reduction Matrix] [VRM prof bach] [2008-12-15 22:31:00] [bc937651ef42bf891200cf0e0edc7238]
- RMP     [(Partial) Autocorrelation Function] [ARIMA Prof bach A...] [2008-12-15 22:38:57] [bc937651ef42bf891200cf0e0edc7238]
- RMP       [ARIMA Backward Selection] [Arima backward se...] [2008-12-19 17:26:16] [bc937651ef42bf891200cf0e0edc7238]
- RMP         [ARIMA Forecasting] [ARIMA forecast pr...] [2008-12-20 11:34:44] [bc937651ef42bf891200cf0e0edc7238]
-  MPD            [ARIMA Forecasting] [] [2010-12-21 19:37:30] [d1991ab4912b5ede0ff54c26afa5d84c] [Current]
-    D              [ARIMA Forecasting] [] [2010-12-22 16:40:18] [94f4aa1c01e87d8321fffb341ed4df07]
Feedback Forum

Post a new message
Dataseries X:
2981,85
3080,58
3106,22
3119,31
3061,26
3097,31
3161,69
3257,16
3277,01
3295,32
3363,99
3494,17
3667,03
3813,06
3917,96
3895,51
3801,06
3570,12
3701,61
3862,27
3970,10
4138,52
4199,75
4290,89
4443,91
4502,64
4356,98
4591,27
4696,96
4621,40
4562,84
4202,52
4296,49
4435,23
4105,18
4116,68
3844,49
3720,98
3674,40
3857,62
3801,06
3504,37
3032,60
3047,03
2962,34
2197,82
2014,45
1862,83
1905,41
1810,99
1670,07
1864,44
2052,02
2029,60
2070,83
2293,41
2443,27
2513,17
2466,92
2502,66
2539,91




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

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=113887&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])
373844.49-------
383720.98-------
393674.4-------
403857.62-------
413801.06-------
423504.37-------
433032.6-------
443047.03-------
452962.34-------
462197.82-------
472014.45-------
481862.83-------
491905.41-------
501810.991917.21581558.1232276.30860.2810.525700.5257
511670.071920.48921337.98352502.99480.19970.643700.5202
521864.441921.39671162.60662680.18690.44150.741900.5165
532052.021921.64841016.26762827.02920.38890.549300.514
542029.61921.7181889.35822954.07810.41890.40230.00130.5124
552070.831921.7375776.13563067.33940.39930.42680.02870.5111
562293.411921.7428673.06253170.42320.27980.40750.03870.5102
572443.271921.7443577.85213265.63660.22340.29390.06460.5095
582513.171921.7447488.94943354.54010.20920.23780.35280.5089
592466.921921.7449405.24823438.24150.24050.22230.45230.5084
602502.661921.7449325.93073517.5590.23780.25160.52880.508
612539.911921.7449250.37313593.11670.23430.24790.50760.5076

\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 & 3844.49 & - & - & - & - & - & - & - \tabularnewline
38 & 3720.98 & - & - & - & - & - & - & - \tabularnewline
39 & 3674.4 & - & - & - & - & - & - & - \tabularnewline
40 & 3857.62 & - & - & - & - & - & - & - \tabularnewline
41 & 3801.06 & - & - & - & - & - & - & - \tabularnewline
42 & 3504.37 & - & - & - & - & - & - & - \tabularnewline
43 & 3032.6 & - & - & - & - & - & - & - \tabularnewline
44 & 3047.03 & - & - & - & - & - & - & - \tabularnewline
45 & 2962.34 & - & - & - & - & - & - & - \tabularnewline
46 & 2197.82 & - & - & - & - & - & - & - \tabularnewline
47 & 2014.45 & - & - & - & - & - & - & - \tabularnewline
48 & 1862.83 & - & - & - & - & - & - & - \tabularnewline
49 & 1905.41 & - & - & - & - & - & - & - \tabularnewline
50 & 1810.99 & 1917.2158 & 1558.123 & 2276.3086 & 0.281 & 0.5257 & 0 & 0.5257 \tabularnewline
51 & 1670.07 & 1920.4892 & 1337.9835 & 2502.9948 & 0.1997 & 0.6437 & 0 & 0.5202 \tabularnewline
52 & 1864.44 & 1921.3967 & 1162.6066 & 2680.1869 & 0.4415 & 0.7419 & 0 & 0.5165 \tabularnewline
53 & 2052.02 & 1921.6484 & 1016.2676 & 2827.0292 & 0.3889 & 0.5493 & 0 & 0.514 \tabularnewline
54 & 2029.6 & 1921.7181 & 889.3582 & 2954.0781 & 0.4189 & 0.4023 & 0.0013 & 0.5124 \tabularnewline
55 & 2070.83 & 1921.7375 & 776.1356 & 3067.3394 & 0.3993 & 0.4268 & 0.0287 & 0.5111 \tabularnewline
56 & 2293.41 & 1921.7428 & 673.0625 & 3170.4232 & 0.2798 & 0.4075 & 0.0387 & 0.5102 \tabularnewline
57 & 2443.27 & 1921.7443 & 577.8521 & 3265.6366 & 0.2234 & 0.2939 & 0.0646 & 0.5095 \tabularnewline
58 & 2513.17 & 1921.7447 & 488.9494 & 3354.5401 & 0.2092 & 0.2378 & 0.3528 & 0.5089 \tabularnewline
59 & 2466.92 & 1921.7449 & 405.2482 & 3438.2415 & 0.2405 & 0.2223 & 0.4523 & 0.5084 \tabularnewline
60 & 2502.66 & 1921.7449 & 325.9307 & 3517.559 & 0.2378 & 0.2516 & 0.5288 & 0.508 \tabularnewline
61 & 2539.91 & 1921.7449 & 250.3731 & 3593.1167 & 0.2343 & 0.2479 & 0.5076 & 0.5076 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=113887&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]3844.49[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]38[/C][C]3720.98[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]39[/C][C]3674.4[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]40[/C][C]3857.62[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]41[/C][C]3801.06[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]42[/C][C]3504.37[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]43[/C][C]3032.6[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]44[/C][C]3047.03[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]45[/C][C]2962.34[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]46[/C][C]2197.82[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]47[/C][C]2014.45[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]48[/C][C]1862.83[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]49[/C][C]1905.41[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]50[/C][C]1810.99[/C][C]1917.2158[/C][C]1558.123[/C][C]2276.3086[/C][C]0.281[/C][C]0.5257[/C][C]0[/C][C]0.5257[/C][/ROW]
[ROW][C]51[/C][C]1670.07[/C][C]1920.4892[/C][C]1337.9835[/C][C]2502.9948[/C][C]0.1997[/C][C]0.6437[/C][C]0[/C][C]0.5202[/C][/ROW]
[ROW][C]52[/C][C]1864.44[/C][C]1921.3967[/C][C]1162.6066[/C][C]2680.1869[/C][C]0.4415[/C][C]0.7419[/C][C]0[/C][C]0.5165[/C][/ROW]
[ROW][C]53[/C][C]2052.02[/C][C]1921.6484[/C][C]1016.2676[/C][C]2827.0292[/C][C]0.3889[/C][C]0.5493[/C][C]0[/C][C]0.514[/C][/ROW]
[ROW][C]54[/C][C]2029.6[/C][C]1921.7181[/C][C]889.3582[/C][C]2954.0781[/C][C]0.4189[/C][C]0.4023[/C][C]0.0013[/C][C]0.5124[/C][/ROW]
[ROW][C]55[/C][C]2070.83[/C][C]1921.7375[/C][C]776.1356[/C][C]3067.3394[/C][C]0.3993[/C][C]0.4268[/C][C]0.0287[/C][C]0.5111[/C][/ROW]
[ROW][C]56[/C][C]2293.41[/C][C]1921.7428[/C][C]673.0625[/C][C]3170.4232[/C][C]0.2798[/C][C]0.4075[/C][C]0.0387[/C][C]0.5102[/C][/ROW]
[ROW][C]57[/C][C]2443.27[/C][C]1921.7443[/C][C]577.8521[/C][C]3265.6366[/C][C]0.2234[/C][C]0.2939[/C][C]0.0646[/C][C]0.5095[/C][/ROW]
[ROW][C]58[/C][C]2513.17[/C][C]1921.7447[/C][C]488.9494[/C][C]3354.5401[/C][C]0.2092[/C][C]0.2378[/C][C]0.3528[/C][C]0.5089[/C][/ROW]
[ROW][C]59[/C][C]2466.92[/C][C]1921.7449[/C][C]405.2482[/C][C]3438.2415[/C][C]0.2405[/C][C]0.2223[/C][C]0.4523[/C][C]0.5084[/C][/ROW]
[ROW][C]60[/C][C]2502.66[/C][C]1921.7449[/C][C]325.9307[/C][C]3517.559[/C][C]0.2378[/C][C]0.2516[/C][C]0.5288[/C][C]0.508[/C][/ROW]
[ROW][C]61[/C][C]2539.91[/C][C]1921.7449[/C][C]250.3731[/C][C]3593.1167[/C][C]0.2343[/C][C]0.2479[/C][C]0.5076[/C][C]0.5076[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=113887&T=1

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=113887&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])
373844.49-------
383720.98-------
393674.4-------
403857.62-------
413801.06-------
423504.37-------
433032.6-------
443047.03-------
452962.34-------
462197.82-------
472014.45-------
481862.83-------
491905.41-------
501810.991917.21581558.1232276.30860.2810.525700.5257
511670.071920.48921337.98352502.99480.19970.643700.5202
521864.441921.39671162.60662680.18690.44150.741900.5165
532052.021921.64841016.26762827.02920.38890.549300.514
542029.61921.7181889.35822954.07810.41890.40230.00130.5124
552070.831921.7375776.13563067.33940.39930.42680.02870.5111
562293.411921.7428673.06253170.42320.27980.40750.03870.5102
572443.271921.7443577.85213265.63660.22340.29390.06460.5095
582513.171921.7447488.94943354.54010.20920.23780.35280.5089
592466.921921.7449405.24823438.24150.24050.22230.45230.5084
602502.661921.7449325.93073517.5590.23780.25160.52880.508
612539.911921.7449250.37313593.11670.23430.24790.50760.5076







Univariate ARIMA Extrapolation Forecast Performance
time% S.E.PEMAPESq.EMSERMSE
500.0956-0.05540.004611283.9303940.327530.6648
510.1548-0.13040.010962709.75875225.813272.2898
520.2015-0.02960.00253244.0697270.339116.442
530.24040.06780.005716996.76171416.396837.635
540.27410.05610.004711638.4957969.874631.1428
550.30410.07760.006522228.57821852.381543.0393
560.33150.19340.0161138136.47211511.3727107.2911
570.35680.27140.0226271989.019422665.7516150.5515
580.38040.30780.0256349783.829729148.6525170.7298
590.40260.28370.0236297215.931624767.9943157.3785
600.42370.30230.0252337462.361328121.8634167.6957
610.44370.32170.0268382128.088431844.0074178.4489

\begin{tabular}{lllllllll}
\hline
Univariate ARIMA Extrapolation Forecast Performance \tabularnewline
time & % S.E. & PE & MAPE & Sq.E & MSE & RMSE \tabularnewline
50 & 0.0956 & -0.0554 & 0.0046 & 11283.9303 & 940.3275 & 30.6648 \tabularnewline
51 & 0.1548 & -0.1304 & 0.0109 & 62709.7587 & 5225.8132 & 72.2898 \tabularnewline
52 & 0.2015 & -0.0296 & 0.0025 & 3244.0697 & 270.3391 & 16.442 \tabularnewline
53 & 0.2404 & 0.0678 & 0.0057 & 16996.7617 & 1416.3968 & 37.635 \tabularnewline
54 & 0.2741 & 0.0561 & 0.0047 & 11638.4957 & 969.8746 & 31.1428 \tabularnewline
55 & 0.3041 & 0.0776 & 0.0065 & 22228.5782 & 1852.3815 & 43.0393 \tabularnewline
56 & 0.3315 & 0.1934 & 0.0161 & 138136.472 & 11511.3727 & 107.2911 \tabularnewline
57 & 0.3568 & 0.2714 & 0.0226 & 271989.0194 & 22665.7516 & 150.5515 \tabularnewline
58 & 0.3804 & 0.3078 & 0.0256 & 349783.8297 & 29148.6525 & 170.7298 \tabularnewline
59 & 0.4026 & 0.2837 & 0.0236 & 297215.9316 & 24767.9943 & 157.3785 \tabularnewline
60 & 0.4237 & 0.3023 & 0.0252 & 337462.3613 & 28121.8634 & 167.6957 \tabularnewline
61 & 0.4437 & 0.3217 & 0.0268 & 382128.0884 & 31844.0074 & 178.4489 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=113887&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.0956[/C][C]-0.0554[/C][C]0.0046[/C][C]11283.9303[/C][C]940.3275[/C][C]30.6648[/C][/ROW]
[ROW][C]51[/C][C]0.1548[/C][C]-0.1304[/C][C]0.0109[/C][C]62709.7587[/C][C]5225.8132[/C][C]72.2898[/C][/ROW]
[ROW][C]52[/C][C]0.2015[/C][C]-0.0296[/C][C]0.0025[/C][C]3244.0697[/C][C]270.3391[/C][C]16.442[/C][/ROW]
[ROW][C]53[/C][C]0.2404[/C][C]0.0678[/C][C]0.0057[/C][C]16996.7617[/C][C]1416.3968[/C][C]37.635[/C][/ROW]
[ROW][C]54[/C][C]0.2741[/C][C]0.0561[/C][C]0.0047[/C][C]11638.4957[/C][C]969.8746[/C][C]31.1428[/C][/ROW]
[ROW][C]55[/C][C]0.3041[/C][C]0.0776[/C][C]0.0065[/C][C]22228.5782[/C][C]1852.3815[/C][C]43.0393[/C][/ROW]
[ROW][C]56[/C][C]0.3315[/C][C]0.1934[/C][C]0.0161[/C][C]138136.472[/C][C]11511.3727[/C][C]107.2911[/C][/ROW]
[ROW][C]57[/C][C]0.3568[/C][C]0.2714[/C][C]0.0226[/C][C]271989.0194[/C][C]22665.7516[/C][C]150.5515[/C][/ROW]
[ROW][C]58[/C][C]0.3804[/C][C]0.3078[/C][C]0.0256[/C][C]349783.8297[/C][C]29148.6525[/C][C]170.7298[/C][/ROW]
[ROW][C]59[/C][C]0.4026[/C][C]0.2837[/C][C]0.0236[/C][C]297215.9316[/C][C]24767.9943[/C][C]157.3785[/C][/ROW]
[ROW][C]60[/C][C]0.4237[/C][C]0.3023[/C][C]0.0252[/C][C]337462.3613[/C][C]28121.8634[/C][C]167.6957[/C][/ROW]
[ROW][C]61[/C][C]0.4437[/C][C]0.3217[/C][C]0.0268[/C][C]382128.0884[/C][C]31844.0074[/C][C]178.4489[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=113887&T=2

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=113887&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.0956-0.05540.004611283.9303940.327530.6648
510.1548-0.13040.010962709.75875225.813272.2898
520.2015-0.02960.00253244.0697270.339116.442
530.24040.06780.005716996.76171416.396837.635
540.27410.05610.004711638.4957969.874631.1428
550.30410.07760.006522228.57821852.381543.0393
560.33150.19340.0161138136.47211511.3727107.2911
570.35680.27140.0226271989.019422665.7516150.5515
580.38040.30780.0256349783.829729148.6525170.7298
590.40260.28370.0236297215.931624767.9943157.3785
600.42370.30230.0252337462.361328121.8634167.6957
610.44370.32170.0268382128.088431844.0074178.4489



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