R/plot_irf.r

In joergrieger/bvar: Estimation and forecasting of bayesian VAR models

#' @importFrom ggplot2 autoplot
#' @import ggfortify
#' @export
ggplot2::autoplot


#' @export
#' @title Plotting Impulse-Response Functions
#' @param x S3 object with information about the impulse-response functions
#' @param ... currently not used
#' @importFrom gridExtra grid.arrange
plot.bvirf <- function(x,...){

  # declare variable
  irfObj <- x
  nLength <- irfObj$no_variables
  pltList <- list()

  if(is.null(irfObj$varnames)){

    varnames <- as.character(seq(1:nLength))

  }
  else{

    varnames <- irfObj$varnames

  }

  for(ii in 1:nLength){
    for(jj in 1:nLength){
      irf1     <- irfObj$irfdraws[ii,jj,,1]
      irfUpper <- irfObj$irfdraws[ii,jj,,2]
      irfLower <- irfObj$irfdraws[ii,jj,,3]
      irfLength <- length(irf1)

      # Put all the information into a data frame
      irfDf <- data.frame(x = seq(1:irfLength), irf = irf1, Upper = irfUpper, Lower = irfLower)

      # Draw the irf plot
      p1 <- ggplot2::ggplot(data = irfDf) +
        ggplot2::geom_line(mapping = ggplot2::aes_(x = ~x,y = ~irf)) +
        ggplot2::geom_line(mapping = ggplot2::aes_(x = ~x,y = ~Upper,color = "red")) +
        ggplot2::geom_line(mapping = ggplot2::aes_(x = ~x,y = ~Lower,color = "red")) +
        ggplot2::theme(legend.position = "none")

      if(ii == 1){

        p1 <- p1 + ggplot2::ylab(varnames[jj])

      }
      else{

        p1 <- p1 + ggplot2::theme(axis.title.y = ggplot2::element_blank())

      }
      if(jj == 1){

        p1 <- p1 + ggplot2::ggtitle(varnames[ii]) + ggplot2::theme(plot.title = ggplot2::element_text(size=10))

      }
      if(jj == nLength){

        p1 <- p1 + ggplot2::xlab("Horizon")

      }
      else{

        p1 <- p1 + ggplot2::theme(axis.title.x = ggplot2::element_blank())

      }
      # Store all plots in a list
      pltList[[(jj-1)*nLength+ii]] <- p1
    }
  }

  # Create the final plot
  do.call("grid.arrange",c(pltList,nrow=nLength))



}

#' @export
#' @title plot impulse-response functions for regime switchi models
#' @param x an S3 object generated by irf.msvar
#' @param ... currently not used

plot.msirf <- function(x,...){

  irfObj <- x
  nLength <- irfObj$no_variables

  if(is.null(irfObj$varnames)){

    varnames <- as.character(seq(1:nLength))

  }
  else{

    varnames <- irfObj$varnames

  }

  # Plot over all regimes

  for(kk in 1:irfObj$noregimes){
    pltList <- list()
    # Plot over all regimes
    for(ii in 1:nLength){
      for(jj in 1:nLength){
        irf1     <- irfObj$irfdraws[ii,jj,,1,kk]
        irfUpper <- irfObj$irfdraws[ii,jj,,2,kk]
        irfLower <- irfObj$irfdraws[ii,jj,,3,kk]
        irfLength <- length(irf1)

        # Put all the information into a data frame
        irfDf <- data.frame(x = seq(1:irfLength), irf = irf1, Upper = irfUpper, Lower = irfLower)
        # Draw the irf plot
        p1 <- ggplot2::ggplot(data = irfDf) + ggplot2::geom_line(mapping = ggplot2::aes_(x = ~x,y = ~irf)) +
          ggplot2::geom_line(mapping = ggplot2::aes_(x = ~x,y = ~Upper,color = "red")) +
          ggplot2::geom_line(mapping = ggplot2::aes_(x = ~x,y = ~Lower,color = "red")) +
          ggplot2::theme(legend.position = "none")

        if(ii == 1){

          p1 <- p1 + ggplot2::ylab(varnames[jj])

        }
        else{

          p1 <- p1 + ggplot2::theme(axis.title.y = ggplot2::element_blank())

        }
        if(jj == 1){
          p1 <- p1 + ggplot2::ggtitle(varnames[ii]) + ggplot2::theme(plot.title = ggplot2::element_text(size=10))
        }
        if(jj == nLength){
          p1 <- p1 + ggplot2::xlab("Horizon")
        }
        else{
          p1 <- p1 + ggplot2::theme(axis.title.x = ggplot2::element_blank())
        }
        # Store all plots in a list
        pltList[[(jj-1)*nLength+ii]] <- p1

      }
    }
    # Create the final plot
    do.call("grid.arrange",c(pltList,nrow=nLength))
    readline("Press [Enter] to continue")

  }




}


#' @export
#' @title plot impulse-response functions threshold VAR-Models
#' @param x an S3 object generated by irf.tvar
#' @param ... currently not used
plot.tvirf <- function(x,...){

  # Initialize list to store impulse-response functions
  nLength <- dim(x$irf)[1]
  pltListReg1 <- list()
  pltListReg2 <- list()

  if(is.null(x$varnames)){

    varnames <- as.character(seq(1:nLength))

  }
  else{

    varnames <- x$varnames

  }

  for(ii in 1:nLength){
    for(jj in 1:nLength){

      irf1 <- x$irf[ii,jj,,1,1]
      irf2 <- x$irf[ii,jj,,2,1]

      irfLower1 <- x$irf[ii,jj,,1,2]
      irfLower2 <- x$irf[ii,jj,,2,2]

      irfUpper1 <- x$irf[ii,jj,,1,3]
      irfUpper2 <- x$irf[ii,jj,,2,3]

      irfLength <- length(irf1)

      irfDf1 <- data.frame(x = seq(1:irfLength), irf = irf1, Upper = irfUpper1, Lower = irfLower1)
      irfDf2 <- data.frame(x = seq(1:irfLength), irf = irf2, Upper = irfUpper2, Lower = irfLower2)

      # Draw the irf plot

      # First Regime
      p1 <- ggplot2::ggplot(data = irfDf1) + ggplot2::geom_line(mapping = ggplot2::aes_(x = ~x,y = ~irf)) +
        ggplot2::geom_line(mapping = ggplot2::aes_(x = ~x,y = ~Upper,color = "red")) +
        ggplot2::geom_line(mapping = ggplot2::aes_(x = ~x,y = ~Lower,color = "red")) +
        ggplot2::theme(legend.position = "none")

      # Second Regime
      p2 <- ggplot2::ggplot(data = irfDf2) + ggplot2::geom_line(mapping = ggplot2::aes_(x = ~x,y = ~irf)) +
        ggplot2::geom_line(mapping = ggplot2::aes_(x = ~x,y = ~Upper,color = "red")) +
        ggplot2::geom_line(mapping = ggplot2::aes_(x = ~x,y = ~Lower,color = "red")) +
        ggplot2::theme(legend.position = "none")

      if(ii == 1){

        p1 <- p1 + ggplot2::ylab(varnames[jj]) + ggplot2::theme(plot.title = ggplot2::element_text(size=10))
        p2 <- p2 + ggplot2::ylab(varnames[jj]) + ggplot2::theme(plot.title = ggplot2::element_text(size=10))

      }
      else{
        p1 <- p1 + ggplot2::theme(axis.title.y = ggplot2::element_blank())
        p2 <- p2 + ggplot2::theme(axis.title.y = ggplot2::element_blank())
      }
      if(jj == 1){
        p1 <- p1 + ggplot2::ggtitle(varnames[ii]) + ggplot2::theme(plot.title = ggplot2::element_text(size=10))
        p2 <- p2 + ggplot2::ggtitle(varnames[ii]) + ggplot2::theme(plot.title = ggplot2::element_text(size=10))
      }
      if(jj == nLength){
        p1 <- p1 + ggplot2::xlab("Horizon")
        p2 <- p2 + ggplot2::xlab("Horizon")
      }
      else{
        p1 <- p1 + ggplot2::theme(axis.title.x = ggplot2::element_blank())
        p2 <- p2 + ggplot2::theme(axis.title.x = ggplot2::element_blank())
      }

      # Store all plots in a list
      pltListReg1[[(jj-1)*nLength+ii]] <- p1
      pltListReg2[[(jj-1)*nLength+ii]] <- p2

    }
  }

  do.call("grid.arrange",c(pltListReg1,nrow=nLength))
  readline("Press [Enter] to continue")
  do.call("grid.arrange",c(pltListReg2,nrow=nLength))

}