v0.5.0

Update
kthohr · Jul 19, 2015 · 71827fd · 71827fd
1 parent a96e61c
commit 71827fd
Show file tree

Hide file tree

Showing 70 changed files with 4,908 additions and 3,574 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,10 +1,11 @@
 Package: BMR
 Title: Bayesian Macroeconometrics in R
-Version: 0.4.3
-Date: 2015-02-06
+Version: 0.5.0
+Date: 2015-07-20
 Author: Keith O'Hara
 Maintainer: Keith O'Hara <[email protected]>
 Description: A package for estimating Bayesian macroeconometric models.
-License: GPL-3
-Depends: Rcpp (>= 0.11.4), RcppArmadillo (>= 0.4.6.4.0), doSNOW (>= 1.0.12), ggplot2 (>= 1.0.0), grid
-LinkingTo: Rcpp, RcppArmadillo, doSNOW, ggplot2, grid
+License: GPL (>=2)
+Depends: Rcpp (>= 0.11.4), RcppArmadillo (>= 0.4.6.4.0), doSNOW (>= 1.0.12), ggplot2 (>= 1.0.0)
+LinkingTo: Rcpp, RcppArmadillo
+Imports: foreach, snow, grid
diff --git a/LICENSE b/LICENSE
diff --git a/NAMESPACE b/NAMESPACE
@@ -1,2 +1,11 @@
 useDynLib(BMR)
+
+importFrom(Rcpp, evalCpp)
+import(RcppArmadillo)
+import(doSNOW)
+import(foreach)
+importFrom(snow, makeCluster, stopCluster)
+import(ggplot2)
+importFrom(grid, grid.newpage, viewport, pushViewport, grid.layout)
+
 exportPattern("^[[:alpha:]]+")
diff --git a/R/AutocorrelationFunctions.R b/R/AutocorrelationFunctions.R
@@ -1,12 +1,31 @@
+################################################################################
+##
+##   R package BMR by Keith O'Hara Copyright (C) 2011, 2012, 2013, 2014, 2015
+##   This file is part of the R package BMR.
+##
+##   The R package BMR is free software: you can redistribute it and/or modify
+##   it under the terms of the GNU General Public License as published by
+##   the Free Software Foundation, either version 2 of the License, or
+##   (at your option) any later version.
+##
+##   The R package BMR is distributed in the hope that it will be useful,
+##   but WITHOUT ANY WARRANTY; without even the implied warranty of
+##   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+##   GNU General Public License for more details.
+##
+################################################################################
+
+# 07/20/2015
+
 gacf<-function(y,lags=10,ci=.95,plot=TRUE,barcolor="purple",names=FALSE,save=FALSE,height=12,width=12){
   .ggplotacf(y,lags,ci,plot,barcolor,names,save,height,width)
 }
 
-gpacf<-function(y,lags=10,ci=.95,plot=T,barcolor="darkred",names=FALSE,save=FALSE,height=12,width=12){
+gpacf<-function(y,lags=10,ci=.95,plot=TRUE,barcolor="darkred",names=FALSE,save=FALSE,height=12,width=12){
   .ggplotpacf(y,lags,ci,plot,barcolor,names,save,height,width)
 }
 
-.ggplotacf<-function(y,lags=10,ci=.95,plot=T,barcolor="purple",names=FALSE,save=FALSE,height=12,width=12){
+.ggplotacf<-function(y,lags=10,ci=.95,plot=TRUE,barcolor="purple",names=FALSE,save=FALSE,height=12,width=12){
   #
   M <- as.numeric(ncol(y))
   #
@@ -23,7 +42,7 @@ gpacf<-function(y,lags=10,ci=.95,plot=T,barcolor="darkred",names=FALSE,save=FALS
   }
   #
   for(j in 1:M){
-    myacf <- acf(y[,j],lags,plot=F)
+    myacf <- acf(y[,j],lags,plot=FALSE)
     myacf2 <- as.numeric(myacf$acf)
     myacf2 <- myacf2[2:(lags+1)]
     ACFMat[,j] <- myacf2
@@ -40,7 +59,7 @@ gpacf<-function(y,lags=10,ci=.95,plot=T,barcolor="darkred",names=FALSE,save=FALS
   if(plot==TRUE){
     if(save==TRUE){
       if(class(dev.list()) != "NULL"){dev.off()}
-      cairo_ps(file="ACF.eps",height=height,width=width)
+      cairo_ps(filename="ACF.eps",height=height,width=width)
     }else{
       grid.newpage()
     }
@@ -76,7 +95,7 @@ gpacf<-function(y,lags=10,ci=.95,plot=T,barcolor="darkred",names=FALSE,save=FALS
   #
 }
 
-.ggplotpacf<-function(y,lags=10,ci=.95,plot=T,barcolor="darkred",names=FALSE,save=FALSE,height=12,width=12){
+.ggplotpacf<-function(y,lags=10,ci=.95,plot=TRUE,barcolor="darkred",names=FALSE,save=FALSE,height=12,width=12){
   #
   M <- as.numeric(ncol(y))
   #
@@ -93,7 +112,7 @@ gpacf<-function(y,lags=10,ci=.95,plot=T,barcolor="darkred",names=FALSE,save=FALS
   }
   #
   for(j in 1:M){
-    mypacf <- pacf(y[,j],lags,plot=F)
+    mypacf <- pacf(y[,j],lags,plot=FALSE)
     mypacf2 <- as.numeric(mypacf$acf)
     mypacf2 <- mypacf2[1:lags]
     PACFMat[,j] <- mypacf2
@@ -110,7 +129,7 @@ gpacf<-function(y,lags=10,ci=.95,plot=T,barcolor="darkred",names=FALSE,save=FALS
   if(plot==TRUE){
     if(save==TRUE){
       if(class(dev.list()) != "NULL"){dev.off()}
-      cairo_ps(file="PACF.eps",height=height,width=width)
+      cairo_ps(filename="PACF.eps",height=height,width=width)
     }else{
       grid.newpage()
     }

diff --git a/R/BVARM.R b/R/BVARM.R
@@ -1,4 +1,22 @@
-# 01/12/2015
+################################################################################
+##
+##   R package BMR by Keith O'Hara Copyright (C) 2011, 2012, 2013, 2014, 2015
+##   This file is part of the R package BMR.
+##
+##   The R package BMR is free software: you can redistribute it and/or modify
+##   it under the terms of the GNU General Public License as published by
+##   the Free Software Foundation, either version 2 of the License, or
+##   (at your option) any later version.
+##
+##   The R package BMR is distributed in the hope that it will be useful,
+##   but WITHOUT ANY WARRANTY; without even the implied warranty of
+##   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+##   GNU General Public License for more details.
+##
+################################################################################
+
+# 07/20/2015
+
 BVARM.default <- function(mydata,coefprior=NULL,p=4,constant=TRUE,irf.periods=20,keep=10000,burnin=1000,VType=1,decay="H",HP1=0.5,HP2=0.5,HP3=1,HP4=2){
   #
   kerr <- .bvarmerrors(mydata,p,coefprior,constant,VType,decay,HP4)
@@ -188,11 +206,11 @@ BVARM.default <- function(mydata,coefprior=NULL,p=4,constant=TRUE,irf.periods=20
   Sigma <- kronecker(solve(Sigma),diag(nrow(Y)))
   #
   message('Starting Gibbs C++, ', date(),'.', sep="")
-  RepsRun <- .Call("MBVARReps", Sigma,as.matrix(Z),as.matrix(Y),matrix(aPr,ncol=1),BVPr,M,K,burnin,keep, PACKAGE = "BMR", DUP = FALSE)
+  RepsRun <- .Call("MBVARReps", Sigma,as.matrix(Z),as.matrix(Y),matrix(aPr,ncol=1),BVPr,M,K,burnin,keep, PACKAGE = "BMR")
   message('C++ reps finished, ', date(),'. Now generating IRFs.', sep="")
   #
   kcons <- 0; if(constant==T){kcons<-1}
-  ImpStore <- .Call("MBVARIRFs", shock,M,K,kcons,keep,irf.periods,RepsRun$Beta, PACKAGE = "BMR", DUP = FALSE)
+  ImpStore <- .Call("MBVARIRFs", shock,M,K,kcons,keep,irf.periods,RepsRun$Beta, PACKAGE = "BMR")
   ImpStore <- ImpStore$ImpStore
   ImpStore2 <- array(NA,dim=c(M,M,irf.periods,keep))
   for(i in 1:keep){

diff --git a/R/BVARS.R b/R/BVARS.R
@@ -1,4 +1,22 @@
-# 01/12/2015
+################################################################################
+##
+##   R package BMR by Keith O'Hara Copyright (C) 2011, 2012, 2013, 2014, 2015
+##   This file is part of the R package BMR.
+##
+##   The R package BMR is free software: you can redistribute it and/or modify
+##   it under the terms of the GNU General Public License as published by
+##   the Free Software Foundation, either version 2 of the License, or
+##   (at your option) any later version.
+##
+##   The R package BMR is distributed in the hope that it will be useful,
+##   but WITHOUT ANY WARRANTY; without even the implied warranty of
+##   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+##   GNU General Public License for more details.
+##
+################################################################################
+
+# 07/20/2015
+
 BVARS.default <- function(mydata,psiprior=NULL,coefprior=NULL,p=4,irf.periods=20,keep=10000,burnin=1000,XiPsi=1,HP1=0.5,HP4=2,gamma=NULL){
   #
   kerr <- .bvarserrors(mydata,p,coefprior,psiprior,XiPsi,HP1,HP4,gamma)
@@ -158,10 +176,10 @@ BVARS.default <- function(mydata,psiprior=NULL,coefprior=NULL,p=4,irf.periods=20
   ImpStore <- 0
   #
   message('Starting Gibbs C++, ', date(),'.', sep="")
-  RepsRun <- .Call("SBVARReps", as.matrix(X),as.matrix(Y),d,dX,yd,Zd,PsiPr,invPsiVPr,BPr,Beta,invBVPr,Sigma,SigmaML,gamma,Tp,M,p,burnin,keep, PACKAGE = "BMR", DUP = FALSE)
+  RepsRun <- .Call("SBVARReps", as.matrix(X),as.matrix(Y),d,dX,yd,Zd,PsiPr,invPsiVPr,BPr,Beta,invBVPr,Sigma,SigmaML,gamma,Tp,M,p,burnin,keep, PACKAGE = "BMR")
   message('C++ reps finished, ', date(),'. Now generating IRFs.', sep="")
   #
-  ImpStore <- .Call("SBVARIRFs", M,K,keep,irf.periods,RepsRun$Beta,RepsRun$Sigma, PACKAGE = "BMR", DUP = FALSE)
+  ImpStore <- .Call("SBVARIRFs", M,K,keep,irf.periods,RepsRun$Beta,RepsRun$Sigma, PACKAGE = "BMR")
   #
   ImpStore <- ImpStore$ImpStore
   ImpStore2 <- array(NA,dim=c(M,M,irf.periods,keep))

diff --git a/R/BVARTVP.R b/R/BVARTVP.R
@@ -1,4 +1,22 @@
-# 01/12/2015
+################################################################################
+##
+##   R package BMR by Keith O'Hara Copyright (C) 2011, 2012, 2013, 2014, 2015
+##   This file is part of the R package BMR.
+##
+##   The R package BMR is free software: you can redistribute it and/or modify
+##   it under the terms of the GNU General Public License as published by
+##   the Free Software Foundation, either version 2 of the License, or
+##   (at your option) any later version.
+##
+##   The R package BMR is distributed in the hope that it will be useful,
+##   but WITHOUT ANY WARRANTY; without even the implied warranty of
+##   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+##   GNU General Public License for more details.
+##
+################################################################################
+
+# 07/20/2015
+
 BVARTVP.default <- function(mydata,timelab=NULL,coefprior=NULL,tau=NULL,p=4,irf.periods=20,irf.points=NULL,keep=10000,burnin=5000,XiBeta=1,XiQ=0.01,gammaQ=NULL,XiSigma=1,gammaS=NULL){
   #
   kerr <- .bvartvperror(mydata,p,coefprior,tau,XiBeta,XiQ,gammaQ,XiSigma,gammaS)
@@ -12,7 +30,7 @@ BVARTVP.default <- function(mydata,timelab=NULL,coefprior=NULL,tau=NULL,p=4,irf.
   kreps <- .bvartvpreps(kdata$Y,kdata$y,kdata$Z,kprior$B0Pr,kprior$B0VPr,kprior$invB0VPr,
                        kprior$QPr,kprior$QVPr,kprior$SPr,kprior$SVPr,kprior$QDraw,kprior$Qchol,
                        kprior$SDraw,kprior$invSDraw,kdata$K,kdata$M,p,kdata$kT,
-                       keep,burnin,kdata$timelab,kdata$nIRFs,kdata$irf.points,cumulative,irf.periods)
+                       keep,burnin,kdata$timelab,kdata$nIRFs,kdata$irf.points,irf.periods)
   #
   bvartvpret <- list(IRFs=kreps$IRFs,Beta=kreps$BetaMean,Q=kreps$QMean,Sigma=kreps$SigmaMean,BDraws=kreps$Betas,QDraws=kreps$QDraws,SDraws=kreps$SDraws,data=mydata,irf.points=irf.points,tau=tau)
   class(bvartvpret) <- "BVARTVP"
@@ -165,7 +183,7 @@ BVARTVP.default <- function(mydata,timelab=NULL,coefprior=NULL,tau=NULL,p=4,irf.
   SPr <- 0; SVPr <- 0; SDraw <- 0; invSDraw <- 0
   #
   if(class(tau)!="NULL"){
-    TauSamplingRun <- .Call("tsprior", Y,tau,M,K,p, PACKAGE = "BMR", DUP = FALSE)
+    TauSamplingRun <- .Call("tsprior", Y,tau,M,K,p, PACKAGE = "BMR")
     #
     BetaVariance <- TauSamplingRun$BVPrOLS
     #
@@ -206,7 +224,7 @@ BVARTVP.default <- function(mydata,timelab=NULL,coefprior=NULL,tau=NULL,p=4,irf.
     }
     QSortIndex <- c(QSortIndex)
     #
-    BPr <- c(t(ktest1))[c(t(QSortIndex))]
+    BPr <- c(t(BPr))[c(t(QSortIndex))]
     B0Pr <- matrix(BPr,ncol=1)
     #
     if(class(XiBeta)=="numeric"){
@@ -232,10 +250,10 @@ BVARTVP.default <- function(mydata,timelab=NULL,coefprior=NULL,tau=NULL,p=4,irf.
   return=list(B0Pr=B0Pr,B0VPr=B0VPr,invB0VPr=invB0VPr,QPr=QPr,QVPr=QVPr,SPr=SPr,SVPr=SVPr,QDraw=QDraw,Qchol=Qchol,SDraw=SDraw,invSDraw=invSDraw)
 }
 
-.bvartvpreps <- function(Y,y,Z,B0Pr,B0VPr,invB0VPr,QPr,QVPr,SPr,SVPr,QDraw,Qchol,SDraw,invSDraw,K,M,p,kT,keep,burnin,timelab,nIRFs,irf.points,cumulative,irf.periods){
+.bvartvpreps <- function(Y,y,Z,B0Pr,B0VPr,invB0VPr,QPr,QVPr,SPr,SVPr,QDraw,Qchol,SDraw,invSDraw,K,M,p,kT,keep,burnin,timelab,nIRFs,irf.points,irf.periods){
   #
   message('Starting Gibbs C++, ', date(),'.', sep="")
-  RepsRun <- .Call("BVARTVPReps", y,Z,M,K,kT,keep,burnin,B0Pr,B0VPr,invB0VPr,QPr,QVPr,SPr,SVPr,QDraw,Qchol,SDraw,invSDraw, PACKAGE = "BMR", DUP = FALSE)
+  RepsRun <- .Call("BVARTVPReps", y,Z,M,K,kT,keep,burnin,B0Pr,B0VPr,invB0VPr,QPr,QVPr,SPr,SVPr,QDraw,Qchol,SDraw,invSDraw, PACKAGE = "BMR")
   message('C++ reps finished, ', date(),'. Now generating IRFs.', sep="")
   #
   BetaDraws <- RepsRun$BetaDraws; QDraws <- RepsRun$QDraws; SDraws <- RepsRun$SDraws
@@ -281,7 +299,7 @@ BVARTVP.default <- function(mydata,timelab=NULL,coefprior=NULL,tau=NULL,p=4,irf.
     if(KTC < (nIRFs+1)){
       if(timelab[i] == irf.points[KTC]){
         Beta <- BetaT[,,,i]
-        ImpStore <- .Call("BVARTVPIRFs", M,K/M,keep,irf.periods,Beta,SDraws, PACKAGE = "BMR", DUP = FALSE)
+        ImpStore <- .Call("BVARTVPIRFs", M,K/M,keep,irf.periods,Beta,SDraws, PACKAGE = "BMR")
         ImpStore <- ImpStore$ImpStore
         ImpStoreE <- array(NA,dim=c(M,M,irf.periods,keep))
         for(j in 1:keep){

diff --git a/R/BVARW.R b/R/BVARW.R
@@ -1,4 +1,22 @@
-# 01/12/2015
+################################################################################
+##
+##   R package BMR by Keith O'Hara Copyright (C) 2011, 2012, 2013, 2014, 2015
+##   This file is part of the R package BMR.
+##
+##   The R package BMR is free software: you can redistribute it and/or modify
+##   it under the terms of the GNU General Public License as published by
+##   the Free Software Foundation, either version 2 of the License, or
+##   (at your option) any later version.
+##
+##   The R package BMR is distributed in the hope that it will be useful,
+##   but WITHOUT ANY WARRANTY; without even the implied warranty of
+##   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+##   GNU General Public License for more details.
+##
+################################################################################
+
+# 07/20/2015
+
 BVARW.default <- function(mydata,cores=1,coefprior=NULL,p=4,constant=TRUE,irf.periods=20,keep=10000,burnin=1000,XiBeta=1,XiSigma=1,gamma=NULL){
   #
   kerr <- .bvarwerrors(mydata,cores,p,coefprior,constant,XiBeta,XiSigma,gamma)
@@ -167,11 +185,11 @@ BVARW.default <- function(mydata,cores=1,coefprior=NULL,p=4,constant=TRUE,irf.pe
   ImpStore <- 0
   #
   message('Starting Gibbs C++, ', date(),'.', sep="")
-  RepsRun <- .Call("WBVARReps", Sigma,as.matrix(X),as.matrix(Z),as.matrix(Y),matrix(aPr,ncol=1),SPr,vPr,BVPr,Tp,M,K,burnin,keep, PACKAGE = "BMR", DUP = FALSE)
+  RepsRun <- .Call("WBVARReps", Sigma,as.matrix(X),as.matrix(Z),as.matrix(Y),matrix(aPr,ncol=1),SPr,vPr,BVPr,Tp,M,K,burnin,keep, PACKAGE = "BMR")
   message('C++ reps finished, ', date(),'. Now generating IRFs.', sep="")
   #
   kcons <- 0; if(constant==T){kcons<-1}
-  ImpStore <- .Call("WBVARIRFs", M,K,kcons,keep,irf.periods,RepsRun$Beta,RepsRun$Sigma, PACKAGE = "BMR", DUP = FALSE)
+  ImpStore <- .Call("WBVARIRFs", M,K,kcons,keep,irf.periods,RepsRun$Beta,RepsRun$Sigma, PACKAGE = "BMR")
   ImpStore <- ImpStore$ImpStore
   IRFStore <- array(NA,dim=c(M,M,irf.periods,keep))
   for(i in 1:keep){
@@ -208,7 +226,7 @@ BVARW.default <- function(mydata,cores=1,coefprior=NULL,p=4,constant=TRUE,irf.pe
   #
   message('Starting Gibbs C++, ', date(),'.', sep="")
   #
-  RepsRunB <- .Call("WBVARRepsB", Sigma,as.matrix(X),as.matrix(Z),as.matrix(Y),matrix(aPr,ncol=1),SPr,vPr,BVPr,Tp,M,K,burnin, PACKAGE = "BMR", DUP = FALSE)
+  RepsRunB <- .Call("WBVARRepsB", Sigma,as.matrix(X),as.matrix(Z),as.matrix(Y),matrix(aPr,ncol=1),SPr,vPr,BVPr,Tp,M,K,burnin, PACKAGE = "BMR")
   #
   cl <- makeCluster(NCore)
   registerDoSNOW(cl)
@@ -232,7 +250,7 @@ BVARW.default <- function(mydata,cores=1,coefprior=NULL,p=4,constant=TRUE,irf.pe
   message('C++ reps finished, ', date(),'. Now generating IRFs.', sep="")
   #
   kcons <- 0; if(constant==T){kcons<-1}
-  ImpStore <- .Call("WBVARIRFs", M,K,kcons,keep,irf.periods,BetaArray,SigmaArray, PACKAGE = "BMR", DUP = FALSE)
+  ImpStore <- .Call("WBVARIRFs", M,K,kcons,keep,irf.periods,BetaArray,SigmaArray, PACKAGE = "BMR")
   ImpStore <- ImpStore$ImpStore
   IRFStore <- array(NA,dim=c(M,M,irf.periods,keep))
   for(i in 1:keep){
@@ -265,7 +283,7 @@ BVARW.default <- function(mydata,cores=1,coefprior=NULL,p=4,constant=TRUE,irf.pe
 
 .RepsBFn <- function(Sigma,X,Z,Y,aPr,SPr,vPr,BVPr,Tp,M,K,keeppar){
   #
-  Res <- .Call("WBVARRepsK", Sigma,X,Z,Y,aPr,SPr,vPr,BVPr,Tp,M,K,keeppar, PACKAGE = "BMR", DUP = FALSE)
+  Res <- .Call("WBVARRepsK", Sigma,X,Z,Y,aPr,SPr,vPr,BVPr,Tp,M,K,keeppar, PACKAGE = "BMR")
   #
   return(list(Res$Beta,Res$Sigma))
 }
diff --git a/R/CVAR.R b/R/CVAR.R
@@ -1,4 +1,22 @@
-# 01/12/2014
+################################################################################
+##
+##   R package BMR by Keith O'Hara Copyright (C) 2011, 2012, 2013, 2014, 2015
+##   This file is part of the R package BMR.
+##
+##   The R package BMR is free software: you can redistribute it and/or modify
+##   it under the terms of the GNU General Public License as published by
+##   the Free Software Foundation, either version 2 of the License, or
+##   (at your option) any later version.
+##
+##   The R package BMR is distributed in the hope that it will be useful,
+##   but WITHOUT ANY WARRANTY; without even the implied warranty of
+##   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+##   GNU General Public License for more details.
+##
+################################################################################
+
+# 07/20/2015
+
 CVAR.default <- function(mydata,p=4,constant=TRUE,irf.periods=20,boot=10000){
   #
   kerr <- .cvarerrors(mydata,p)
@@ -72,10 +90,10 @@ CVAR.default <- function(mydata,p=4,constant=TRUE,irf.periods=20,boot=10000){
   kcons <- 0; if(constant==T){kcons<-1}
   #
   message('Starting C++, ', date(),'.', sep="")
-  RepsRun <- .Call("CVARReps", Beta,Sigma,as.matrix(X),as.matrix(Y),Tp,M,K,kcons,boot,ResidDraws, PACKAGE = "BMR", DUP = FALSE)
+  RepsRun <- .Call("CVARReps", Beta,Sigma,as.matrix(X),as.matrix(Y),Tp,M,K,kcons,boot,ResidDraws, PACKAGE = "BMR")
   message('C++ reps finished, ', date(),'. Now getting IRFs.', sep="")
   #
-  ImpStore <- .Call("CVARIRFs", M,K,kcons,boot,irf.periods,RepsRun$Beta,RepsRun$Sigma, PACKAGE = "BMR", DUP = FALSE)
+  ImpStore <- .Call("CVARIRFs", M,K,kcons,boot,irf.periods,RepsRun$Beta,RepsRun$Sigma, PACKAGE = "BMR")
   ImpStore <- ImpStore$ImpStore
   ImpStore2 <- array(NA,dim=c(M,M,irf.periods,boot))
   for(i in 1:boot){