Illustrative Example

# ============================================================
# Required package: R2DAG
# ============================================================
# This notebook reproduces the illustrative example in the paper.
# The main network computations rely on the author's R package,
# R2DAG, which is available from GitHub.
#
# The installation command is included for replicability. In an
# already configured environment, this cell only needs to be run once.
# We use dependencies = FALSE and upgrade = "never" to avoid changing
# already installed packages during replication.

# Install the package from GitHub.
devtools::install_github(
  "espanm/R2DAG",
  dependencies = FALSE,
  upgrade = "never"
)

# Load the package after installation.
library(R2DAG)

# The igraph package is used only for graph construction and plotting.
library(igraph)

plot_net_graph <- function(tab,
                           main = "Net directed graph",
                           vertex_color = "orange",
                           edge_color = "black",
                           label_color = "blue",
                           vertex_size = 35,
                           label_cex = 1.2,
                           edge_label_cex = 1.1,
                           edge_width_scale = 12,
                           arrow_size = 0.9,
                           arrow_width = 1.8,
                           edge_curved = 0.15,
                           label_offset = 0.08,
                           label_pos = 0.35,
                           layout_fun = igraph::layout_in_circle) {
  
  # Check that the plotting dependency is available.
  if (!requireNamespace("igraph", quietly = TRUE)) {
    stop("The 'igraph' package is not installed.")
  }
  
  # ------------------------------------------------------
  # 1. Basic checks and preparation
  # ------------------------------------------------------
  # The input is expected to be a square matrix-like object whose
  # rows and columns refer to the same variables.
  M <- as.matrix(tab)
  
  if (nrow(M) != ncol(M)) {
    stop("Input must be a square matrix or table.")
  }
  
  if (is.null(rownames(M)) || is.null(colnames(M))) {
    stop("The matrix must have row names and column names.")
  }
  
  if (!identical(rownames(M), colnames(M))) {
    stop("Row names and column names must match.")
  }
  
  nodes <- rownames(M)
  n <- nrow(M)
  
  # Own effects are not plotted as network links.
  diag(M) <- 0
  
  # ------------------------------------------------------
  # 2. Netting procedure
  # ------------------------------------------------------
  # The convention of the network tables is that M[i, j] denotes
  # the effect running from variable j to variable i. For every
  # unordered pair {i, j}, we plot only the net direction, i.e. the
  # larger bilateral effect minus the smaller bilateral effect.
  edge_list <- list()
  
  for (i in 1:(n - 1)) {
    for (j in (i + 1):n) {
      val_ij <- M[i, j]  # effect j -> i
      val_ji <- M[j, i]  # effect i -> j
      
      net_val <- abs(val_ij - val_ji)
      
      # Keep only pairs with a nonzero net effect.
      if (net_val > 0) {
        if (val_ij > val_ji) {
          edge_list[[length(edge_list) + 1]] <- data.frame(
            from = nodes[j],
            to = nodes[i],
            weight = net_val
          )
        } else if (val_ji > val_ij) {
          edge_list[[length(edge_list) + 1]] <- data.frame(
            from = nodes[i],
            to = nodes[j],
            weight = net_val
          )
        }
      }
    }
  }
  
  if (length(edge_list) == 0) {
    stop("There are no nonzero net edges to plot.")
  }
  
  edges <- do.call(rbind, edge_list)
  
  # ------------------------------------------------------
  # 3. Build graph object
  # ------------------------------------------------------
  # Edge widths are proportional to the absolute net effect.
  g <- igraph::graph_from_data_frame(edges, directed = TRUE, vertices = nodes)
  
  E(g)$label <- sprintf("%.4f", E(g)$weight)
  E(g)$width <- E(g)$weight * edge_width_scale
  
  # The layout can be changed through the layout_fun argument.
  lay <- layout_fun(g)
  
  # ------------------------------------------------------
  # 4. Plot graph without built-in edge labels
  # ------------------------------------------------------
  # Edge labels are added manually below because this gives better
  # control over their position relative to the arrows.
  plot(
    g,
    layout = lay,
    main = main,
    vertex.color = vertex_color,
    vertex.frame.color = "black",
    vertex.size = vertex_size,
    vertex.label.color = "black",
    vertex.label.cex = label_cex,
    vertex.label.font = 2,
    edge.color = edge_color,
    edge.arrow.size = arrow_size,
    edge.arrow.width = arrow_width,
    edge.curved = edge_curved,
    edge.label = NA
  )
  
  # ------------------------------------------------------
  # 5. Add edge labels manually
  # ------------------------------------------------------
  # label_pos controls where the label is placed along the edge.
  # label_offset moves the label perpendicular to the edge. These
  # two parameters make the labels easier to read in small graphs.
  edge_ends <- igraph::ends(g, igraph::E(g), names = FALSE)
  
  for (k in seq_len(nrow(edge_ends))) {
    from_id <- edge_ends[k, 1]
    to_id   <- edge_ends[k, 2]
    
    x0 <- lay[from_id, 1]
    y0 <- lay[from_id, 2]
    x1 <- lay[to_id, 1]
    y1 <- lay[to_id, 2]
    
    dx <- x1 - x0
    dy <- y1 - y0
    len <- sqrt(dx^2 + dy^2)
    
    if (len > 0) {
      px <- -dy / len
      py <-  dx / len
    } else {
      px <- 0
      py <- 0
    }
    
    # Base label position along the edge.
    bx <- x0 + label_pos * dx
    by <- y0 + label_pos * dy
    
    # Final label position after perpendicular offset.
    lx <- bx + label_offset * px
    ly <- by + label_offset * py
    
    text(
      x = lx,
      y = ly,
      labels = E(g)$label[k],
      col = label_color,
      cex = edge_label_cex,
      font = 2
    )
  }
  
  # Return the graph object invisibly, so the function can also be
  # used programmatically without printing additional output.
  invisible(g)
}

# Structural contemporaneous matrix used in the illustrative example.
# The variables are ordered as X1, X2, X3, and X4.
A0 <- matrix(c(
  1.0,  0.0,  0.0,  0.0,
  0.0,  1.0,  0.0,  0.0,
 -0.5, -0.5,  1.0,  0.0,
 -0.5,  0.0, -0.5,  1.0
), nrow = 4, byrow = TRUE)

# Common arguments used in all three calculations.
# sigma_eps = rep(1, nrow(A0)) sets the standard deviation of each
# structural shock to one. var_names assigns readable labels to the
# four variables.
sigma_eps <- rep(1, nrow(A0))
var_names <- paste0("X", 1:nrow(A0))

# Proposed directed R-squared network.
directed <- theoretical_R2_network(
  A0,
  sigma_eps = sigma_eps,
  var_names = var_names,
  method = c("directed")
)

# Undirected Genizi-type R-squared decomposition.
undirected_genizi <- theoretical_R2_network(
  A0,
  sigma_eps = sigma_eps,
  var_names = var_names,
  method = c("undirected_genizi")
)

# Diebold--Yilmaz-type network for the same structural system.
dy <- theoretical_R2_network(
  A0,
  sigma_eps = sigma_eps,
  var_names = var_names,
  method = c("dy")
)

# Directed R-squared network.
plot_net_graph(
  directed$total_table,
  main = "Directed $R^2$ network",
  vertex_color = "orange",
  edge_color = "black",
  label_color = "blue",
  vertex_size = 40,
  label_cex = 1.5,
  edge_label_cex = 1.2,
  edge_width_scale = 20,
  arrow_size = 0.9,
  arrow_width = 1.8,
  layout_fun = igraph::layout_in_circle
)

# Undirected Genizi-type R-squared network.
plot_net_graph(
  undirected_genizi$total_table,
  main = "$R^2$ network",
  vertex_color = "orange",
  edge_color = "black",
  label_color = "blue",
  vertex_size = 40,
  label_cex = 1.5,
  edge_label_cex = 1.2,
  edge_width_scale = 20,
  arrow_size = 0.9,
  arrow_width = 1.8,
  layout_fun = igraph::layout_in_circle
)

# Diebold--Yilmaz-type network.
plot_net_graph(
  dy$total_table,
  main = "Diebold–Yilmaz network",
  vertex_color = "orange",
  edge_color = "black",
  label_color = "blue",
  vertex_size = 40,
  label_cex = 1.5,
  edge_label_cex = 1.2,
  edge_width_scale = 20,
  arrow_size = 0.9,
  arrow_width = 1.8,
  layout_fun = igraph::layout_in_circle
)

# Table A1: proposed directed R-squared network.
directed$total_table

# Table A2: undirected Genizi-type R-squared network.
undirected_genizi$total_table

# Table A3: Diebold--Yilmaz-type network.
dy$total_table