R version 2.15.2 (2012-10-26) -- "Trick or Treat" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 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(41 + ,48 + ,52 + ,53 + ,65 + ,68 + ,64 + ,57 + ,55 + ,54 + ,59 + ,66 + ,83 + ,100 + ,101 + ,98 + ,92 + ,85 + ,92 + ,94 + ,90 + ,99 + ,108 + ,106 + ,99 + ,100 + ,99 + ,93 + ,92 + ,93 + ,98 + ,95 + ,86 + ,85 + ,83 + ,85 + ,80 + ,84 + ,86 + ,87 + ,85 + ,83 + ,76 + ,70 + ,78 + ,83 + ,88 + ,90 + ,90 + ,97 + ,102 + ,101 + ,98 + ,98 + ,100 + ,102 + ,108 + ,112 + ,110 + ,110 + ,117 + ,120 + ,119 + ,113 + ,123 + ,120 + ,129 + ,132 + ,136 + ,141 + ,122 + ,137 + ,145 + ,155 + ,148 + ,153 + ,172 + ,169 + ,180 + ,190 + ,233 + ,231 + ,245 + ,299 + ,385 + ,381 + ,322 + ,317 + ,323 + ,393 + ,372 + ,387 + ,413 + ,405 + ,407 + ,392 + ,363 + ,358 + ,375 + ,370 + ,386 + ,353 + ,347 + ,363 + ,350 + ,347 + ,333 + ,327 + ,328 + ,309 + ,286 + ,319 + ,285 + ,301 + ,315 + ,388 + ,383 + ,417 + ,423 + ,430 + ,486 + ,394 + ,411 + ,431 + ,447 + ,432 + ,457 + ,453 + ,441 + ,416 + ,451 + ,432 + ,436 + ,429 + ,421 + ,425 + ,437 + ,432 + ,413 + ,419 + ,436 + ,421 + ,424 + ,402 + ,403 + ,400 + ,426 + ,418 + ,403 + ,405 + ,394 + ,400 + ,376 + ,367 + ,354 + ,348 + ,364 + ,329 + ,348 + ,330 + ,351 + ,336 + ,332 + ,349 + ,384 + ,370 + ,346 + ,338 + ,335 + ,338 + ,347 + ,372 + ,376 + ,373 + ,392 + ,374 + ,385 + ,372 + ,372 + ,352 + ,353 + ,330 + ,348 + ,346 + ,361 + ,364 + ,375 + ,369 + ,342 + ,338 + ,337 + ,333 + ,336 + ,322 + ,329 + ,322 + ,325 + ,331 + ,311 + ,318 + ,312 + ,315 + ,333 + ,311 + ,321 + ,316 + ,284 + ,281 + ,280 + ,266 + ,268 + ,278 + ,292 + ,263 + ,265 + ,266 + ,251 + ,256 + ,280 + ,283 + ,289 + ,308 + ,293 + ,281 + ,274 + ,277 + ,278 + ,250 + ,265 + ,269 + ,262 + ,258 + ,251 + ,243 + ,247 + ,224 + ,241 + ,255 + ,261 + ,267 + ,264 + ,270 + ,275 + ,281 + ,301 + ,321 + ,355 + ,319 + ,299 + ,319 + ,328 + ,348 + ,335 + ,333 + ,331 + ,318 + ,325 + ,318 + ,313 + ,313 + ,315 + ,298 + ,311 + ,309 + ,297 + ,294 + ,291 + ,292 + ,290 + ,287 + ,281 + ,295 + ,289 + ,286 + ,295 + ,291 + ,315 + ,306 + ,304 + ,309 + ,307 + ,299 + ,294 + ,295 + ,296 + ,294 + ,292 + ,290 + ,289 + ,310 + ,297 + ,301 + ,302 + ,297 + ,305 + ,298 + ,299 + ,273 + ,267 + ,266 + ,284 + ,276 + ,284 + ,285 + ,267 + ,273 + ,262 + ,246 + ,251 + ,248 + ,255 + ,245 + ,251 + ,261 + ,259 + ,271 + ,258 + ,253 + ,239 + ,241 + ,281 + ,285 + ,289 + ,290 + ,290 + ,305 + ,289 + ,302 + ,294 + ,301 + ,299 + ,312 + ,310 + ,312 + ,309 + ,292 + ,284 + ,290 + ,292 + ,297 + ,316 + ,320 + ,304 + ,301 + ,322 + ,309 + ,308 + ,311 + ,328 + ,343 + ,345 + ,342 + ,350 + ,322 + ,311 + ,319 + ,328 + ,320 + ,321 + ,331 + ,342 + ,322 + ,307 + ,302 + ,307 + ,301 + ,315 + ,342 + ,333 + ,332 + ,332 + ,330 + ,322 + ,319 + ,345 + ,324 + ,322 + ,325 + ,325 + ,335 + ,335 + ,335 + ,341 + ,320 + ,324 + ,328 + ,329 + ,338 + ,336 + ,361 + ,353 + ,352 + ,393 + ,393 + ,420 + ,435 + ,468 + ,466 + ,481 + ,511 + ,508 + ,480 + ,496 + ,487 + ,473 + ,473 + ,488 + ,479 + ,501 + ,503 + ,497 + ,496 + ,490 + ,482 + ,486 + ,493 + ,522 + ,546 + ,534 + ,570 + ,624 + ,640 + ,589 + ,559 + ,570 + ,590 + ,588 + ,566 + ,630 + ,576 + ,642 + ,626 + ,718 + ,750 + ,690 + ,667 + ,689 + ,666 + ,662 + ,666 + ,681 + ,705 + ,783 + ,758 + ,776 + ,812 + ,824 + ,887 + ,984 + ,1016 + ,897 + ,980 + ,957 + ,969 + ,1063 + ,1048 + ,968 + ,1022 + ,1014 + ,1035 + ,1069 + ,1038 + ,1133 + ,1260 + ,1207 + ,1235 + ,1297 + ,1179 + ,1332 + ,1323 + ,1248 + ,1248 + ,1260 + ,1260 + ,1317 + ,1308 + ,1380 + ,1327 + ,1327) > par10 = 'FALSE' > par9 = '1' > par8 = '0' > par7 = '0' > par6 = '0' > par5 = '12' > par4 = '1' > par3 = '1' > par2 = '0.3' > 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: sma1 -0.9980 s.e. 0.1732 sigma^2 estimated as 0.008587: log likelihood = 414.25, aic = -824.5 > (forecast <- predict(arima.out,par1)) $pred Time Series: Start = 468 End = 479 Frequency = 1 [1] 8.582260 8.627144 8.635053 8.628615 8.636332 8.660635 8.657734 8.655700 [9] 8.675549 8.703497 8.696458 8.730950 $se Time Series: Start = 468 End = 479 Frequency = 1 [1] 0.09378535 0.13263252 0.16242323 0.18753994 0.20966914 0.22967601 [7] 0.24807457 0.26519976 0.28128425 0.29649747 0.31096732 0.32479315 > (lb <- forecast$pred - 1.96 * forecast$se) Time Series: Start = 468 End = 479 Frequency = 1 [1] 8.398441 8.367184 8.316704 8.261036 8.225380 8.210470 8.171508 8.135908 [9] 8.124232 8.122362 8.086962 8.094355 > (ub <- forecast$pred + 1.96 * forecast$se) Time Series: Start = 468 End = 479 Frequency = 1 [1] 8.766079 8.887104 8.953403 8.996193 9.047283 9.110800 9.143960 9.175491 [9] 9.226867 9.284632 9.305954 9.367544 > 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] 41.000 48.000 52.000 53.000 65.000 68.000 64.000 57.000 [9] 55.000 54.000 59.000 66.000 83.000 100.000 101.000 98.000 [17] 92.000 85.000 92.000 94.000 90.000 99.000 108.000 106.000 [25] 99.000 100.000 99.000 93.000 92.000 93.000 98.000 95.000 [33] 86.000 85.000 83.000 85.000 80.000 84.000 86.000 87.000 [41] 85.000 83.000 76.000 70.000 78.000 83.000 88.000 90.000 [49] 90.000 97.000 102.000 101.000 98.000 98.000 100.000 102.000 [57] 108.000 112.000 110.000 110.000 117.000 120.000 119.000 113.000 [65] 123.000 120.000 129.000 132.000 136.000 141.000 122.000 137.000 [73] 145.000 155.000 148.000 153.000 172.000 169.000 180.000 190.000 [81] 233.000 231.000 245.000 299.000 385.000 381.000 322.000 317.000 [89] 323.000 393.000 372.000 387.000 413.000 405.000 407.000 392.000 [97] 363.000 358.000 375.000 370.000 386.000 353.000 347.000 363.000 [105] 350.000 347.000 333.000 327.000 328.000 309.000 286.000 319.000 [113] 285.000 301.000 315.000 388.000 383.000 417.000 423.000 430.000 [121] 486.000 394.000 411.000 431.000 447.000 432.000 457.000 453.000 [129] 441.000 416.000 451.000 432.000 436.000 429.000 421.000 425.000 [137] 437.000 432.000 413.000 419.000 436.000 421.000 424.000 402.000 [145] 403.000 400.000 426.000 418.000 403.000 405.000 394.000 400.000 [153] 376.000 367.000 354.000 348.000 364.000 329.000 348.000 330.000 [161] 351.000 336.000 332.000 349.000 384.000 370.000 346.000 338.000 [169] 335.000 338.000 347.000 372.000 376.000 373.000 392.000 374.000 [177] 385.000 372.000 372.000 352.000 353.000 330.000 348.000 346.000 [185] 361.000 364.000 375.000 369.000 342.000 338.000 337.000 333.000 [193] 336.000 322.000 329.000 322.000 325.000 331.000 311.000 318.000 [201] 312.000 315.000 333.000 311.000 321.000 316.000 284.000 281.000 [209] 280.000 266.000 268.000 278.000 292.000 263.000 265.000 266.000 [217] 251.000 256.000 280.000 283.000 289.000 308.000 293.000 281.000 [225] 274.000 277.000 278.000 250.000 265.000 269.000 262.000 258.000 [233] 251.000 243.000 247.000 224.000 241.000 255.000 261.000 267.000 [241] 264.000 270.000 275.000 281.000 301.000 321.000 355.000 319.000 [249] 299.000 319.000 328.000 348.000 335.000 333.000 331.000 318.000 [257] 325.000 318.000 313.000 313.000 315.000 298.000 311.000 309.000 [265] 297.000 294.000 291.000 292.000 290.000 287.000 281.000 295.000 [273] 289.000 286.000 295.000 291.000 315.000 306.000 304.000 309.000 [281] 307.000 299.000 294.000 295.000 296.000 294.000 292.000 290.000 [289] 289.000 310.000 297.000 301.000 302.000 297.000 305.000 298.000 [297] 299.000 273.000 267.000 266.000 284.000 276.000 284.000 285.000 [305] 267.000 273.000 262.000 246.000 251.000 248.000 255.000 245.000 [313] 251.000 261.000 259.000 271.000 258.000 253.000 239.000 241.000 [321] 281.000 285.000 289.000 290.000 290.000 305.000 289.000 302.000 [329] 294.000 301.000 299.000 312.000 310.000 312.000 309.000 292.000 [337] 284.000 290.000 292.000 297.000 316.000 320.000 304.000 301.000 [345] 322.000 309.000 308.000 311.000 328.000 343.000 345.000 342.000 [353] 350.000 322.000 311.000 319.000 328.000 320.000 321.000 331.000 [361] 342.000 322.000 307.000 302.000 307.000 301.000 315.000 342.000 [369] 333.000 332.000 332.000 330.000 322.000 319.000 345.000 324.000 [377] 322.000 325.000 325.000 335.000 335.000 335.000 341.000 320.000 [385] 324.000 328.000 329.000 338.000 336.000 361.000 353.000 352.000 [393] 393.000 393.000 420.000 435.000 468.000 466.000 481.000 511.000 [401] 508.000 480.000 496.000 487.000 473.000 473.000 488.000 479.000 [409] 501.000 503.000 497.000 496.000 490.000 482.000 486.000 493.000 [417] 522.000 546.000 534.000 570.000 624.000 640.000 589.000 559.000 [425] 570.000 590.000 588.000 566.000 630.000 576.000 642.000 626.000 [433] 718.000 750.000 690.000 667.000 689.000 666.000 662.000 666.000 [441] 681.000 705.000 783.000 758.000 776.000 812.000 824.000 887.000 [449] 984.000 1016.000 897.000 980.000 957.000 969.000 1063.000 1048.000 [457] 968.000 1022.000 1014.000 1035.000 1069.000 1038.000 1133.000 1260.000 [465] 1207.000 1235.000 1297.000 1294.212 1316.912 1320.941 1317.661 1321.593 [473] 1334.031 1332.542 1331.498 1341.704 1356.165 1352.513 1370.477 > (perc.se <- (ub-forecast$pred)/1.96/forecast$pred) Time Series: Start = 468 End = 479 Frequency = 1 [1] 0.03734496 0.05307195 0.06544030 0.07611795 0.08551315 0.09388342 [7] 0.10192669 0.10947629 0.11631567 0.12266465 0.12924443 0.13489263 > postscript(file="/var/wessaorg/rcomp/tmp/1v1fb1356122649.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/2ml841356122649.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/3gtg01356122649.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/4rura1356122649.tab") > > try(system("convert tmp/1v1fb1356122649.ps tmp/1v1fb1356122649.png",intern=TRUE)) character(0) > try(system("convert tmp/2ml841356122649.ps tmp/2ml841356122649.png",intern=TRUE)) character(0) > > > proc.time() user system elapsed 1.888 0.278 2.287