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, 15 Dec 2009 11:44:14 -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/15/t1260902928fwa893uzg1iajfz.htm/, Retrieved Wed, 08 May 2024 09:27:36 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=68073, Retrieved Wed, 08 May 2024 09:27:36 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywordsSDHW, DSHW
Estimated Impact115
Family? (F = Feedback message, R = changed R code, M = changed R Module, P = changed Parameters, D = changed Data)
-     [Bivariate Explorative Data Analysis] [Paper Bivariate E...] [2009-12-13 14:39:24] [143cbdcaf7333bdd9926a1dde50d1082]
- RMPD    [ARIMA Forecasting] [Paper-ARIMAforeca...] [2009-12-15 18:44:14] [36295456a56d4c7dcc9b9537ce63463b] [Current]
- R PD      [ARIMA Forecasting] [Paper-ARIMAforeca...] [2009-12-18 10:49:22] [143cbdcaf7333bdd9926a1dde50d1082]
- R PD        [ARIMA Forecasting] [Forecasting] [2010-12-29 19:27:15] [17d39bb3ec485d4ce196f61215d11ba1]
-               [ARIMA Forecasting] [forecast] [2010-12-29 22:40:36] [442b6d00ecbe55ac6a674160c9c5510a]
- RMPD        [Cross Correlation Function] [Cross correlation] [2010-12-29 19:42:55] [17d39bb3ec485d4ce196f61215d11ba1]
-               [Cross Correlation Function] [cross correlation] [2010-12-29 22:35:31] [442b6d00ecbe55ac6a674160c9c5510a]
- RMPD        [ARIMA Backward Selection] [Arima bw - NWWZ- ...] [2010-12-29 19:51:03] [17d39bb3ec485d4ce196f61215d11ba1]
- R PD        [ARIMA Forecasting] [Arima forcasting ...] [2010-12-29 20:07:50] [87d09f1da78d94c90b11e34ec961a75e]
- R PD        [ARIMA Forecasting] [forcastingmodel f...] [2010-12-29 20:13:09] [17d39bb3ec485d4ce196f61215d11ba1]
- RMPD        [ARIMA Backward Selection] [Arima- backward f...] [2010-12-29 20:17:01] [17d39bb3ec485d4ce196f61215d11ba1]
Feedback Forum

Post a new message
Dataseries X:
128
502
629.7
595.9
823.7
498.7
766.9
1611.3
329.7
1378.9
1159.4
790.1
-189.6
862.4
426.6
852
834.7
1026.7
1052.8
1280.9
-243.6
976
908.2
416
610.7
728
520.8
905.8
768.9
479.3
1054.2
1411.9
-131
1526.2
1049.5
550.8
168.5
458.2
297
616.3
762.7
693.1
512.7
1169.2
-915.1
1384.2
1368.9
-275.1
-408.9
-37.5
171.5
671.8
-18.5
231.6
747.5
1505.7
-83.6
1173.2
1452.1
777
-52.8
861.2
735.2
1073.6
966.9
1189.8
1093.5
1782.7
-70.4
1471.6
1273.8
900.8
-910.2
299.8
460.2
677.2
937.1
1265.4
1275.6
1582.6
-154.2
1667.7
1083.1
891.7
-26.5
423.4
662.8
711.4
993.3
1133.2
343.9
1415.8
-531.8
1193.6
1201.3
805.6
-164.8




Summary of computational transaction
Raw Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time5 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 & 5 seconds \tabularnewline
R Server & 'Gwilym Jenkins' @ 72.249.127.135 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=68073&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]5 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=68073&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=68073&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 time5 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[85])
73-910.2-------
74299.8-------
75460.2-------
76677.2-------
77937.1-------
781265.4-------
791275.6-------
801582.6-------
81-154.2-------
821667.7-------
831083.1-------
84891.7-------
85-26.5-------
86423.4513.9832-118.63861146.60510.38950.9530.74650.953
87662.8463.5758-190.53361117.68530.27530.54790.5040.929
88711.4772.5839118.47451426.69340.42730.62890.61250.9917
89993.3727.461873.35241381.57130.21290.51920.26490.9881
901133.2789.3246135.21521443.43410.15140.27050.07690.9927
91343.9940.6707286.56121594.78010.03690.2820.15780.9981
921415.81487.0947832.98522141.20410.41540.99970.38741
93-531.8-183.1261-837.2355470.98340.148100.46550.3194
941193.61380.0525725.9432034.16190.288210.19441
951201.31189.2349535.12551843.34440.48560.49480.62480.9999
96805.6601.5899-52.27361255.45330.27040.03610.19230.9701
97-164.8-109.6159-759.9079540.67610.43390.00290.40110.4011

\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[85]) \tabularnewline
73 & -910.2 & - & - & - & - & - & - & - \tabularnewline
74 & 299.8 & - & - & - & - & - & - & - \tabularnewline
75 & 460.2 & - & - & - & - & - & - & - \tabularnewline
76 & 677.2 & - & - & - & - & - & - & - \tabularnewline
77 & 937.1 & - & - & - & - & - & - & - \tabularnewline
78 & 1265.4 & - & - & - & - & - & - & - \tabularnewline
79 & 1275.6 & - & - & - & - & - & - & - \tabularnewline
80 & 1582.6 & - & - & - & - & - & - & - \tabularnewline
81 & -154.2 & - & - & - & - & - & - & - \tabularnewline
82 & 1667.7 & - & - & - & - & - & - & - \tabularnewline
83 & 1083.1 & - & - & - & - & - & - & - \tabularnewline
84 & 891.7 & - & - & - & - & - & - & - \tabularnewline
85 & -26.5 & - & - & - & - & - & - & - \tabularnewline
86 & 423.4 & 513.9832 & -118.6386 & 1146.6051 & 0.3895 & 0.953 & 0.7465 & 0.953 \tabularnewline
87 & 662.8 & 463.5758 & -190.5336 & 1117.6853 & 0.2753 & 0.5479 & 0.504 & 0.929 \tabularnewline
88 & 711.4 & 772.5839 & 118.4745 & 1426.6934 & 0.4273 & 0.6289 & 0.6125 & 0.9917 \tabularnewline
89 & 993.3 & 727.4618 & 73.3524 & 1381.5713 & 0.2129 & 0.5192 & 0.2649 & 0.9881 \tabularnewline
90 & 1133.2 & 789.3246 & 135.2152 & 1443.4341 & 0.1514 & 0.2705 & 0.0769 & 0.9927 \tabularnewline
91 & 343.9 & 940.6707 & 286.5612 & 1594.7801 & 0.0369 & 0.282 & 0.1578 & 0.9981 \tabularnewline
92 & 1415.8 & 1487.0947 & 832.9852 & 2141.2041 & 0.4154 & 0.9997 & 0.3874 & 1 \tabularnewline
93 & -531.8 & -183.1261 & -837.2355 & 470.9834 & 0.1481 & 0 & 0.4655 & 0.3194 \tabularnewline
94 & 1193.6 & 1380.0525 & 725.943 & 2034.1619 & 0.2882 & 1 & 0.1944 & 1 \tabularnewline
95 & 1201.3 & 1189.2349 & 535.1255 & 1843.3444 & 0.4856 & 0.4948 & 0.6248 & 0.9999 \tabularnewline
96 & 805.6 & 601.5899 & -52.2736 & 1255.4533 & 0.2704 & 0.0361 & 0.1923 & 0.9701 \tabularnewline
97 & -164.8 & -109.6159 & -759.9079 & 540.6761 & 0.4339 & 0.0029 & 0.4011 & 0.4011 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=68073&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[85])[/C][/ROW]
[ROW][C]73[/C][C]-910.2[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]74[/C][C]299.8[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]75[/C][C]460.2[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]76[/C][C]677.2[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]77[/C][C]937.1[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]78[/C][C]1265.4[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]79[/C][C]1275.6[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]80[/C][C]1582.6[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]81[/C][C]-154.2[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]82[/C][C]1667.7[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]83[/C][C]1083.1[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]84[/C][C]891.7[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]85[/C][C]-26.5[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]86[/C][C]423.4[/C][C]513.9832[/C][C]-118.6386[/C][C]1146.6051[/C][C]0.3895[/C][C]0.953[/C][C]0.7465[/C][C]0.953[/C][/ROW]
[ROW][C]87[/C][C]662.8[/C][C]463.5758[/C][C]-190.5336[/C][C]1117.6853[/C][C]0.2753[/C][C]0.5479[/C][C]0.504[/C][C]0.929[/C][/ROW]
[ROW][C]88[/C][C]711.4[/C][C]772.5839[/C][C]118.4745[/C][C]1426.6934[/C][C]0.4273[/C][C]0.6289[/C][C]0.6125[/C][C]0.9917[/C][/ROW]
[ROW][C]89[/C][C]993.3[/C][C]727.4618[/C][C]73.3524[/C][C]1381.5713[/C][C]0.2129[/C][C]0.5192[/C][C]0.2649[/C][C]0.9881[/C][/ROW]
[ROW][C]90[/C][C]1133.2[/C][C]789.3246[/C][C]135.2152[/C][C]1443.4341[/C][C]0.1514[/C][C]0.2705[/C][C]0.0769[/C][C]0.9927[/C][/ROW]
[ROW][C]91[/C][C]343.9[/C][C]940.6707[/C][C]286.5612[/C][C]1594.7801[/C][C]0.0369[/C][C]0.282[/C][C]0.1578[/C][C]0.9981[/C][/ROW]
[ROW][C]92[/C][C]1415.8[/C][C]1487.0947[/C][C]832.9852[/C][C]2141.2041[/C][C]0.4154[/C][C]0.9997[/C][C]0.3874[/C][C]1[/C][/ROW]
[ROW][C]93[/C][C]-531.8[/C][C]-183.1261[/C][C]-837.2355[/C][C]470.9834[/C][C]0.1481[/C][C]0[/C][C]0.4655[/C][C]0.3194[/C][/ROW]
[ROW][C]94[/C][C]1193.6[/C][C]1380.0525[/C][C]725.943[/C][C]2034.1619[/C][C]0.2882[/C][C]1[/C][C]0.1944[/C][C]1[/C][/ROW]
[ROW][C]95[/C][C]1201.3[/C][C]1189.2349[/C][C]535.1255[/C][C]1843.3444[/C][C]0.4856[/C][C]0.4948[/C][C]0.6248[/C][C]0.9999[/C][/ROW]
[ROW][C]96[/C][C]805.6[/C][C]601.5899[/C][C]-52.2736[/C][C]1255.4533[/C][C]0.2704[/C][C]0.0361[/C][C]0.1923[/C][C]0.9701[/C][/ROW]
[ROW][C]97[/C][C]-164.8[/C][C]-109.6159[/C][C]-759.9079[/C][C]540.6761[/C][C]0.4339[/C][C]0.0029[/C][C]0.4011[/C][C]0.4011[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=68073&T=1

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=68073&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[85])
73-910.2-------
74299.8-------
75460.2-------
76677.2-------
77937.1-------
781265.4-------
791275.6-------
801582.6-------
81-154.2-------
821667.7-------
831083.1-------
84891.7-------
85-26.5-------
86423.4513.9832-118.63861146.60510.38950.9530.74650.953
87662.8463.5758-190.53361117.68530.27530.54790.5040.929
88711.4772.5839118.47451426.69340.42730.62890.61250.9917
89993.3727.461873.35241381.57130.21290.51920.26490.9881
901133.2789.3246135.21521443.43410.15140.27050.07690.9927
91343.9940.6707286.56121594.78010.03690.2820.15780.9981
921415.81487.0947832.98522141.20410.41540.99970.38741
93-531.8-183.1261-837.2355470.98340.148100.46550.3194
941193.61380.0525725.9432034.16190.288210.19441
951201.31189.2349535.12551843.34440.48560.49480.62480.9999
96805.6601.5899-52.27361255.45330.27040.03610.19230.9701
97-164.8-109.6159-759.9079540.67610.43390.00290.40110.4011







Univariate ARIMA Extrapolation Forecast Performance
time% S.E.PEMAPESq.EMSERMSE
860.628-0.176208205.322400
870.71990.42980.30339690.269123947.7957154.7508
880.432-0.07920.22843743.470617213.0207131.1984
890.45880.36540.262770669.927630577.2474174.8635
900.42280.43570.2973118250.265748111.8511219.3441
910.3548-0.63440.3534356135.226799449.0804315.3555
920.2244-0.04790.30985082.931685968.202293.2033
93-1.82241.9040.5091121573.511290418.8656300.6973
940.2418-0.13510.467534764.520384235.0495290.2328
950.28060.01010.4218145.565675826.1011275.3654
960.55450.33910.414341620.126372716.467269.6599
97-3.02680.50340.42173045.286566910.5353258.6707

\begin{tabular}{lllllllll}
\hline
Univariate ARIMA Extrapolation Forecast Performance \tabularnewline
time & % S.E. & PE & MAPE & Sq.E & MSE & RMSE \tabularnewline
86 & 0.628 & -0.1762 & 0 & 8205.3224 & 0 & 0 \tabularnewline
87 & 0.7199 & 0.4298 & 0.303 & 39690.2691 & 23947.7957 & 154.7508 \tabularnewline
88 & 0.432 & -0.0792 & 0.2284 & 3743.4706 & 17213.0207 & 131.1984 \tabularnewline
89 & 0.4588 & 0.3654 & 0.2627 & 70669.9276 & 30577.2474 & 174.8635 \tabularnewline
90 & 0.4228 & 0.4357 & 0.2973 & 118250.2657 & 48111.8511 & 219.3441 \tabularnewline
91 & 0.3548 & -0.6344 & 0.3534 & 356135.2267 & 99449.0804 & 315.3555 \tabularnewline
92 & 0.2244 & -0.0479 & 0.3098 & 5082.9316 & 85968.202 & 293.2033 \tabularnewline
93 & -1.8224 & 1.904 & 0.5091 & 121573.5112 & 90418.8656 & 300.6973 \tabularnewline
94 & 0.2418 & -0.1351 & 0.4675 & 34764.5203 & 84235.0495 & 290.2328 \tabularnewline
95 & 0.2806 & 0.0101 & 0.4218 & 145.5656 & 75826.1011 & 275.3654 \tabularnewline
96 & 0.5545 & 0.3391 & 0.4143 & 41620.1263 & 72716.467 & 269.6599 \tabularnewline
97 & -3.0268 & 0.5034 & 0.4217 & 3045.2865 & 66910.5353 & 258.6707 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=68073&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]86[/C][C]0.628[/C][C]-0.1762[/C][C]0[/C][C]8205.3224[/C][C]0[/C][C]0[/C][/ROW]
[ROW][C]87[/C][C]0.7199[/C][C]0.4298[/C][C]0.303[/C][C]39690.2691[/C][C]23947.7957[/C][C]154.7508[/C][/ROW]
[ROW][C]88[/C][C]0.432[/C][C]-0.0792[/C][C]0.2284[/C][C]3743.4706[/C][C]17213.0207[/C][C]131.1984[/C][/ROW]
[ROW][C]89[/C][C]0.4588[/C][C]0.3654[/C][C]0.2627[/C][C]70669.9276[/C][C]30577.2474[/C][C]174.8635[/C][/ROW]
[ROW][C]90[/C][C]0.4228[/C][C]0.4357[/C][C]0.2973[/C][C]118250.2657[/C][C]48111.8511[/C][C]219.3441[/C][/ROW]
[ROW][C]91[/C][C]0.3548[/C][C]-0.6344[/C][C]0.3534[/C][C]356135.2267[/C][C]99449.0804[/C][C]315.3555[/C][/ROW]
[ROW][C]92[/C][C]0.2244[/C][C]-0.0479[/C][C]0.3098[/C][C]5082.9316[/C][C]85968.202[/C][C]293.2033[/C][/ROW]
[ROW][C]93[/C][C]-1.8224[/C][C]1.904[/C][C]0.5091[/C][C]121573.5112[/C][C]90418.8656[/C][C]300.6973[/C][/ROW]
[ROW][C]94[/C][C]0.2418[/C][C]-0.1351[/C][C]0.4675[/C][C]34764.5203[/C][C]84235.0495[/C][C]290.2328[/C][/ROW]
[ROW][C]95[/C][C]0.2806[/C][C]0.0101[/C][C]0.4218[/C][C]145.5656[/C][C]75826.1011[/C][C]275.3654[/C][/ROW]
[ROW][C]96[/C][C]0.5545[/C][C]0.3391[/C][C]0.4143[/C][C]41620.1263[/C][C]72716.467[/C][C]269.6599[/C][/ROW]
[ROW][C]97[/C][C]-3.0268[/C][C]0.5034[/C][C]0.4217[/C][C]3045.2865[/C][C]66910.5353[/C][C]258.6707[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=68073&T=2

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=68073&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
860.628-0.176208205.322400
870.71990.42980.30339690.269123947.7957154.7508
880.432-0.07920.22843743.470617213.0207131.1984
890.45880.36540.262770669.927630577.2474174.8635
900.42280.43570.2973118250.265748111.8511219.3441
910.3548-0.63440.3534356135.226799449.0804315.3555
920.2244-0.04790.30985082.931685968.202293.2033
93-1.82241.9040.5091121573.511290418.8656300.6973
940.2418-0.13510.467534764.520384235.0495290.2328
950.28060.01010.4218145.565675826.1011275.3654
960.55450.33910.414341620.126372716.467269.6599
97-3.02680.50340.42173045.286566910.5353258.6707



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