R ggnetwork facet by origin node - 在每个面板中显示目标节点

Question

library(dplyr)
library(ggnetwork)
library(ggplot)
library(igraph)
library(sna)

我有一个如下所示的数据框，表示网络中多个对象之间的连接：

origin <- c("A", "A", "B", "B", "C", "C", "B", "B")

dest <- c("D", "C", "D", "C", "B", "E", "E", "F")

net <- data.frame(origin, dest)

然后我像这样总结 ggnetwork 中使用的数据框，将起点和终点的每个组合显示为自己的行：

df_edges <- net %>% group_by(origin, dest) %>% summarize(weight = n())

然后我转换为一个 igraph 对象，然后是一个 ggnetwork 对象，如下所示：

net_igraph <- graph.data.frame(df_edges, directed = T)

df_net <- ggnetwork(net_igraph)

最后，我想在ggplot2中绘图。如果我想将所有连接绘制在一起，我可以这样绘制：

ggplot(df_net, aes(x = x, y = y, xend = xend, yend = yend, label = vertex.names)) + 
    geom_edges() +
    geom_nodetext() +
    geom_nodes()

但我想绘制成 facet_wrap，这样每个起点都有自己的面板，显示与每个连接目的地的连接。 问题是当我这样绘制时，目标节点没有显示:

ggplot(df_net, aes(x = x, y = y, xend = xend, yend = yend, label = vertex.names)) + 
    geom_edges() +
    geom_nodetext() +
    geom_nodes() + 
    facet_wrap(~ vertex.names)

如何让目标节点显示在每个面板中？

我查看了 ggnetwork() 的帮助文件，发现使用了 by = 参数，但不确定我选择的 "edge attribute" 是什么。

Answer 1

我找不到任何直接的方法来实现这一点，鉴于

，这并不奇怪

head(df_net, 2)
#           x         y  na.x vertex.names      xend      yend na.y weight
# 1 1.0000000 0.1356215 FALSE            A 1.0000000 0.1356215   NA     NA
# 2 0.3039919 0.5152220 FALSE            B 0.3039919 0.5152220   NA     NA

即每一行只有原点名称。因此，虽然添加目标顶点实际上很容易，但添加它们的名称需要一些额外的工作。

df_net 的结构是这样的，首先我们有几行（与顶点一样多）weight 为 NA，这些行仅定义顶点位置（另请注意x 与 xend 一致，y 与 yend 一致）。然后我们有和边对应的边一样多的行，在哪里绘制它们。

但是，有一个问题。例如，

df_net[c(3, 7), ]
#            x        y  na.x vertex.names      xend       yend  na.y weight
# 3  0.4846586 0.000000 FALSE            C 0.4846586 0.00000000    NA     NA
# 31 0.3039919 0.515222 FALSE            B 0.4763860 0.02359162 FALSE      1

第二行对应从B到C的一条边。问题是第二行的 xend 和 yend 与第一行的 x 和 y 不完全相同。因此，我们无法直接确定这条边实际上到达 C。为此，我们可以使用如下定义的近似匹配函数：

apprMatch <- function(x, y) apply(x, 1, function(z) which.min(colSums((t(y) - z)^2)))

它需要两个矩阵（每个矩阵两列），并且对于 x 的每一行，它找到最近的 y 行。鉴于该图不是非常密集，它应该可以毫无问题地工作（即使它很密集，我也希望它能工作）。

因此，让

ends1 <- with(df_net, cbind(xend, yend)[!is.na(weight), ])
ends2 <- with(df_net, cbind(x, y)[is.na(weight), ])

就是我们要匹配的那两个矩阵。然后

df_net$to[!is.na(df_net$weight)] <- as.character(df_net$vertex.names[apprMatch(ends1,ends2)])

产量

tail(df_net, 2)
#    x         y  na.x vertex.names      xend        yend  na.y weight to
# 10 1 0.1356215 FALSE            A 0.5088354 0.006362567 FALSE      1  C
# 11 1 0.1356215 FALSE            A 0.8644390 0.614776499 FALSE      1  D

即目标顶点名称列 to。因此，总而言之，我们有

apprMatch <- function(x, y) apply(x, 1, function(z) which.min(colSums((t(y) - z)^2)))
ends1 <- with(df_net, cbind(xend, yend)[!is.na(weight), ])
ends2 <- with(df_net, cbind(x, y)[is.na(weight), ])
df_net$to[!is.na(df_net$weight)] <- as.character(df_net$vertex.names[apprMatch(ends1,ends2)])

ggplot(df_net, aes(x = x, y = y, xend = xend, yend = yend, label = vertex.names)) + 
  geom_edges() +
  geom_nodetext(vjust = 1, hjust = 1) + 
  geom_nodetext(aes(label = to, x = xend, y = yend), vjust = 1, hjust = 1) +
  geom_nodes() +
  geom_nodes(aes(x = xend, y = yend)) +
  facet_wrap(~ vertex.names)

我还添加了 vjust 和 hjust 以便顶点名称更清晰。

R ggnetwork facet by origin node - 在每个面板中显示目标节点

R ggnetwork facet by origin node - display destination nodes in each panel

r

igraph

ggplot2

facet-wrap