We examine Industrial Petroleum Consumption and OPEC Oil Imports, or petrol for short. (The two series are available from Department of Energy, Energy Information Administration.) Both series cover the period January 1973 through December 2016, and are seasonally adjusted. Industrial Petroleum Consumption is U.S. Product Supplied of Crude Oil and Petroleum Products, Monthly, in Thousand Barrels per Day. OPEC Oil Imports is Petroleum Imports from OPEC, in Thousand Barrels per Day. We perform a bivariate analysis by fitting the Local Level Model (LLM).
This code installs and loads the packages, and loads the data into a variable named petrol.
library(devtools) library(Rcpp) devtools::install_github("tuckermcelroy/sigex") library(sigex)
start.date = c(1973,1) period <- 12
dataALL.ts <- sigex.load(petrol[,c(1,2)],start.date,period, c("Consumption","Imports"),TRUE)
transform <- "log" aggregate <- FALSE subseries <- c(1,2) begin.date <- start(dataALL.ts) end.date <- end(dataALL.ts) range <- NULL data.ts <- sigex.prep(dataALL.ts,transform,aggregate,subseries,range,TRUE)
# raw data par(mfrow=c(1,2)) for(i in subseries) { sigex.specar(data.ts,FALSE,i,period) }
# growth rates par(mfrow=c(1,2)) for(i in subseries) { sigex.specar(data.ts,TRUE,i,period) }
N <- dim(data.ts)[2] T <- dim(data.ts)[1]
mdl <- NULL mdl <- sigex.add(mdl,seq(1,N),"arma",c(0,0),NULL,"trend",c(1,-1)) mdl <- sigex.add(mdl,seq(1,N),"arma",c(0,0),NULL,"irregular",1)
mdl <- sigex.meaninit(mdl,data.ts,0)
mdl2 <- NULL mdl2 <- sigex.add(mdl2,1,"arma",c(0,0),NULL,"trend",c(1,-1)) mdl2 <- sigex.add(mdl2,seq(1,N),"arma",c(0,0),NULL,"irregular",1) mdl2 <- sigex.meaninit(mdl2,data.ts,0)
constraint <- NULL par.mle <- sigex.default(mdl,data.ts,constraint) psi.mle <- sigex.par2psi(par.mle,mdl)
fit.mle <- sigex.mlefit(data.ts,par.mle,constraint,mdl,"bfgs",debug=FALSE) psi.mle <- sigex.eta2psi(fit.mle[[1]]$par,constraint) hess <- fit.mle[[1]]$hessian par.mle <- fit.mle[[2]]
r sigex.lik(psi.mle,mdl,data.ts)
.resid.mle <- sigex.resid(psi.mle,mdl,data.ts)[[1]] resid.mle <- sigex.load(t(resid.mle),start(data.ts),frequency(data.ts), colnames(data.ts),TRUE) resid.acf <- acf(resid.mle,lag.max=4*period,plot=TRUE)$acf
log(sigex.conditions(data.ts,psi.mle,mdl))
sigex.portmanteau(resid.mle,4*period,length(psi.mle)) sigex.gausscheck(resid.mle)
print(eigen(hess)$values)
tstats <- sigex.tstats(mdl,psi.mle,hess,constraint) print(tstats)
analysis.mle <- sigex.bundle(data.ts,transform,mdl,psi.mle)
cov.mat <- par.mle[[1]][[1]] %*% diag(exp(par.mle[[2]][[1]])) %*% t(par.mle[[1]][[1]]) l.trend <- sqrt(cov.mat[2,2]/cov.mat[1,1]) d.trend <- cov.mat[1,1]
constraint <- NULL psi.mle2 <- c(l.trend,log(d.trend),psi.mle[4:8]) par.mle2 <- sigex.psi2par(psi.mle2,mdl2,data.ts)
fit.mle2 <- sigex.mlefit(data.ts,par.mle2,constraint,mdl2,"bfgs",debug=FALSE) psi.mle2 <- sigex.eta2psi(fit.mle2[[1]]$par,constraint) hess2 <- fit.mle2[[1]]$hessian par.mle2 <- fit.mle2[[2]]
r sigex.lik(psi.mle2,mdl2,data.ts)
.resid.mle2 <- sigex.resid(psi.mle2,mdl2,data.ts)[[1]] resid.mle2 <- sigex.load(t(resid.mle2),start(data.ts),frequency(data.ts), colnames(data.ts),TRUE) resid.acf2 <- acf(resid.mle2,lag.max=4*period,plot=TRUE)$acf
log(sigex.conditions(data.ts,psi.mle2,mdl2))
sigex.portmanteau(resid.mle2,4*period,length(psi.mle2)) sigex.gausscheck(resid.mle2)
print(eigen(hess2)$values)
tstats2 <- sigex.tstats(mdl2,psi.mle2,hess2,constraint) print(tstats2)
analysis.mle2 <- sigex.bundle(data.ts,transform,mdl2,psi.mle2)
test.glr <- sigex.glr(data.ts,psi.mle2,psi.mle,mdl2,mdl) print(c(test.glr[1],1-pchisq(test.glr[1],df=test.glr[2])))
data.ts <- analysis.mle[[1]] mdl <- analysis.mle[[3]] psi <- analysis.mle[[4]] param <- sigex.psi2par(psi,mdl,data.ts)
signal.trend <- sigex.signal(data.ts,param,mdl,1) signal.irr <- sigex.signal(data.ts,param,mdl,2)
extract.trend <- sigex.extract(data.ts,signal.trend,mdl,param) extract.irr <- sigex.extract(data.ts,signal.irr,mdl,param)
reg.trend <- NULL for(i in 1:N) { reg.trend <- cbind(reg.trend,sigex.fixed(data.ts,mdl,i,param,"Trend")) }
trendcol <- "tomato" fade <- 40 par(mfrow=c(2,1),mar=c(5,4,4,5)+.1) for(i in 1:N) { plot(data.ts[,i],xlab="Year",ylab=colnames(data.ts)[i], ylim=c(min(data.ts[,i]),max(data.ts[,i])), lwd=2,yaxt="n",xaxt="n") sigex.graph(extract.trend,reg.trend,begin.date,period,i,0,trendcol,fade) axis(1,cex.axis=1) axis(2,cex.axis=1) }
grid <- 1000 frf.trend <- sigex.getfrf(data.ts,param,mdl,1,TRUE,grid)
len <- 50 target <- array(diag(N),c(N,N,1)) wk.trend <- sigex.wk(data.ts,param,mdl,1,target,TRUE,grid,len)
data.ts <- analysis.mle2[[1]] mdl <- analysis.mle2[[3]] psi <- analysis.mle2[[4]] param <- sigex.psi2par(psi,mdl,data.ts)
signal.trend <- sigex.signal(data.ts,param,mdl,1) signal.irr <- sigex.signal(data.ts,param,mdl,2)
extract.trend <- sigex.extract(data.ts,signal.trend,mdl,param) extract.irr <- sigex.extract(data.ts,signal.irr,mdl,param)
reg.trend <- NULL for(i in 1:N) { reg.trend <- cbind(reg.trend,sigex.fixed(data.ts,mdl,i,param,"Trend")) }
trendcol <- "tomato" fade <- 40 par(mfrow=c(2,1),mar=c(5,4,4,5)+.1) for(i in 1:N) { plot(data.ts[,i],xlab="Year",ylab=colnames(data.ts)[i], ylim=c(min(data.ts[,i]),max(data.ts[,i])), lwd=2,yaxt="n",xaxt="n") sigex.graph(extract.trend,reg.trend,begin.date,period,i,0,trendcol,fade) axis(1,cex.axis=1) axis(2,cex.axis=1) }
grid <- 1000 frf.trend <- sigex.getfrf(data.ts,param,mdl,1,TRUE,grid)
len <- 50 target <- array(diag(N),c(N,N,1)) wk.trend <- sigex.wk(data.ts,param,mdl,1,target,TRUE,grid,len)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.