Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data:
52.61 65.04 67.54 63.58 57.35 54.93 54.30 58.89 65.95 82.65 100.08 100.68 97.53 92.29 85.08 91.61 93.61 90.40 99.31 107.71 106.18 98.80 99.58 98.85 92.69 91.82 92.63 98.41 94.56 85.78 84.59 83.49 84.68 80.12 84.37 85.94 87.07 84.52 83.13 75.95 70.12 78.10 83.06 87.92 90.21 89.95 97.08 102.08 100.64 97.73 97.61 100.32 102.04 107.80 111.51 110.18 110.08 117.40 119.82 118.79 113.18 122.76 120.43 129.16 132.48 135.68 141.49 122.40 137.06 144.84 154.64 148.04 152.76 172.00 169.03 179.68 190.38 233.23 231.45 244.87 299.12 385.01 381.48 321.56 317.27 323.09 392.72 372.37 386.52 412.83 404.91 406.73 392.41 363.31 357.95 375.10 369.74 386.14 353.40 346.87 362.53 349.87 347.03 332.94 327.48 327.92 308.91 285.71 318.81 284.76 301.04 315.16 388.34 383.37 416.77 423.24 429.90 486.07 394.41 410.93 430.88 447.29 431.65 456.53 452.93 440.90 416.46 451.49 432.00 436.19 428.55 421.40 425.18 437.24 431.92 412.65 419.37 436.40 421.37 423.66 402.45 402.82 400.46 425.73 417.93 403.43 404.96 393.64 399.98 375.93 366.57 353.90 347.51 364.10 328.64 348.01 329.63 350.96 336.16 332.15 349.46 383.64 369.82 345.50 337.80 334.76 338.02 346.74 371.84 375.90 373.31 391.91 374.28 384.69 372.16 371.97 351.76 352.89 330.48 347.70 345.58 360.76 364.40 374.62 369.07 341.80 337.87 336.58 332.66 335.74 321.64 329.38 321.84 324.56 330.90 310.91 318.07 312.36 315.19 332.89 310.67 321.26 316.15 283.87 280.65 280.21 265.93 267.80 278.03 291.86 262.61 264.80 265.67 251.05 256.11 279.75 282.52 288.89 308.46 292.89 280.79 273.61 276.67 277.92 250.28 264.70 268.95 261.69 257.99 251.28 243.14 246.81 224.50 241.25 254.97 261.39 266.67 264.28 270.45 274.97 281.13 300.65 321.12 354.79 318.97 298.71 318.85 327.89 348.19 335.18 332.98 331.04 317.52 325.31 317.59 313.37 313.00 314.77 298.37 311.10 308.79 297.30 293.58 291.35 291.51 289.94 287.07 280.74 294.95 288.98 285.63 294.55 290.67 314.78 306.50 304.48 308.65 307.01 298.59 293.51 294.90 296.14 294.25 291.75 290.49 288.68 310.07 297.45 300.81 301.56 296.89 305.23 298.45 298.75 273.02 266.62 266.06 284.48 275.71 284.19 284.81 267.29 272.95 262.35 246.34 251.03 247.54 254.80 245.08 251.30 261.48 258.85 270.89 257.55 253.08 238.81 241.22 280.75 284.56 289.35 289.56 289.55 305.00 289.22 301.82 293.56 300.59 298.67 311.55 310.08 312.06 309.13 292.31 284.41 290.02 291.52 296.81 315.60 319.63 303.89 300.53 321.84 309.48 307.68 310.53 327.91 343.18 345.48 342.03 349.57 322.50 310.74 318.96 327.53 320.00 320.72 330.86 342.34 322.37 306.86 301.75 307.27 301.30 315.18 342.11 333.18 332.26 332.32 330.00 321.78 318.59 344.78 324.09 322.03 325.32 325.10 335.10 334.66 334.54 341.15 320.47 323.85 328.06 328.93 337.50 335.65 361.05 353.19 352.28 392.53 393.03 420.42 434.91 468.38 466.35 480.93 511.25 508.39 479.80 495.63 487.09 473.06 473.03 487.87 479.28 500.60 502.82 497.13 496.06 489.80 481.66 486.17 492.94 522.45 545.71 533.77 570.26 623.56 639.94 589.13 559.45 569.96 590.43 588.37 565.80 629.69 576.28 641.89 625.70 717.52 749.58 690.29 666.55 689.18 666.24 662.32 665.83 681.23 704.87 783.13 757.97 775.93 812.08 824.40 886.89 984.07 1015.59 897.30 980.37 957.37 968.96 1062.80 1047.67 967.91 1021.58 1014.02 1034.98 1068.80 1038.38 1133.26 1259.55 1207.42 1234.59 1297.03
Include mean?
1.0
FALSE
TRUE
Box-Cox lambda transformation parameter (lambda)
1
1
-2.0
-1.9
-1.8
-1.7
-1.6
-1.5
-1.4
-1.3
-1.2
-1.1
-1.0
-0.9
-0.8
-0.7
-0.6
-0.5
-0.4
-0.3
-0.2
-0.1
0.0
0.1
0.2
0.3
0.4
0.5
0.6
0.7
0.8
0.9
1.0
1.1
1.2
1.3
1.4
1.5
1.6
1.7
1.8
1.9
2.0
Degree of non-seasonal differencing (d)
1
0
1
2
Degree of seasonal differencing (D)
12
0
1
Seasonal Period (s)
1
2
3
4
6
12
Maximum AR(p) order
0
1
2
3
Maximum MA(q) order
0
1
Maximum SAR(P) order
0
1
2
Maximum SMA(Q) order
0
1
Chart options
R Code
library(lattice) if (par1 == 'TRUE') par1 <- TRUE if (par1 == 'FALSE') par1 <- FALSE par2 <- as.numeric(par2) #Box-Cox lambda transformation parameter 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) #degree (p) of the non-seasonal AR(p) polynomial par7 <- as.numeric(par7) #degree (q) of the non-seasonal MA(q) polynomial par8 <- as.numeric(par8) #degree (P) of the seasonal AR(P) polynomial par9 <- as.numeric(par9) #degree (Q) of the seasonal MA(Q) polynomial armaGR <- function(arima.out, names, n){ try1 <- arima.out$coef try2 <- sqrt(diag(arima.out$var.coef)) try.data.frame <- data.frame(matrix(NA,ncol=4,nrow=length(names))) dimnames(try.data.frame) <- list(names,c('coef','std','tstat','pv')) try.data.frame[,1] <- try1 for(i in 1:length(try2)) try.data.frame[which(rownames(try.data.frame)==names(try2)[i]),2] <- try2[i] try.data.frame[,3] <- try.data.frame[,1] / try.data.frame[,2] try.data.frame[,4] <- round((1-pt(abs(try.data.frame[,3]),df=n-(length(try2)+1)))*2,5) vector <- rep(NA,length(names)) vector[is.na(try.data.frame[,4])] <- 0 maxi <- which.max(try.data.frame[,4]) continue <- max(try.data.frame[,4],na.rm=TRUE) > .05 vector[maxi] <- 0 list(summary=try.data.frame,next.vector=vector,continue=continue) } arimaSelect <- function(series, order=c(13,0,0), seasonal=list(order=c(2,0,0),period=12), include.mean=F){ nrc <- order[1]+order[3]+seasonal$order[1]+seasonal$order[3] coeff <- matrix(NA, nrow=nrc*2, ncol=nrc) pval <- matrix(NA, nrow=nrc*2, ncol=nrc) mylist <- rep(list(NULL), nrc) names <- NULL if(order[1] > 0) names <- paste('ar',1:order[1],sep='') if(order[3] > 0) names <- c( names , paste('ma',1:order[3],sep='') ) if(seasonal$order[1] > 0) names <- c(names, paste('sar',1:seasonal$order[1],sep='')) if(seasonal$order[3] > 0) names <- c(names, paste('sma',1:seasonal$order[3],sep='')) arima.out <- arima(series, order=order, seasonal=seasonal, include.mean=include.mean, method='ML') mylist[[1]] <- arima.out last.arma <- armaGR(arima.out, names, length(series)) mystop <- FALSE i <- 1 coeff[i,] <- last.arma[[1]][,1] pval [i,] <- last.arma[[1]][,4] i <- 2 aic <- arima.out$aic while(!mystop){ mylist[[i]] <- arima.out arima.out <- arima(series, order=order, seasonal=seasonal, include.mean=include.mean, method='ML', fixed=last.arma$next.vector) aic <- c(aic, arima.out$aic) last.arma <- armaGR(arima.out, names, length(series)) mystop <- !last.arma$continue coeff[i,] <- last.arma[[1]][,1] pval [i,] <- last.arma[[1]][,4] i <- i+1 } list(coeff, pval, mylist, aic=aic) } arimaSelectplot <- function(arimaSelect.out,noms,choix){ noms <- names(arimaSelect.out[[3]][[1]]$coef) coeff <- arimaSelect.out[[1]] k <- min(which(is.na(coeff[,1])))-1 coeff <- coeff[1:k,] pval <- arimaSelect.out[[2]][1:k,] aic <- arimaSelect.out$aic[1:k] coeff[coeff==0] <- NA n <- ncol(coeff) if(missing(choix)) choix <- k layout(matrix(c(1,1,1,2, 3,3,3,2, 3,3,3,4, 5,6,7,7),nr=4), widths=c(10,35,45,15), heights=c(30,30,15,15)) couleurs <- rainbow(75)[1:50]#(50) ticks <- pretty(coeff) par(mar=c(1,1,3,1)) plot(aic,k:1-.5,type='o',pch=21,bg='blue',cex=2,axes=F,lty=2,xpd=NA) points(aic[choix],k-choix+.5,pch=21,cex=4,bg=2,xpd=NA) title('aic',line=2) par(mar=c(3,0,0,0)) plot(0,axes=F,xlab='',ylab='',xlim=range(ticks),ylim=c(.1,1)) rect(xleft = min(ticks) + (0:49)/50*(max(ticks)-min(ticks)), xright = min(ticks) + (1:50)/50*(max(ticks)-min(ticks)), ytop = rep(1,50), ybottom= rep(0,50),col=couleurs,border=NA) axis(1,ticks) rect(xleft=min(ticks),xright=max(ticks),ytop=1,ybottom=0) text(mean(coeff,na.rm=T),.5,'coefficients',cex=2,font=2) par(mar=c(1,1,3,1)) image(1:n,1:k,t(coeff[k:1,]),axes=F,col=couleurs,zlim=range(ticks)) for(i in 1:n) for(j in 1:k) if(!is.na(coeff[j,i])) { if(pval[j,i]<.01) symb = 'green' else if( (pval[j,i]<.05) & (pval[j,i]>=.01)) symb = 'orange' else if( (pval[j,i]<.1) & (pval[j,i]>=.05)) symb = 'red' else symb = 'black' polygon(c(i+.5 ,i+.2 ,i+.5 ,i+.5), c(k-j+0.5,k-j+0.5,k-j+0.8,k-j+0.5), col=symb) if(j==choix) { rect(xleft=i-.5, xright=i+.5, ybottom=k-j+1.5, ytop=k-j+.5, lwd=4) text(i, k-j+1, round(coeff[j,i],2), cex=1.2, font=2) } else{ rect(xleft=i-.5,xright=i+.5,ybottom=k-j+1.5,ytop=k-j+.5) text(i,k-j+1,round(coeff[j,i],2),cex=1.2,font=1) } } axis(3,1:n,noms) par(mar=c(0.5,0,0,0.5)) plot(0,axes=F,xlab='',ylab='',type='n',xlim=c(0,8),ylim=c(-.2,.8)) cols <- c('green','orange','red','black') niv <- c('0','0.01','0.05','0.1') for(i in 0:3){ polygon(c(1+2*i ,1+2*i ,1+2*i-.5 ,1+2*i), c(.4 ,.7 , .4 , .4), col=cols[i+1]) text(2*i,0.5,niv[i+1],cex=1.5) } text(8,.5,1,cex=1.5) text(4,0,'p-value',cex=2) box() residus <- arimaSelect.out[[3]][[choix]]$res par(mar=c(1,2,4,1)) acf(residus,main='') title('acf',line=.5) par(mar=c(1,2,4,1)) pacf(residus,main='') title('pacf',line=.5) par(mar=c(2,2,4,1)) qqnorm(residus,main='') title('qq-norm',line=.5) qqline(residus) residus } if (par2 == 0) x <- log(x) if (par2 != 0) x <- x^par2 (selection <- arimaSelect(x, order=c(par6,par3,par7), seasonal=list(order=c(par8,par4,par9), period=par5))) bitmap(file='test1.png') resid <- arimaSelectplot(selection) dev.off() resid bitmap(file='test2.png') acf(resid,length(resid)/2, main='Residual Autocorrelation Function') dev.off() bitmap(file='test3.png') pacf(resid,length(resid)/2, main='Residual Partial Autocorrelation Function') dev.off() bitmap(file='test4.png') cpgram(resid, main='Residual Cumulative Periodogram') dev.off() bitmap(file='test5.png') hist(resid, main='Residual Histogram', xlab='values of Residuals') dev.off() bitmap(file='test6.png') densityplot(~resid,col='black',main='Residual Density Plot', xlab='values of Residuals') dev.off() bitmap(file='test7.png') qqnorm(resid, main='Residual Normal Q-Q Plot') qqline(resid) dev.off() ncols <- length(selection[[1]][1,]) nrows <- length(selection[[2]][,1])-1 load(file='createtable') a<-table.start() a<-table.row.start(a) a<-table.element(a,'ARIMA Parameter Estimation and Backward Selection', ncols+1,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Iteration', header=TRUE) for (i in 1:ncols) { a<-table.element(a,names(selection[[3]][[1]]$coef)[i],header=TRUE) } a<-table.row.end(a) for (j in 1:nrows) { a<-table.row.start(a) mydum <- 'Estimates (' mydum <- paste(mydum,j) mydum <- paste(mydum,')') a<-table.element(a,mydum, header=TRUE) for (i in 1:ncols) { a<-table.element(a,round(selection[[1]][j,i],4)) } a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'(p-val)', header=TRUE) for (i in 1:ncols) { mydum <- '(' mydum <- paste(mydum,round(selection[[2]][j,i],4),sep='') mydum <- paste(mydum,')') a<-table.element(a,mydum) } 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,'Estimated ARIMA Residuals', 1,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Value', 1,TRUE) a<-table.row.end(a) for (i in (par4*par5+par3):length(resid)) { a<-table.row.start(a) a<-table.element(a,resid[i]) a<-table.row.end(a) } a<-table.end(a) table.save(a,file='mytable1.tab')
Compute
Summary of computational transaction
Raw Input
view raw input (R code)
Raw Output
view raw output of R engine
Computing time
0 seconds
R Server
Big Analytics Cloud Computing Center
Click here to blog (archive) this computation