R version 2.9.0 (2009-04-17) Copyright (C) 2009 The R Foundation for Statistical Computing ISBN 3-900051-07-0 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(153.3 + ,154.5 + ,155.2 + ,156.9 + ,157 + ,157.4 + ,157.2 + ,157.5 + ,158 + ,158.5 + ,159 + ,159.3 + ,160 + ,160.8 + ,161.9 + ,162.5 + ,162.7 + ,162.8 + ,162.9 + ,163 + ,164 + ,164.7 + ,164.8 + ,164.9 + ,165 + ,165.8 + ,166.1 + ,167.2 + ,167.7 + ,168.3 + ,168.6 + ,168.9 + ,169.1 + ,169.5 + ,169.6 + ,169.7 + ,169.8 + ,170.4 + ,170.9 + ,171.9 + ,171.9 + ,172 + ,172 + ,172.4 + ,173 + ,173.7 + ,173.8 + ,173.8 + ,173.9 + ,174.6 + ,175 + ,175.9 + ,176 + ,175.1 + ,175.6 + ,175.9 + ,176.7 + ,176.1 + ,176.1 + ,176.2 + ,176.3 + ,177.8 + ,178.5 + ,179.4 + ,179.5 + ,179.6 + ,179.7 + ,179.7 + ,179.8 + ,179.9 + ,180.2 + ,180.4 + ,180.4 + ,181.3 + ,181.9 + ,182.5 + ,182.7 + ,183.1 + ,183.6 + ,183.7 + ,183.8 + ,183.9 + ,184.1 + ,184.4 + ,184.5 + ,185.9 + ,186.6 + ,187.6 + ,187.8 + ,187.9 + ,188 + ,188.3 + ,188.4 + ,188.5 + ,188.5 + ,188.6 + ,188.6 + ,189.4 + ,190 + ,191.9 + ,192.5 + ,193 + ,193.5 + ,193.9 + ,194.2 + ,194.9 + ,194.9 + ,194.9 + ,194.9 + ,195.5 + ,196 + ,196.2 + ,196.2 + ,196.2 + ,196.2 + ,197 + ,197.7 + ,198 + ,198.2 + ,198.5 + ,198.6 + ,199.5 + ,200 + ,201.3 + ,202.2 + ,202.9 + ,203.5 + ,203.5 + ,204 + ,204.1 + ,204.3 + ,204.5 + ,204.8 + ,205.1 + ,205.7 + ,206.5 + ,206.9 + ,207.1 + ,207.8 + ,208 + ,208.5 + ,208.6 + ,209 + ,209.1 + ,209.7 + ,209.8 + ,209.9 + ,210 + ,210.8 + ,211.4 + ,211.7 + ,212 + ,212.2 + ,212.4 + ,212.9 + ,213.4 + ,213.7 + ,214 + ,214.3 + ,214.8 + ,215 + ,215.9 + ,216.4 + ,216.9 + ,217.2 + ,217.5 + ,217.9 + ,218.1 + ,218.6 + ,218.9 + ,219.3 + ,220.4 + ,220.9 + ,221 + ,221.8 + ,222 + ,222.2 + ,222.5 + ,222.9 + ,223.1 + ,223.4 + ,224 + ,225.1 + ,225.5 + ,225.9 + ,226.3 + ,226.5 + ,227 + ,227.3 + ,227.8 + ,228.1 + ,228.4 + ,228.5 + ,228.8 + ,229 + ,229.1 + ,229.3 + ,229.6 + ,229.9 + ,230 + ,230.2 + ,230.8 + ,231 + ,231.7 + ,231.9 + ,233 + ,235.1 + ,236 + ,236.9 + ,237.1 + ,237.5 + ,238.2 + ,238.9 + ,239.1 + ,240 + ,240.2 + ,240.5 + ,240.7 + ,241.1 + ,241.4 + ,242.2 + ,242.9 + ,243.2 + ,243.9) > par20 = '' > par19 = '' > par18 = '' > par17 = '' > par16 = '' > par15 = '' > par14 = '' > par13 = '' > par12 = '' > par11 = '' > par10 = 'FALSE' > par9 = '1' > par8 = '0' > par7 = '0' > par6 = '2' > par5 = '12' > par4 = '1' > par3 = '1' > par2 = '1' > par1 = '12' > ylab = '' > xlab = '' > main = '' > #'GNU S' R Code compiled by R2WASP v. 1.0.44 () > #Author: Prof. Dr. P. Wessa > #To cite this work: AUTHOR(S), (YEAR), YOUR SOFTWARE TITLE (vNUMBER) in Free Statistics Software (v$_version), Office for Research Development and Education, URL http://www.wessa.net/rwasp_YOURPAGE.wasp/ > #Source of accompanying publication: Office for Research, Development, and Education > #Technical description: Write here your technical program description (don't use hard returns!) > 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 sma1 0.1433 0.1447 -0.7904 s.e. 0.0706 0.0703 0.0607 sigma^2 estimated as 0.1081: log likelihood = -66.95, aic = 141.9 > (forecast <- predict(arima.out,fx)) $pred Time Series: Start = 213 End = 224 Frequency = 1 [1] 238.5618 238.9931 239.2994 239.6442 239.8947 240.5078 241.3397 241.9953 [9] 242.4786 242.8067 243.2021 243.5786 $se Time Series: Start = 213 End = 224 Frequency = 1 [1] 0.3288492 0.4995082 0.6593066 0.7953915 0.9162790 1.0245542 1.1232296 [8] 1.2142107 1.2989746 1.3785936 1.4538849 1.5254756 > (lb <- forecast$pred - 1.96 * forecast$se) Time Series: Start = 213 End = 224 Frequency = 1 [1] 237.9173 238.0141 238.0072 238.0852 238.0987 238.4997 239.1382 239.6155 [9] 239.9326 240.1047 240.3525 240.5887 > (ub <- forecast$pred + 1.96 * forecast$se) Time Series: Start = 213 End = 224 Frequency = 1 [1] 239.2064 239.9721 240.5917 241.2032 241.6906 242.5159 243.5412 244.3752 [9] 245.0245 245.5088 246.0517 246.5686 > 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] 153.3000 154.5000 155.2000 156.9000 157.0000 157.4000 157.2000 157.5000 [9] 158.0000 158.5000 159.0000 159.3000 160.0000 160.8000 161.9000 162.5000 [17] 162.7000 162.8000 162.9000 163.0000 164.0000 164.7000 164.8000 164.9000 [25] 165.0000 165.8000 166.1000 167.2000 167.7000 168.3000 168.6000 168.9000 [33] 169.1000 169.5000 169.6000 169.7000 169.8000 170.4000 170.9000 171.9000 [41] 171.9000 172.0000 172.0000 172.4000 173.0000 173.7000 173.8000 173.8000 [49] 173.9000 174.6000 175.0000 175.9000 176.0000 175.1000 175.6000 175.9000 [57] 176.7000 176.1000 176.1000 176.2000 176.3000 177.8000 178.5000 179.4000 [65] 179.5000 179.6000 179.7000 179.7000 179.8000 179.9000 180.2000 180.4000 [73] 180.4000 181.3000 181.9000 182.5000 182.7000 183.1000 183.6000 183.7000 [81] 183.8000 183.9000 184.1000 184.4000 184.5000 185.9000 186.6000 187.6000 [89] 187.8000 187.9000 188.0000 188.3000 188.4000 188.5000 188.5000 188.6000 [97] 188.6000 189.4000 190.0000 191.9000 192.5000 193.0000 193.5000 193.9000 [105] 194.2000 194.9000 194.9000 194.9000 194.9000 195.5000 196.0000 196.2000 [113] 196.2000 196.2000 196.2000 197.0000 197.7000 198.0000 198.2000 198.5000 [121] 198.6000 199.5000 200.0000 201.3000 202.2000 202.9000 203.5000 203.5000 [129] 204.0000 204.1000 204.3000 204.5000 204.8000 205.1000 205.7000 206.5000 [137] 206.9000 207.1000 207.8000 208.0000 208.5000 208.6000 209.0000 209.1000 [145] 209.7000 209.8000 209.9000 210.0000 210.8000 211.4000 211.7000 212.0000 [153] 212.2000 212.4000 212.9000 213.4000 213.7000 214.0000 214.3000 214.8000 [161] 215.0000 215.9000 216.4000 216.9000 217.2000 217.5000 217.9000 218.1000 [169] 218.6000 218.9000 219.3000 220.4000 220.9000 221.0000 221.8000 222.0000 [177] 222.2000 222.5000 222.9000 223.1000 223.4000 224.0000 225.1000 225.5000 [185] 225.9000 226.3000 226.5000 227.0000 227.3000 227.8000 228.1000 228.4000 [193] 228.5000 228.8000 229.0000 229.1000 229.3000 229.6000 229.9000 230.0000 [201] 230.2000 230.8000 231.0000 231.7000 231.9000 233.0000 235.1000 236.0000 [209] 236.9000 237.1000 237.5000 238.2000 238.5618 238.9931 239.2994 239.6442 [217] 239.8947 240.5078 241.3397 241.9953 242.4786 242.8067 243.2021 243.5786 > (perc.se <- (ub-forecast$pred)/1.96/forecast$pred) Time Series: Start = 213 End = 224 Frequency = 1 [1] 0.001378465 0.002090053 0.002755153 0.003319052 0.003819506 0.004259963 [7] 0.004654143 0.005017497 0.005357070 0.005677741 0.005978094 0.006262764 > postscript(file="/var/www/html/rcomp/tmp/1zj051260537772.ps",horizontal=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.se <- array(0, dim=fx) > perf.mse <- 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.mape[i] = perf.mape[i] + abs(perf.pe[i]) + perf.se[i] = (x[nx+i] - forecast$pred[i])^2 + perf.mse[i] = perf.mse[i] + perf.se[i] + 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 = perf.mape / fx > perf.mse = perf.mse / fx > perf.rmse = sqrt(perf.mse) > postscript(file="/var/www/html/rcomp/tmp/28fir1260537772.ps",horizontal=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:12] <- x[(nx+1):lx] > lines(dum, lty=1) > lines(ub,lty=3) > lines(lb,lty=3) > dev.off() null device 1 > > #Note: the /var/www/html/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab > load(file="/var/www/html/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/www/html/rcomp/tmp/3igeo1260537772.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.mape[i],4)) + a<-table.element(a,round(perf.se[i],4)) + a<-table.element(a,round(perf.mse[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/www/html/rcomp/tmp/4x03y1260537772.tab") > > system("convert tmp/1zj051260537772.ps tmp/1zj051260537772.png") > system("convert tmp/28fir1260537772.ps tmp/28fir1260537772.png") > > > proc.time() user system elapsed 0.877 0.311 1.092