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 computationSun, 26 Dec 2010 17:15:25 +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/26/t1293383606w0nl9lfhprbiuqq.htm/, Retrieved Mon, 06 May 2024 18:15:34 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=115734, Retrieved Mon, 06 May 2024 18:15:34 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact127
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]
-   PD      [ARIMA Forecasting] [ARIMA Model] [2010-12-07 16:48:47] [1c68a339ea090fe045c8010fcdb839f1]
-   PD        [ARIMA Forecasting] [Paper ARIMA Model] [2010-12-17 12:22:16] [1c68a339ea090fe045c8010fcdb839f1]
-   PD          [ARIMA Forecasting] [paper voorspellin...] [2010-12-26 16:46:25] [eeb33d252044f8583501f5ba0605ad6d]
-    D              [ARIMA Forecasting] [paper arima forec...] [2010-12-26 17:15:25] [6df2229e3f2091de42c4a9cf9a617420] [Current]
Feedback Forum

Post a new message
Dataseries X:
10554,27
10532,54
10324,31
10695,25
10827,81
10872,48
10971,19
11145,65
11234,68
11333,88
10997,97
11036,89
11257,35
11533,59
11963,12
12185,15
12377,62
12512,89
12631,48
12268,53
12754,8
13407,75
13480,21
13673,28
13239,71
13557,69
13901,28
13200,58
13406,97
12538,12
12419,57
12193,88
12656,63
12812,48
12056,67
11322,38
11530,75
11114,08
9181,73
8614,55
8595,56
8396,2
7690,5
7235,47
7992,12
8398,37
8593
8679,75
9374,63
9634,97
9857,34
10238,83
10433,44
10471,24
10214,51
10677,52
11052,15
10500,19
10159,27
10222,24
10350,4




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

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=115734&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'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])
3711530.75-------
3811114.08-------
399181.73-------
408614.55-------
418595.56-------
428396.2-------
437690.5-------
447235.47-------
457992.12-------
468398.37-------
478593-------
488679.75-------
499374.63-------
509634.979364.31718251.618710379.9430.30070.49214e-040.4921
519857.349320.41047702.927410738.74480.2290.33190.5760.4701
5210238.839308.7797286.706311027.04270.14440.26570.78580.4701
5310433.449308.39976932.386711273.57740.13090.17670.76140.4737
5410471.249304.4576603.017611484.20870.14710.1550.79290.4748
5510214.519291.08926280.098211663.83550.22280.16480.90690.4725
5610677.529282.96335976.895411830.53080.14170.23680.94240.4719
5711052.159296.68975714.651712001.37020.10170.15850.82780.4775
5810500.199304.49955451.490912155.98060.20560.11480.73330.4808
5910159.279308.34865187.234812297.95340.28850.21730.68050.4827
6010222.249310.08644922.287712430.25670.28330.29690.65390.4838
6110350.49324.49824680.169712565.66870.26750.29360.48790.4879

\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 & 11530.75 & - & - & - & - & - & - & - \tabularnewline
38 & 11114.08 & - & - & - & - & - & - & - \tabularnewline
39 & 9181.73 & - & - & - & - & - & - & - \tabularnewline
40 & 8614.55 & - & - & - & - & - & - & - \tabularnewline
41 & 8595.56 & - & - & - & - & - & - & - \tabularnewline
42 & 8396.2 & - & - & - & - & - & - & - \tabularnewline
43 & 7690.5 & - & - & - & - & - & - & - \tabularnewline
44 & 7235.47 & - & - & - & - & - & - & - \tabularnewline
45 & 7992.12 & - & - & - & - & - & - & - \tabularnewline
46 & 8398.37 & - & - & - & - & - & - & - \tabularnewline
47 & 8593 & - & - & - & - & - & - & - \tabularnewline
48 & 8679.75 & - & - & - & - & - & - & - \tabularnewline
49 & 9374.63 & - & - & - & - & - & - & - \tabularnewline
50 & 9634.97 & 9364.3171 & 8251.6187 & 10379.943 & 0.3007 & 0.4921 & 4e-04 & 0.4921 \tabularnewline
51 & 9857.34 & 9320.4104 & 7702.9274 & 10738.7448 & 0.229 & 0.3319 & 0.576 & 0.4701 \tabularnewline
52 & 10238.83 & 9308.779 & 7286.7063 & 11027.0427 & 0.1444 & 0.2657 & 0.7858 & 0.4701 \tabularnewline
53 & 10433.44 & 9308.3997 & 6932.3867 & 11273.5774 & 0.1309 & 0.1767 & 0.7614 & 0.4737 \tabularnewline
54 & 10471.24 & 9304.457 & 6603.0176 & 11484.2087 & 0.1471 & 0.155 & 0.7929 & 0.4748 \tabularnewline
55 & 10214.51 & 9291.0892 & 6280.0982 & 11663.8355 & 0.2228 & 0.1648 & 0.9069 & 0.4725 \tabularnewline
56 & 10677.52 & 9282.9633 & 5976.8954 & 11830.5308 & 0.1417 & 0.2368 & 0.9424 & 0.4719 \tabularnewline
57 & 11052.15 & 9296.6897 & 5714.6517 & 12001.3702 & 0.1017 & 0.1585 & 0.8278 & 0.4775 \tabularnewline
58 & 10500.19 & 9304.4995 & 5451.4909 & 12155.9806 & 0.2056 & 0.1148 & 0.7333 & 0.4808 \tabularnewline
59 & 10159.27 & 9308.3486 & 5187.2348 & 12297.9534 & 0.2885 & 0.2173 & 0.6805 & 0.4827 \tabularnewline
60 & 10222.24 & 9310.0864 & 4922.2877 & 12430.2567 & 0.2833 & 0.2969 & 0.6539 & 0.4838 \tabularnewline
61 & 10350.4 & 9324.4982 & 4680.1697 & 12565.6687 & 0.2675 & 0.2936 & 0.4879 & 0.4879 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=115734&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]11530.75[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]38[/C][C]11114.08[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]39[/C][C]9181.73[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]40[/C][C]8614.55[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]41[/C][C]8595.56[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]42[/C][C]8396.2[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]43[/C][C]7690.5[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]44[/C][C]7235.47[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]45[/C][C]7992.12[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]46[/C][C]8398.37[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]47[/C][C]8593[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]48[/C][C]8679.75[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]49[/C][C]9374.63[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]50[/C][C]9634.97[/C][C]9364.3171[/C][C]8251.6187[/C][C]10379.943[/C][C]0.3007[/C][C]0.4921[/C][C]4e-04[/C][C]0.4921[/C][/ROW]
[ROW][C]51[/C][C]9857.34[/C][C]9320.4104[/C][C]7702.9274[/C][C]10738.7448[/C][C]0.229[/C][C]0.3319[/C][C]0.576[/C][C]0.4701[/C][/ROW]
[ROW][C]52[/C][C]10238.83[/C][C]9308.779[/C][C]7286.7063[/C][C]11027.0427[/C][C]0.1444[/C][C]0.2657[/C][C]0.7858[/C][C]0.4701[/C][/ROW]
[ROW][C]53[/C][C]10433.44[/C][C]9308.3997[/C][C]6932.3867[/C][C]11273.5774[/C][C]0.1309[/C][C]0.1767[/C][C]0.7614[/C][C]0.4737[/C][/ROW]
[ROW][C]54[/C][C]10471.24[/C][C]9304.457[/C][C]6603.0176[/C][C]11484.2087[/C][C]0.1471[/C][C]0.155[/C][C]0.7929[/C][C]0.4748[/C][/ROW]
[ROW][C]55[/C][C]10214.51[/C][C]9291.0892[/C][C]6280.0982[/C][C]11663.8355[/C][C]0.2228[/C][C]0.1648[/C][C]0.9069[/C][C]0.4725[/C][/ROW]
[ROW][C]56[/C][C]10677.52[/C][C]9282.9633[/C][C]5976.8954[/C][C]11830.5308[/C][C]0.1417[/C][C]0.2368[/C][C]0.9424[/C][C]0.4719[/C][/ROW]
[ROW][C]57[/C][C]11052.15[/C][C]9296.6897[/C][C]5714.6517[/C][C]12001.3702[/C][C]0.1017[/C][C]0.1585[/C][C]0.8278[/C][C]0.4775[/C][/ROW]
[ROW][C]58[/C][C]10500.19[/C][C]9304.4995[/C][C]5451.4909[/C][C]12155.9806[/C][C]0.2056[/C][C]0.1148[/C][C]0.7333[/C][C]0.4808[/C][/ROW]
[ROW][C]59[/C][C]10159.27[/C][C]9308.3486[/C][C]5187.2348[/C][C]12297.9534[/C][C]0.2885[/C][C]0.2173[/C][C]0.6805[/C][C]0.4827[/C][/ROW]
[ROW][C]60[/C][C]10222.24[/C][C]9310.0864[/C][C]4922.2877[/C][C]12430.2567[/C][C]0.2833[/C][C]0.2969[/C][C]0.6539[/C][C]0.4838[/C][/ROW]
[ROW][C]61[/C][C]10350.4[/C][C]9324.4982[/C][C]4680.1697[/C][C]12565.6687[/C][C]0.2675[/C][C]0.2936[/C][C]0.4879[/C][C]0.4879[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=115734&T=1

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=115734&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])
3711530.75-------
3811114.08-------
399181.73-------
408614.55-------
418595.56-------
428396.2-------
437690.5-------
447235.47-------
457992.12-------
468398.37-------
478593-------
488679.75-------
499374.63-------
509634.979364.31718251.618710379.9430.30070.49214e-040.4921
519857.349320.41047702.927410738.74480.2290.33190.5760.4701
5210238.839308.7797286.706311027.04270.14440.26570.78580.4701
5310433.449308.39976932.386711273.57740.13090.17670.76140.4737
5410471.249304.4576603.017611484.20870.14710.1550.79290.4748
5510214.519291.08926280.098211663.83550.22280.16480.90690.4725
5610677.529282.96335976.895411830.53080.14170.23680.94240.4719
5711052.159296.68975714.651712001.37020.10170.15850.82780.4775
5810500.199304.49955451.490912155.98060.20560.11480.73330.4808
5910159.279308.34865187.234812297.95340.28850.21730.68050.4827
6010222.249310.08644922.287712430.25670.28330.29690.65390.4838
6110350.49324.49824680.169712565.66870.26750.29360.48790.4879







Univariate ARIMA Extrapolation Forecast Performance
time% S.E.PEMAPESq.EMSERMSE
500.05530.0289073253.003700
510.07760.05760.0433288293.4089180773.2063425.1743
520.09420.09990.0621864994.8688408847.0938639.4115
530.10770.12090.07681265715.7867623064.267789.3442
540.11950.12540.08651361382.6249770727.9386877.9111
550.13030.09940.0887852705.9378784390.9385885.6585
560.140.15020.09751944788.3763950162.001974.7625
570.14840.18880.10893081640.96721216596.87181102.9945
580.15640.12850.11111429675.77221240272.30521113.6751
590.16390.09140.1091724067.29261188651.80391090.2531
600.1710.0980.1081832024.12441156231.10581075.2819
610.17730.110.10831052474.49741147584.72171071.2538

\begin{tabular}{lllllllll}
\hline
Univariate ARIMA Extrapolation Forecast Performance \tabularnewline
time & % S.E. & PE & MAPE & Sq.E & MSE & RMSE \tabularnewline
50 & 0.0553 & 0.0289 & 0 & 73253.0037 & 0 & 0 \tabularnewline
51 & 0.0776 & 0.0576 & 0.0433 & 288293.4089 & 180773.2063 & 425.1743 \tabularnewline
52 & 0.0942 & 0.0999 & 0.0621 & 864994.8688 & 408847.0938 & 639.4115 \tabularnewline
53 & 0.1077 & 0.1209 & 0.0768 & 1265715.7867 & 623064.267 & 789.3442 \tabularnewline
54 & 0.1195 & 0.1254 & 0.0865 & 1361382.6249 & 770727.9386 & 877.9111 \tabularnewline
55 & 0.1303 & 0.0994 & 0.0887 & 852705.9378 & 784390.9385 & 885.6585 \tabularnewline
56 & 0.14 & 0.1502 & 0.0975 & 1944788.3763 & 950162.001 & 974.7625 \tabularnewline
57 & 0.1484 & 0.1888 & 0.1089 & 3081640.9672 & 1216596.8718 & 1102.9945 \tabularnewline
58 & 0.1564 & 0.1285 & 0.1111 & 1429675.7722 & 1240272.3052 & 1113.6751 \tabularnewline
59 & 0.1639 & 0.0914 & 0.1091 & 724067.2926 & 1188651.8039 & 1090.2531 \tabularnewline
60 & 0.171 & 0.098 & 0.1081 & 832024.1244 & 1156231.1058 & 1075.2819 \tabularnewline
61 & 0.1773 & 0.11 & 0.1083 & 1052474.4974 & 1147584.7217 & 1071.2538 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=115734&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.0553[/C][C]0.0289[/C][C]0[/C][C]73253.0037[/C][C]0[/C][C]0[/C][/ROW]
[ROW][C]51[/C][C]0.0776[/C][C]0.0576[/C][C]0.0433[/C][C]288293.4089[/C][C]180773.2063[/C][C]425.1743[/C][/ROW]
[ROW][C]52[/C][C]0.0942[/C][C]0.0999[/C][C]0.0621[/C][C]864994.8688[/C][C]408847.0938[/C][C]639.4115[/C][/ROW]
[ROW][C]53[/C][C]0.1077[/C][C]0.1209[/C][C]0.0768[/C][C]1265715.7867[/C][C]623064.267[/C][C]789.3442[/C][/ROW]
[ROW][C]54[/C][C]0.1195[/C][C]0.1254[/C][C]0.0865[/C][C]1361382.6249[/C][C]770727.9386[/C][C]877.9111[/C][/ROW]
[ROW][C]55[/C][C]0.1303[/C][C]0.0994[/C][C]0.0887[/C][C]852705.9378[/C][C]784390.9385[/C][C]885.6585[/C][/ROW]
[ROW][C]56[/C][C]0.14[/C][C]0.1502[/C][C]0.0975[/C][C]1944788.3763[/C][C]950162.001[/C][C]974.7625[/C][/ROW]
[ROW][C]57[/C][C]0.1484[/C][C]0.1888[/C][C]0.1089[/C][C]3081640.9672[/C][C]1216596.8718[/C][C]1102.9945[/C][/ROW]
[ROW][C]58[/C][C]0.1564[/C][C]0.1285[/C][C]0.1111[/C][C]1429675.7722[/C][C]1240272.3052[/C][C]1113.6751[/C][/ROW]
[ROW][C]59[/C][C]0.1639[/C][C]0.0914[/C][C]0.1091[/C][C]724067.2926[/C][C]1188651.8039[/C][C]1090.2531[/C][/ROW]
[ROW][C]60[/C][C]0.171[/C][C]0.098[/C][C]0.1081[/C][C]832024.1244[/C][C]1156231.1058[/C][C]1075.2819[/C][/ROW]
[ROW][C]61[/C][C]0.1773[/C][C]0.11[/C][C]0.1083[/C][C]1052474.4974[/C][C]1147584.7217[/C][C]1071.2538[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=115734&T=2

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=115734&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.05530.0289073253.003700
510.07760.05760.0433288293.4089180773.2063425.1743
520.09420.09990.0621864994.8688408847.0938639.4115
530.10770.12090.07681265715.7867623064.267789.3442
540.11950.12540.08651361382.6249770727.9386877.9111
550.13030.09940.0887852705.9378784390.9385885.6585
560.140.15020.09751944788.3763950162.001974.7625
570.14840.18880.10893081640.96721216596.87181102.9945
580.15640.12850.11111429675.77221240272.30521113.6751
590.16390.09140.1091724067.29261188651.80391090.2531
600.1710.0980.1081832024.12441156231.10581075.2819
610.17730.110.10831052474.49741147584.72171071.2538



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