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 computationWed, 23 Dec 2009 05:45:30 -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/23/t12615723894aaaf2ikdyva10r.htm/, Retrieved Thu, 31 Oct 2024 23:29:31 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=70524, Retrieved Thu, 31 Oct 2024 23:29:31 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywordspaper, voorspelling, diensten
Estimated Impact181
Family? (F = Feedback message, R = changed R code, M = changed R Module, P = changed Parameters, D = changed Data)
-     [(Partial) Autocorrelation Function] [] [2009-12-22 10:45:15] [0750c128064677e728c9436fc3f45ae7]
- RMPD  [Standard Deviation-Mean Plot] [] [2009-12-23 11:52:37] [0750c128064677e728c9436fc3f45ae7]
- RMPD      [ARIMA Forecasting] [] [2009-12-23 12:45:30] [30f5b608e5a1bbbae86b1702c0071566] [Current]
Feedback Forum

Post a new message
Dataseries X:
1,5
1,7
1,6
1,8
2,1
2,1
2,3
2,8
2,5
2,5
2,3
2,3
2,2
2,1
2,2
2
1,6
1,6
1,3
1,3
1,5
1,4
2
2,1
2,1
1,7
2,3
2,5
2,2
2,3
2,9
3,1
2,4
2
1,6
1,9
1,6
1,7
1,2
1,6
1,6
1,9
2,1
1,8
2,1
2,7
3,2
3
3,1
3,7
3,7
2,5
2,8
2,8
2,5
2,8
2,5
1,6
1,5
1,7
1,3




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

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=70524&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[49])
371.6-------
381.7-------
391.2-------
401.6-------
411.6-------
421.9-------
432.1-------
441.8-------
452.1-------
462.7-------
473.2-------
483-------
493.1-------
503.72.99152.15744.42250.16590.44090.96150.4409
513.73.76952.2947.30940.48460.51540.92260.6446
522.53.11.7986.56940.36730.36730.80160.5
532.83.11.67247.60380.44810.6030.74310.5
542.82.81411.46697.44190.49760.50240.65070.4518
552.52.67481.3437.7170.47290.48060.58840.4344
562.82.8971.354810.01990.48930.54350.61860.4777
572.52.67481.22979.70020.48050.48610.56370.4528
581.62.39121.09738.71640.40320.48660.46190.4131
591.52.24021.01478.47550.4080.57970.38140.3935
601.72.29430.99879.78290.43820.58230.42670.4165
611.32.26640.961410.49780.4090.55360.42130.4213

\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 & 1.6 & - & - & - & - & - & - & - \tabularnewline
38 & 1.7 & - & - & - & - & - & - & - \tabularnewline
39 & 1.2 & - & - & - & - & - & - & - \tabularnewline
40 & 1.6 & - & - & - & - & - & - & - \tabularnewline
41 & 1.6 & - & - & - & - & - & - & - \tabularnewline
42 & 1.9 & - & - & - & - & - & - & - \tabularnewline
43 & 2.1 & - & - & - & - & - & - & - \tabularnewline
44 & 1.8 & - & - & - & - & - & - & - \tabularnewline
45 & 2.1 & - & - & - & - & - & - & - \tabularnewline
46 & 2.7 & - & - & - & - & - & - & - \tabularnewline
47 & 3.2 & - & - & - & - & - & - & - \tabularnewline
48 & 3 & - & - & - & - & - & - & - \tabularnewline
49 & 3.1 & - & - & - & - & - & - & - \tabularnewline
50 & 3.7 & 2.9915 & 2.1574 & 4.4225 & 0.1659 & 0.4409 & 0.9615 & 0.4409 \tabularnewline
51 & 3.7 & 3.7695 & 2.294 & 7.3094 & 0.4846 & 0.5154 & 0.9226 & 0.6446 \tabularnewline
52 & 2.5 & 3.1 & 1.798 & 6.5694 & 0.3673 & 0.3673 & 0.8016 & 0.5 \tabularnewline
53 & 2.8 & 3.1 & 1.6724 & 7.6038 & 0.4481 & 0.603 & 0.7431 & 0.5 \tabularnewline
54 & 2.8 & 2.8141 & 1.4669 & 7.4419 & 0.4976 & 0.5024 & 0.6507 & 0.4518 \tabularnewline
55 & 2.5 & 2.6748 & 1.343 & 7.717 & 0.4729 & 0.4806 & 0.5884 & 0.4344 \tabularnewline
56 & 2.8 & 2.897 & 1.3548 & 10.0199 & 0.4893 & 0.5435 & 0.6186 & 0.4777 \tabularnewline
57 & 2.5 & 2.6748 & 1.2297 & 9.7002 & 0.4805 & 0.4861 & 0.5637 & 0.4528 \tabularnewline
58 & 1.6 & 2.3912 & 1.0973 & 8.7164 & 0.4032 & 0.4866 & 0.4619 & 0.4131 \tabularnewline
59 & 1.5 & 2.2402 & 1.0147 & 8.4755 & 0.408 & 0.5797 & 0.3814 & 0.3935 \tabularnewline
60 & 1.7 & 2.2943 & 0.9987 & 9.7829 & 0.4382 & 0.5823 & 0.4267 & 0.4165 \tabularnewline
61 & 1.3 & 2.2664 & 0.9614 & 10.4978 & 0.409 & 0.5536 & 0.4213 & 0.4213 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=70524&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]1.6[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]38[/C][C]1.7[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]39[/C][C]1.2[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]40[/C][C]1.6[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]41[/C][C]1.6[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]42[/C][C]1.9[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]43[/C][C]2.1[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]44[/C][C]1.8[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]45[/C][C]2.1[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]46[/C][C]2.7[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]47[/C][C]3.2[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]48[/C][C]3[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]49[/C][C]3.1[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][/ROW]
[ROW][C]50[/C][C]3.7[/C][C]2.9915[/C][C]2.1574[/C][C]4.4225[/C][C]0.1659[/C][C]0.4409[/C][C]0.9615[/C][C]0.4409[/C][/ROW]
[ROW][C]51[/C][C]3.7[/C][C]3.7695[/C][C]2.294[/C][C]7.3094[/C][C]0.4846[/C][C]0.5154[/C][C]0.9226[/C][C]0.6446[/C][/ROW]
[ROW][C]52[/C][C]2.5[/C][C]3.1[/C][C]1.798[/C][C]6.5694[/C][C]0.3673[/C][C]0.3673[/C][C]0.8016[/C][C]0.5[/C][/ROW]
[ROW][C]53[/C][C]2.8[/C][C]3.1[/C][C]1.6724[/C][C]7.6038[/C][C]0.4481[/C][C]0.603[/C][C]0.7431[/C][C]0.5[/C][/ROW]
[ROW][C]54[/C][C]2.8[/C][C]2.8141[/C][C]1.4669[/C][C]7.4419[/C][C]0.4976[/C][C]0.5024[/C][C]0.6507[/C][C]0.4518[/C][/ROW]
[ROW][C]55[/C][C]2.5[/C][C]2.6748[/C][C]1.343[/C][C]7.717[/C][C]0.4729[/C][C]0.4806[/C][C]0.5884[/C][C]0.4344[/C][/ROW]
[ROW][C]56[/C][C]2.8[/C][C]2.897[/C][C]1.3548[/C][C]10.0199[/C][C]0.4893[/C][C]0.5435[/C][C]0.6186[/C][C]0.4777[/C][/ROW]
[ROW][C]57[/C][C]2.5[/C][C]2.6748[/C][C]1.2297[/C][C]9.7002[/C][C]0.4805[/C][C]0.4861[/C][C]0.5637[/C][C]0.4528[/C][/ROW]
[ROW][C]58[/C][C]1.6[/C][C]2.3912[/C][C]1.0973[/C][C]8.7164[/C][C]0.4032[/C][C]0.4866[/C][C]0.4619[/C][C]0.4131[/C][/ROW]
[ROW][C]59[/C][C]1.5[/C][C]2.2402[/C][C]1.0147[/C][C]8.4755[/C][C]0.408[/C][C]0.5797[/C][C]0.3814[/C][C]0.3935[/C][/ROW]
[ROW][C]60[/C][C]1.7[/C][C]2.2943[/C][C]0.9987[/C][C]9.7829[/C][C]0.4382[/C][C]0.5823[/C][C]0.4267[/C][C]0.4165[/C][/ROW]
[ROW][C]61[/C][C]1.3[/C][C]2.2664[/C][C]0.9614[/C][C]10.4978[/C][C]0.409[/C][C]0.5536[/C][C]0.4213[/C][C]0.4213[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=70524&T=1

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=70524&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])
371.6-------
381.7-------
391.2-------
401.6-------
411.6-------
421.9-------
432.1-------
441.8-------
452.1-------
462.7-------
473.2-------
483-------
493.1-------
503.72.99152.15744.42250.16590.44090.96150.4409
513.73.76952.2947.30940.48460.51540.92260.6446
522.53.11.7986.56940.36730.36730.80160.5
532.83.11.67247.60380.44810.6030.74310.5
542.82.81411.46697.44190.49760.50240.65070.4518
552.52.67481.3437.7170.47290.48060.58840.4344
562.82.8971.354810.01990.48930.54350.61860.4777
572.52.67481.22979.70020.48050.48610.56370.4528
581.62.39121.09738.71640.40320.48660.46190.4131
591.52.24021.01478.47550.4080.57970.38140.3935
601.72.29430.99879.78290.43820.58230.42670.4165
611.32.26640.961410.49780.4090.55360.42130.4213







Univariate ARIMA Extrapolation Forecast Performance
time% S.E.PEMAPESq.EMSERMSE
500.24410.236800.50200
510.4791-0.01840.12760.00480.25340.5034
520.571-0.19350.14960.360.28890.5375
530.7412-0.09680.13640.090.23920.4891
540.8391-0.0050.11012e-040.19140.4375
550.9617-0.06540.10270.03060.16460.4057
561.2544-0.03350.09280.00940.14240.3774
571.34-0.06540.08940.03060.12840.3584
581.3496-0.33090.11620.6260.18370.4286
591.4201-0.33040.13760.54790.22010.4692
601.6653-0.2590.14870.35320.23220.4819
611.8531-0.42640.17180.93390.29070.5392

\begin{tabular}{lllllllll}
\hline
Univariate ARIMA Extrapolation Forecast Performance \tabularnewline
time & % S.E. & PE & MAPE & Sq.E & MSE & RMSE \tabularnewline
50 & 0.2441 & 0.2368 & 0 & 0.502 & 0 & 0 \tabularnewline
51 & 0.4791 & -0.0184 & 0.1276 & 0.0048 & 0.2534 & 0.5034 \tabularnewline
52 & 0.571 & -0.1935 & 0.1496 & 0.36 & 0.2889 & 0.5375 \tabularnewline
53 & 0.7412 & -0.0968 & 0.1364 & 0.09 & 0.2392 & 0.4891 \tabularnewline
54 & 0.8391 & -0.005 & 0.1101 & 2e-04 & 0.1914 & 0.4375 \tabularnewline
55 & 0.9617 & -0.0654 & 0.1027 & 0.0306 & 0.1646 & 0.4057 \tabularnewline
56 & 1.2544 & -0.0335 & 0.0928 & 0.0094 & 0.1424 & 0.3774 \tabularnewline
57 & 1.34 & -0.0654 & 0.0894 & 0.0306 & 0.1284 & 0.3584 \tabularnewline
58 & 1.3496 & -0.3309 & 0.1162 & 0.626 & 0.1837 & 0.4286 \tabularnewline
59 & 1.4201 & -0.3304 & 0.1376 & 0.5479 & 0.2201 & 0.4692 \tabularnewline
60 & 1.6653 & -0.259 & 0.1487 & 0.3532 & 0.2322 & 0.4819 \tabularnewline
61 & 1.8531 & -0.4264 & 0.1718 & 0.9339 & 0.2907 & 0.5392 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=70524&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.2441[/C][C]0.2368[/C][C]0[/C][C]0.502[/C][C]0[/C][C]0[/C][/ROW]
[ROW][C]51[/C][C]0.4791[/C][C]-0.0184[/C][C]0.1276[/C][C]0.0048[/C][C]0.2534[/C][C]0.5034[/C][/ROW]
[ROW][C]52[/C][C]0.571[/C][C]-0.1935[/C][C]0.1496[/C][C]0.36[/C][C]0.2889[/C][C]0.5375[/C][/ROW]
[ROW][C]53[/C][C]0.7412[/C][C]-0.0968[/C][C]0.1364[/C][C]0.09[/C][C]0.2392[/C][C]0.4891[/C][/ROW]
[ROW][C]54[/C][C]0.8391[/C][C]-0.005[/C][C]0.1101[/C][C]2e-04[/C][C]0.1914[/C][C]0.4375[/C][/ROW]
[ROW][C]55[/C][C]0.9617[/C][C]-0.0654[/C][C]0.1027[/C][C]0.0306[/C][C]0.1646[/C][C]0.4057[/C][/ROW]
[ROW][C]56[/C][C]1.2544[/C][C]-0.0335[/C][C]0.0928[/C][C]0.0094[/C][C]0.1424[/C][C]0.3774[/C][/ROW]
[ROW][C]57[/C][C]1.34[/C][C]-0.0654[/C][C]0.0894[/C][C]0.0306[/C][C]0.1284[/C][C]0.3584[/C][/ROW]
[ROW][C]58[/C][C]1.3496[/C][C]-0.3309[/C][C]0.1162[/C][C]0.626[/C][C]0.1837[/C][C]0.4286[/C][/ROW]
[ROW][C]59[/C][C]1.4201[/C][C]-0.3304[/C][C]0.1376[/C][C]0.5479[/C][C]0.2201[/C][C]0.4692[/C][/ROW]
[ROW][C]60[/C][C]1.6653[/C][C]-0.259[/C][C]0.1487[/C][C]0.3532[/C][C]0.2322[/C][C]0.4819[/C][/ROW]
[ROW][C]61[/C][C]1.8531[/C][C]-0.4264[/C][C]0.1718[/C][C]0.9339[/C][C]0.2907[/C][C]0.5392[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=70524&T=2

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=70524&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.24410.236800.50200
510.4791-0.01840.12760.00480.25340.5034
520.571-0.19350.14960.360.28890.5375
530.7412-0.09680.13640.090.23920.4891
540.8391-0.0050.11012e-040.19140.4375
550.9617-0.06540.10270.03060.16460.4057
561.2544-0.03350.09280.00940.14240.3774
571.34-0.06540.08940.03060.12840.3584
581.3496-0.33090.11620.6260.18370.4286
591.4201-0.33040.13760.54790.22010.4692
601.6653-0.2590.14870.35320.23220.4819
611.8531-0.42640.17180.93390.29070.5392



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