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 computationMon, 27 Dec 2010 03:33:53 +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/27/t1293420726a6rqtjtem2snalf.htm/, Retrieved Mon, 06 May 2024 15:04:24 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=115853, Retrieved Mon, 06 May 2024 15:04:24 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact167
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 arima forec...] [2010-12-26 16:44:13] [eeb33d252044f8583501f5ba0605ad6d]
-   PD              [ARIMA Forecasting] [paper arima forec...] [2010-12-27 03:33:53] [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'RServer@AstonUniversity' @ vre.aston.ac.uk

\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 & 'RServer@AstonUniversity' @ vre.aston.ac.uk \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=115853&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]'RServer@AstonUniversity' @ vre.aston.ac.uk[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=115853&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=115853&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'RServer@AstonUniversity' @ vre.aston.ac.uk







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.979512.63748438.627610497.27130.40380.60827e-040.6082
519857.349512.63747775.404911026.00040.32760.43710.66590.5709
5210238.839512.63747265.763911396.28490.22490.35990.8250.5571
5310433.449512.63746822.585211694.75620.20410.25710.7950.5493
5410471.249512.63746416.809511949.89980.22040.22950.81540.5442
5510214.519512.63746034.155612175.31420.30270.24020.91010.5405
5610677.529512.63745666.061612378.73940.21280.31560.94030.5376
5711052.159512.63745306.624812565.07280.16140.22720.83560.5353
5810500.199512.63744951.266412737.64310.27420.17470.75090.5334
5910159.279512.63744596.015212898.83280.35410.28380.70270.5318
6010222.249512.63744237.026813050.41560.34710.36010.67780.5305
6110350.49512.63743870.154513193.75350.32780.35280.52930.5293

\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 & 9512.6374 & 8438.6276 & 10497.2713 & 0.4038 & 0.6082 & 7e-04 & 0.6082 \tabularnewline
51 & 9857.34 & 9512.6374 & 7775.4049 & 11026.0004 & 0.3276 & 0.4371 & 0.6659 & 0.5709 \tabularnewline
52 & 10238.83 & 9512.6374 & 7265.7639 & 11396.2849 & 0.2249 & 0.3599 & 0.825 & 0.5571 \tabularnewline
53 & 10433.44 & 9512.6374 & 6822.5852 & 11694.7562 & 0.2041 & 0.2571 & 0.795 & 0.5493 \tabularnewline
54 & 10471.24 & 9512.6374 & 6416.8095 & 11949.8998 & 0.2204 & 0.2295 & 0.8154 & 0.5442 \tabularnewline
55 & 10214.51 & 9512.6374 & 6034.1556 & 12175.3142 & 0.3027 & 0.2402 & 0.9101 & 0.5405 \tabularnewline
56 & 10677.52 & 9512.6374 & 5666.0616 & 12378.7394 & 0.2128 & 0.3156 & 0.9403 & 0.5376 \tabularnewline
57 & 11052.15 & 9512.6374 & 5306.6248 & 12565.0728 & 0.1614 & 0.2272 & 0.8356 & 0.5353 \tabularnewline
58 & 10500.19 & 9512.6374 & 4951.2664 & 12737.6431 & 0.2742 & 0.1747 & 0.7509 & 0.5334 \tabularnewline
59 & 10159.27 & 9512.6374 & 4596.0152 & 12898.8328 & 0.3541 & 0.2838 & 0.7027 & 0.5318 \tabularnewline
60 & 10222.24 & 9512.6374 & 4237.0268 & 13050.4156 & 0.3471 & 0.3601 & 0.6778 & 0.5305 \tabularnewline
61 & 10350.4 & 9512.6374 & 3870.1545 & 13193.7535 & 0.3278 & 0.3528 & 0.5293 & 0.5293 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=115853&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]9512.6374[/C][C]8438.6276[/C][C]10497.2713[/C][C]0.4038[/C][C]0.6082[/C][C]7e-04[/C][C]0.6082[/C][/ROW]
[ROW][C]51[/C][C]9857.34[/C][C]9512.6374[/C][C]7775.4049[/C][C]11026.0004[/C][C]0.3276[/C][C]0.4371[/C][C]0.6659[/C][C]0.5709[/C][/ROW]
[ROW][C]52[/C][C]10238.83[/C][C]9512.6374[/C][C]7265.7639[/C][C]11396.2849[/C][C]0.2249[/C][C]0.3599[/C][C]0.825[/C][C]0.5571[/C][/ROW]
[ROW][C]53[/C][C]10433.44[/C][C]9512.6374[/C][C]6822.5852[/C][C]11694.7562[/C][C]0.2041[/C][C]0.2571[/C][C]0.795[/C][C]0.5493[/C][/ROW]
[ROW][C]54[/C][C]10471.24[/C][C]9512.6374[/C][C]6416.8095[/C][C]11949.8998[/C][C]0.2204[/C][C]0.2295[/C][C]0.8154[/C][C]0.5442[/C][/ROW]
[ROW][C]55[/C][C]10214.51[/C][C]9512.6374[/C][C]6034.1556[/C][C]12175.3142[/C][C]0.3027[/C][C]0.2402[/C][C]0.9101[/C][C]0.5405[/C][/ROW]
[ROW][C]56[/C][C]10677.52[/C][C]9512.6374[/C][C]5666.0616[/C][C]12378.7394[/C][C]0.2128[/C][C]0.3156[/C][C]0.9403[/C][C]0.5376[/C][/ROW]
[ROW][C]57[/C][C]11052.15[/C][C]9512.6374[/C][C]5306.6248[/C][C]12565.0728[/C][C]0.1614[/C][C]0.2272[/C][C]0.8356[/C][C]0.5353[/C][/ROW]
[ROW][C]58[/C][C]10500.19[/C][C]9512.6374[/C][C]4951.2664[/C][C]12737.6431[/C][C]0.2742[/C][C]0.1747[/C][C]0.7509[/C][C]0.5334[/C][/ROW]
[ROW][C]59[/C][C]10159.27[/C][C]9512.6374[/C][C]4596.0152[/C][C]12898.8328[/C][C]0.3541[/C][C]0.2838[/C][C]0.7027[/C][C]0.5318[/C][/ROW]
[ROW][C]60[/C][C]10222.24[/C][C]9512.6374[/C][C]4237.0268[/C][C]13050.4156[/C][C]0.3471[/C][C]0.3601[/C][C]0.6778[/C][C]0.5305[/C][/ROW]
[ROW][C]61[/C][C]10350.4[/C][C]9512.6374[/C][C]3870.1545[/C][C]13193.7535[/C][C]0.3278[/C][C]0.3528[/C][C]0.5293[/C][C]0.5293[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=115853&T=1

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=115853&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.979512.63748438.627610497.27130.40380.60827e-040.6082
519857.349512.63747775.404911026.00040.32760.43710.66590.5709
5210238.839512.63747265.763911396.28490.22490.35990.8250.5571
5310433.449512.63746822.585211694.75620.20410.25710.7950.5493
5410471.249512.63746416.809511949.89980.22040.22950.81540.5442
5510214.519512.63746034.155612175.31420.30270.24020.91010.5405
5610677.529512.63745666.061612378.73940.21280.31560.94030.5376
5711052.159512.63745306.624812565.07280.16140.22720.83560.5353
5810500.199512.63744951.266412737.64310.27420.17470.75090.5334
5910159.279512.63744596.015212898.83280.35410.28380.70270.5318
6010222.249512.63744237.026813050.41560.34710.36010.67780.5305
6110350.49512.63743870.154513193.75350.32780.35280.52930.5293







Univariate ARIMA Extrapolation Forecast Performance
time% S.E.PEMAPESq.EMSERMSE
500.05280.0129014965.263400
510.08120.03620.0245118819.877766892.5705258.636
520.1010.07630.0418527355.6824220380.2745469.4468
530.1170.09680.0556847877.4156377254.5598614.2105
540.13070.10080.0646918918.9316485587.4341696.841
550.14280.07380.0661492625.1371486760.3846697.6822
560.15370.12250.07421356951.4559611073.3948781.7118
570.16370.16180.08512370099.0246830951.5985911.5655
580.1730.10380.0872975260.1243846985.8792920.3184
590.18160.0680.0853418133.7106804100.6623896.7166
600.18970.07460.0843503535.8402776776.5876881.3493
610.19740.08810.0846701846.1625770532.3855877.7997

\begin{tabular}{lllllllll}
\hline
Univariate ARIMA Extrapolation Forecast Performance \tabularnewline
time & % S.E. & PE & MAPE & Sq.E & MSE & RMSE \tabularnewline
50 & 0.0528 & 0.0129 & 0 & 14965.2634 & 0 & 0 \tabularnewline
51 & 0.0812 & 0.0362 & 0.0245 & 118819.8777 & 66892.5705 & 258.636 \tabularnewline
52 & 0.101 & 0.0763 & 0.0418 & 527355.6824 & 220380.2745 & 469.4468 \tabularnewline
53 & 0.117 & 0.0968 & 0.0556 & 847877.4156 & 377254.5598 & 614.2105 \tabularnewline
54 & 0.1307 & 0.1008 & 0.0646 & 918918.9316 & 485587.4341 & 696.841 \tabularnewline
55 & 0.1428 & 0.0738 & 0.0661 & 492625.1371 & 486760.3846 & 697.6822 \tabularnewline
56 & 0.1537 & 0.1225 & 0.0742 & 1356951.4559 & 611073.3948 & 781.7118 \tabularnewline
57 & 0.1637 & 0.1618 & 0.0851 & 2370099.0246 & 830951.5985 & 911.5655 \tabularnewline
58 & 0.173 & 0.1038 & 0.0872 & 975260.1243 & 846985.8792 & 920.3184 \tabularnewline
59 & 0.1816 & 0.068 & 0.0853 & 418133.7106 & 804100.6623 & 896.7166 \tabularnewline
60 & 0.1897 & 0.0746 & 0.0843 & 503535.8402 & 776776.5876 & 881.3493 \tabularnewline
61 & 0.1974 & 0.0881 & 0.0846 & 701846.1625 & 770532.3855 & 877.7997 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=115853&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.0528[/C][C]0.0129[/C][C]0[/C][C]14965.2634[/C][C]0[/C][C]0[/C][/ROW]
[ROW][C]51[/C][C]0.0812[/C][C]0.0362[/C][C]0.0245[/C][C]118819.8777[/C][C]66892.5705[/C][C]258.636[/C][/ROW]
[ROW][C]52[/C][C]0.101[/C][C]0.0763[/C][C]0.0418[/C][C]527355.6824[/C][C]220380.2745[/C][C]469.4468[/C][/ROW]
[ROW][C]53[/C][C]0.117[/C][C]0.0968[/C][C]0.0556[/C][C]847877.4156[/C][C]377254.5598[/C][C]614.2105[/C][/ROW]
[ROW][C]54[/C][C]0.1307[/C][C]0.1008[/C][C]0.0646[/C][C]918918.9316[/C][C]485587.4341[/C][C]696.841[/C][/ROW]
[ROW][C]55[/C][C]0.1428[/C][C]0.0738[/C][C]0.0661[/C][C]492625.1371[/C][C]486760.3846[/C][C]697.6822[/C][/ROW]
[ROW][C]56[/C][C]0.1537[/C][C]0.1225[/C][C]0.0742[/C][C]1356951.4559[/C][C]611073.3948[/C][C]781.7118[/C][/ROW]
[ROW][C]57[/C][C]0.1637[/C][C]0.1618[/C][C]0.0851[/C][C]2370099.0246[/C][C]830951.5985[/C][C]911.5655[/C][/ROW]
[ROW][C]58[/C][C]0.173[/C][C]0.1038[/C][C]0.0872[/C][C]975260.1243[/C][C]846985.8792[/C][C]920.3184[/C][/ROW]
[ROW][C]59[/C][C]0.1816[/C][C]0.068[/C][C]0.0853[/C][C]418133.7106[/C][C]804100.6623[/C][C]896.7166[/C][/ROW]
[ROW][C]60[/C][C]0.1897[/C][C]0.0746[/C][C]0.0843[/C][C]503535.8402[/C][C]776776.5876[/C][C]881.3493[/C][/ROW]
[ROW][C]61[/C][C]0.1974[/C][C]0.0881[/C][C]0.0846[/C][C]701846.1625[/C][C]770532.3855[/C][C]877.7997[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=115853&T=2

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=115853&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.05280.0129014965.263400
510.08120.03620.0245118819.877766892.5705258.636
520.1010.07630.0418527355.6824220380.2745469.4468
530.1170.09680.0556847877.4156377254.5598614.2105
540.13070.10080.0646918918.9316485587.4341696.841
550.14280.07380.0661492625.1371486760.3846697.6822
560.15370.12250.07421356951.4559611073.3948781.7118
570.16370.16180.08512370099.0246830951.5985911.5655
580.1730.10380.0872975260.1243846985.8792920.3184
590.18160.0680.0853418133.7106804100.6623896.7166
600.18970.07460.0843503535.8402776776.5876881.3493
610.19740.08810.0846701846.1625770532.3855877.7997



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