R/dynamic_spillover.R

In Spillover: Spillover/Connectedness Index Based on VAR Modelling

#' dynamnic_spillover is a function for estimating DY directional spillovers.
#'
#' @param data a data.frame consisting of dates in its first column and numeric variables for the others
#' @param width a integer specifying the window width in number of observations.
#' @param n.ahead An integer indicating the how many steps ahead the spillover should be forecasted.
#' @param standardized A logical value indicating whether the values should be divided by the number of columns to get a percentage.
#' @param na.fill A logical value for filling with NA at the begining window due to \code{width}.
#' @param remove.own should own directional spillover be removed?
#' @param ... Further arguments to be passed to var function
#'
#' @return A list of data.frames holding all directional spillovers as described in Diebold and Yilmaz (2012)
#' @export
#' @import stats utils 
#' @importFrom zoo as.zoo
#' 
#' @examples
#' data(dy2012)
#' \donttest{
#' dy_results <- dynamic.spillover(data=dy2012, width=200, remove.own = FALSE) 
#'} 
#' 
dynamic.spillover <- function (data, width, n.ahead = 10, standardized = TRUE, na.fill = FALSE, remove.own = TRUE, ...) {
  #   if (!(class(data) == "zoo")) {
  #     stop("\nPlease provide an object of class 'zoo', generated by 'as.zoo'.\n")
  #   }
  K <- ncol(data)-1
  Date <- data[,1]
  data <- as.zoo(data[, -1])
  indices <- suppressWarnings(rollapplyr(data, width = width, fill=na.fill, align="right",  FUN = function(z) {
    Y <- G.spillover(VAR(z,...), n.ahead = n.ahead, standardized = standardized)[1:K, 1:K]
  }, by.column = FALSE) )
  
  
  
  variables <- names(data)
  ind <- expand.grid(1:K, 1:K)[,2:1]
  Names <- sapply(1:nrow(ind), function(i){
    paste(variables[ind[i,1]], variables[ind[i,2]], sep="_")
  })
  
  colnames(indices) <- Names
  
  
  #### Creating all dynamic indices
  ## creating dynamic spillover matrices excluding own spillover
  indices_mat_1 <- lapply(1:nrow(indices), function(i){
    tmp <- matrix(indices[i,], K, dimnames = list(variables, variables))
    tmp
  })
  
  indices_mat <- lapply(indices_mat_1, `diag<-`, 0)
  
  
  ## getting directional spillover FROM
  from <- lapply(indices_mat, colSums)
  from <- do.call(rbind, from)
  
  
  ## getting directional spillover TO
  to <- lapply(indices_mat, rowSums)
  to <- do.call(rbind, to)
  
  ## getting directional NET spillover 
  net <- from - to
  
  ## Getting net pairwise dynamic index
  combn_names <- combn(colnames(data), 2)
  pairwise_names <- paste(combn_names[1,], combn_names[2,], sep="-")
  
  ind_row <- combn_names[1, ]
  ind_col <- combn_names[2, ]
  
  
  pairwise_dynamics <- function(x){
    tmp <- sapply(1:length(ind_row), function(i){
      tmp <-   x[ind_col[i], ind_row[i]] - x[ind_row[i], ind_col[i]]
      return(tmp)
    })
    
  }
  
  out_pairs2 <- lapply(indices_mat, pairwise_dynamics)
  out_pairs2 <- do.call(rbind, out_pairs2)
  colnames(out_pairs2) <- pairwise_names
  
  ## Getting dynamic pairwise from/to spillover
  
  
  input_pairwise_from_to_names <- expand.grid(variables, variables)[2:1]
  
  #x <-  indices_mat[[1]]
  # a function for making a data.frame consisting of from to pairwise  
  make_pairwise_from_to <- function(x, 
                                    pairwise_from_to_names = input_pairwise_from_to_names,
                                    remove.own = remove.own){
    
    pairwise_from_to_names <- sapply(1:nrow(pairwise_from_to_names), function(i){
      paste("From:", pairwise_from_to_names[i,1], " to:", pairwise_from_to_names[i,2])
    })
    
    
    pairwise_from_to <- data.frame(variables = pairwise_from_to_names, value = as.vector(x))
    
    if(remove.own){
      diag(x) <-  -999
      pairwise_from_to <- data.frame(variables = pairwise_from_to_names, value = as.vector(x))
      pairwise_from_to <- pairwise_from_to[pairwise_from_to[, "value"] != -999, ]
      
    }
    
    return(pairwise_from_to)
  }
  
  pairwise_from_to_out <- lapply(indices_mat_1, make_pairwise_from_to, remove.own = remove.own)
  pairwise_from_to_out <- do.call(rbind, pairwise_from_to_out)
  
  #
  
  
  ## altogether in a list object
  dynamic_out <- list(from = data.frame(Date=Date, from, check.names = FALSE, stringsAsFactors = FALSE),
                      to = data.frame(Date=Date, to, check.names = FALSE, stringsAsFactors = FALSE), 
                      net = data.frame(Date=Date, net, check.names = FALSE, stringsAsFactors = FALSE), 
                      net_pairwise = data.frame(Date=Date, out_pairs2, check.names = FALSE, stringsAsFactors = FALSE), 
                      from_to_pairwise = data.frame(Date=Date, pairwise_from_to_out, check.names = FALSE, stringsAsFactors = FALSE))
  
  if(na.fill==FALSE){
    dynamic_out <- lapply(dynamic_out, na.omit)
  } 
  
  
  class(dynamic_out) <- "directional.spillover"
  return(dynamic_out)
}



# data(dy2012)
# dy_results <- dynamic_spillover(data=dy2012, width=200, remove.own = FALSE)