R version 3.0.2 (2013-09-25) -- "Frisbee Sailing" Copyright (C) 2013 The R Foundation for Statistical Computing Platform: i686-pc-linux-gnu (32-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > x <- c(1356.876334 + ,1267.205322 + ,1296.765977 + ,1088.768988 + ,974.9813884 + ,901.3596576 + ,697.4384802 + ,619.518781 + ,446.3076104 + ,279.7073872 + ,388.5496968 + ,290.3616669 + ,278.7900756 + ,433.3678289 + ,436.029714 + ,642.0796877 + ,800.8666721 + ,1005.060868 + ,986.1196671 + ,1320.620732 + ,1293.652614 + ,1315.564345 + ,1438.509653 + ,1311.68492 + ,1281.851742 + ,1229.184547 + ,1157.483378 + ,1049.930474 + ,720.8534348 + ,756.8141819 + ,587.8054359 + ,440.0632504 + ,476.8424862 + ,376.9041092 + ,408.9909215 + ,335.6074609 + ,510.7385144 + ,784.0262709 + ,868.9048671 + ,930.5891366 + ,1232.387738 + ,1433.973937 + ,1441.341759 + ,1560.894767 + ,1570.121112 + ,1539.736335 + ,1509.516021 + ,1264.261299 + ,1280.1511 + ,1104.198071 + ,867.0732077 + ,832.9038416 + ,551.1656185 + ,578.9382082 + ,548.7690841 + ,526.7505509 + ,543.7872669 + ,387.4285031 + ,583.0257696 + ,858.5103593 + ,835.2939603 + ,1234.576103 + ,1307.198241 + ,1550.368145 + ,1513.93417 + ,1607.433912 + ,1768.513076 + ,1778.655313 + ,1668.394241 + ,1383.577733 + ,1271.618447 + ,1140.579064 + ,998.7028247 + ,804.5968421 + ,743.1134557 + ,661.133487 + ,635.0605076 + ,334.5931783 + ,502.1494165 + ,450.8321675 + ,700.3681247 + ,799.3587889 + ,1068.293463 + ,1229.161035 + ,1369.983001 + ,1586.670588 + ,1649.664042 + ,1871.680788 + ,1816.035687 + ,1919.694672 + ,1817.473725 + ,1707.303794 + ,1606.456459 + ,1446.737592 + ,1005.045182 + ,913.67958 + ,694.7422417 + ,647.2193014 + ,603.2233095 + ,561.3616255 + ,477.9286605 + ,648.8516322 + ,676.4550378 + ,1016.256499 + ,1139.927185 + ,1269.321991 + ,1546.025319 + ,1753.304467 + ,1958.22963 + ,2094.065774 + ,1977.440699 + ,2027.739055 + ,1842.633768 + ,1852.639287 + ,1706.985147 + ,1471.71997 + ,1159.935346 + ,888.3265125 + ,747.4889418 + ,573.6363 + ,696.6030203 + ,736.0360216 + ,625.9859074 + ,668.0129992 + ,878.1341576 + ,925.7355157 + ,1384.068603 + ,1504.264376 + ,1677.525248 + ,1935.129054 + ,1995.385689 + ,2158.635275 + ,2278.786793 + ,2004.468115 + ,2055.40499 + ,1967.431468 + ,1770.334016 + ,1699.341376 + ,1476.810831 + ,970.7915825 + ,997.474492 + ,652.0843291 + ,708.677725 + ,656.5517255 + ,770.8461221 + ,901.3881145 + ,832.0016083 + ,1028.128263 + ,1296.071512 + ,1785.233557 + ,1804.294853 + ,2165.319782 + ,2274.425758 + ,2444.192672 + ,2254.896853 + ,2475.21364 + ,2096.602738 + ,2180.683121 + ,2069.506046 + ,1776.663609 + ,1612.449679 + ,1322.927331 + ,914.8881288 + ,749.3597793 + ,985.6467572 + ,880.7232311 + ,819.4581121 + ,760.5542696 + ,985.0475722 + ,1295.758114 + ,1683.545809 + ,1787.214405 + ,1972.790239 + ,2134.412385 + ,2263.189757 + ,2432.266646 + ,2369.774565 + ,2360.715385 + ,2432.992026 + ,2437.706015 + ,1921.308588 + ,1960.743986 + ,1481.140265 + ,1436.91711 + ,1299.84893 + ,985.736701 + ,805.8439046 + ,736.9963963 + ,898.3310247 + ,1065.843227 + ,1113.559476 + ,1211.918524 + ,1462.155718 + ,1801.38398 + ,2045.731198 + ,2405.387519 + ,2376.281401 + ,2542.194732 + ,2535.172687 + ,2518.76254 + ,2467.712934 + ,2483.547793 + ,2111.5245 + ,1987.469819 + ,1900.284914 + ,1545.174509 + ,1241.063215 + ,1244.17204 + ,1001.510714 + ,1004.787213 + ,1064.602774 + ,1250.752996 + ,1244.505238 + ,1565.513983 + ,1904.45973 + ,2200.393469 + ,2489.302736 + ,2382.022655 + ,2740.656964 + ,2692.201467 + ,2707.985974 + ,2793.734301 + ,2909.368555 + ,2611.616903 + ,2367.927913 + ,2036.392713 + ,1794.090508 + ,1658.074271 + ,1450.206111 + ,1159.117531 + ,1144.297116 + ,1188.107289 + ,1082.864685 + ,1152.30001 + ,1370.470201 + ,1560.414285 + ,1878.82661 + ,2213.171169 + ,2306.794427 + ,2878.274067 + ,3043.563683 + ,3163.511145 + ,3218.690493 + ,3177.601319 + ,2941.518453 + ,2922.823356 + ,2325.88093 + ,2414.009426 + ,1874.014382 + ,1866.949762 + ,1330.453111 + ,1413.735476 + ,988.2221384 + ,1046.533458 + ,1398.652585 + ,1444.958119 + ,1637.387943 + ,1926.364707 + ,2088.421239 + ,2250.892557 + ,2803.393628 + ,2920.006864 + ,3028.392467 + ,3284.085805 + ,3116.539112 + ,3120.244711 + ,2946.135624 + ,2740.67997 + ,2810.140837 + ,2233.823039 + ,2114.011418 + ,2076.542437 + ,1571.481405 + ,1567.958655 + ,1217.444043 + ,1136.643661 + ,1481.287919 + ,1528.477337 + ,1797.720002 + ,1819.469046 + ,2395.358987 + ,2707.314708 + ,2921.060577 + ,3246.433366 + ,3051.477548 + ,3444.481052 + ,3432.580153 + ,3421.04804 + ,3381.830601 + ,3169.679136 + ,2872.11508 + ,2601.76563 + ,2143.011809 + ,2159.598897 + ,1645.12941 + ,1622.54215 + ,1350.064447 + ,1372.486802 + ,1475.078831 + ,1356.08523 + ,1974.230192 + ,1835.493872 + ,2495.225532 + ,2813.660064 + ,3199.803837 + ,3128.428211 + ,3614.588977 + ,3741.816099 + ,3711.62971 + ,3501.116488 + ,3620.888016 + ,3348.935195) > par10 = 'FALSE' > par9 = '0' > par8 = '2' > par7 = '0' > par6 = '3' > par5 = '12' > par4 = '0' > par3 = '1' > par2 = '0.5' > par1 = '12' > 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')) Call: arima(x = x[1:nx], order = c(par6, par3, par7), seasonal = list(order = c(par8, par4, par9), period = par5), include.mean = par10, method = "ML") Coefficients: ar1 ar2 ar3 sar1 sar2 -0.1343 0.2691 0.1743 -0.2968 0.2636 s.e. 0.0698 0.0676 0.0587 0.0688 0.0612 sigma^2 estimated as 5.054: log likelihood = -668.52, aic = 1349.03 > (forecast <- predict(arima.out,par1)) $pred Time Series: Start = 301 End = 312 Frequency = 1 [1] 39.28247 39.94320 41.69361 42.69624 45.74199 46.56305 48.86713 49.73423 [9] 50.34023 51.16368 50.73849 51.18496 $se Time Series: Start = 301 End = 312 Frequency = 1 [1] 2.248038 2.973353 3.944189 4.845879 5.650571 6.429144 7.141270 [8] 7.810022 8.437950 9.028445 9.587861 10.118998 > (lb <- forecast$pred - 1.96 * forecast$se) Time Series: Start = 301 End = 312 Frequency = 1 [1] 34.87632 34.11543 33.96300 33.19832 34.66687 33.96192 34.87024 34.42658 [9] 33.80184 33.46793 31.94628 31.35172 > (ub <- forecast$pred + 1.96 * forecast$se) Time Series: Start = 301 End = 312 Frequency = 1 [1] 43.68863 45.77097 49.42422 52.19417 56.81710 59.16417 62.86402 65.04187 [9] 66.87861 68.85943 69.53069 71.01819 > 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)) [1] 1356.8763 1267.2053 1296.7660 1088.7690 974.9814 901.3597 697.4385 [8] 619.5188 446.3076 279.7074 388.5497 290.3617 278.7901 433.3678 [15] 436.0297 642.0797 800.8667 1005.0609 986.1197 1320.6207 1293.6526 [22] 1315.5643 1438.5097 1311.6849 1281.8517 1229.1845 1157.4834 1049.9305 [29] 720.8534 756.8142 587.8054 440.0633 476.8425 376.9041 408.9909 [36] 335.6075 510.7385 784.0263 868.9049 930.5891 1232.3877 1433.9739 [43] 1441.3418 1560.8948 1570.1211 1539.7363 1509.5160 1264.2613 1280.1511 [50] 1104.1981 867.0732 832.9038 551.1656 578.9382 548.7691 526.7506 [57] 543.7873 387.4285 583.0258 858.5104 835.2940 1234.5761 1307.1982 [64] 1550.3681 1513.9342 1607.4339 1768.5131 1778.6553 1668.3942 1383.5777 [71] 1271.6184 1140.5791 998.7028 804.5968 743.1135 661.1335 635.0605 [78] 334.5932 502.1494 450.8322 700.3681 799.3588 1068.2935 1229.1610 [85] 1369.9830 1586.6706 1649.6640 1871.6808 1816.0357 1919.6947 1817.4737 [92] 1707.3038 1606.4565 1446.7376 1005.0452 913.6796 694.7422 647.2193 [99] 603.2233 561.3616 477.9287 648.8516 676.4550 1016.2565 1139.9272 [106] 1269.3220 1546.0253 1753.3045 1958.2296 2094.0658 1977.4407 2027.7391 [113] 1842.6338 1852.6393 1706.9851 1471.7200 1159.9353 888.3265 747.4889 [120] 573.6363 696.6030 736.0360 625.9859 668.0130 878.1342 925.7355 [127] 1384.0686 1504.2644 1677.5252 1935.1291 1995.3857 2158.6353 2278.7868 [134] 2004.4681 2055.4050 1967.4315 1770.3340 1699.3414 1476.8108 970.7916 [141] 997.4745 652.0843 708.6777 656.5517 770.8461 901.3881 832.0016 [148] 1028.1283 1296.0715 1785.2336 1804.2949 2165.3198 2274.4258 2444.1927 [155] 2254.8969 2475.2136 2096.6027 2180.6831 2069.5060 1776.6636 1612.4497 [162] 1322.9273 914.8881 749.3598 985.6468 880.7232 819.4581 760.5543 [169] 985.0476 1295.7581 1683.5458 1787.2144 1972.7902 2134.4124 2263.1898 [176] 2432.2666 2369.7746 2360.7154 2432.9920 2437.7060 1921.3086 1960.7440 [183] 1481.1403 1436.9171 1299.8489 985.7367 805.8439 736.9964 898.3310 [190] 1065.8432 1113.5595 1211.9185 1462.1557 1801.3840 2045.7312 2405.3875 [197] 2376.2814 2542.1947 2535.1727 2518.7625 2467.7129 2483.5478 2111.5245 [204] 1987.4698 1900.2849 1545.1745 1241.0632 1244.1720 1001.5107 1004.7872 [211] 1064.6028 1250.7530 1244.5052 1565.5140 1904.4597 2200.3935 2489.3027 [218] 2382.0227 2740.6570 2692.2015 2707.9860 2793.7343 2909.3686 2611.6169 [225] 2367.9279 2036.3927 1794.0905 1658.0743 1450.2061 1159.1175 1144.2971 [232] 1188.1073 1082.8647 1152.3000 1370.4702 1560.4143 1878.8266 2213.1712 [239] 2306.7944 2878.2741 3043.5637 3163.5111 3218.6905 3177.6013 2941.5185 [246] 2922.8234 2325.8809 2414.0094 1874.0144 1866.9498 1330.4531 1413.7355 [253] 988.2221 1046.5335 1398.6526 1444.9581 1637.3879 1926.3647 2088.4212 [260] 2250.8926 2803.3936 2920.0069 3028.3925 3284.0858 3116.5391 3120.2447 [267] 2946.1356 2740.6800 2810.1408 2233.8230 2114.0114 2076.5424 1571.4814 [274] 1567.9587 1217.4440 1136.6437 1481.2879 1528.4773 1797.7200 1819.4690 [281] 2395.3590 2707.3147 2921.0606 3246.4334 3051.4775 3444.4811 3432.5802 [288] 3421.0480 3381.8306 3169.6791 2872.1151 2601.7656 2143.0118 2159.5989 [295] 1645.1294 1622.5421 1350.0644 1372.4868 1475.0788 1356.0852 1543.1126 [302] 1595.4594 1738.3570 1822.9691 2092.3293 2168.1172 2387.9966 2473.4933 [309] 2534.1384 2617.7219 2574.3939 2619.8998 > (perc.se <- (ub-forecast$pred)/1.96/forecast$pred) Time Series: Start = 301 End = 312 Frequency = 1 [1] 0.1208740 0.1597399 0.2067388 0.2522410 0.2769724 0.3135142 0.3341304 [8] 0.3624040 0.3903049 0.4139561 0.4479206 0.4719926 > postscript(file="/var/wessaorg/rcomp/tmp/1ft8j1386184217.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) > 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() null device 1 > 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) > postscript(file="/var/wessaorg/rcomp/tmp/2urmc1386184218.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) > 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() null device 1 > > #Note: the /var/wessaorg/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab > load(file="/var/wessaorg/rcomp/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="/var/wessaorg/rcomp/tmp/3ylnj1386184218.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="/var/wessaorg/rcomp/tmp/47btg1386184218.tab") > > try(system("convert tmp/1ft8j1386184217.ps tmp/1ft8j1386184217.png",intern=TRUE)) character(0) > try(system("convert tmp/2urmc1386184218.ps tmp/2urmc1386184218.png",intern=TRUE)) character(0) > > > proc.time() user system elapsed 5.222 1.394 6.754