3

我正在尝试将边缘列表转换为相邻矩阵。

下面是样本数据

#Sample Data
User<-c("1","1","2","3","4")  
v1 <- c("b", "b", "a", "d", "c")
v2 <- c("c", "d", "c", "a", "a")
v3 <- c(0, 0, "d", 0, "b")
v4 <- c(0, 0, 0, 0, 0)
v5 <- c(0, 0, 0, 0, 0)

my_data<-data.frame(User, v1, v2, v3, v4, v5)
my_data

如果您运行此代码,您将获得以下输出,

  User v1 v2 v3 v4 v5
    1  b  c  0  0  0
    1  b  d  0  0  0
    2  a  c  d  0  0
    3  d  a  0  0  0
    4  c  a  b  0  0

使用这些数据,我想创建一个如下所示的相邻矩阵:

   a  b  c  d
a  0  0  2  2        
b  0  0  1  1
c  2  1  0  1  
d  2  1  1  0 

基本上,所需的输出显示了样本数据帧中每对出现在列 v1~v5 中的次数。

我尝试使用库中AdjacencyFromEdgelist的函数dils,还尝试使用 NA 创建矩阵外壳并通过循环遍历数据框来填充矩阵。

但是,我无法工作。

4

3 回答 3

4

我认为这可能与您的想法很接近。在超过 2 个顶点的行中,我考虑了每个现有的对:

library(igraph)

do.call(rbind, my_data[-1] |>
          apply(1, \(x) x[x != 0]) |>
          lapply(\(x) t(combn(x, m = 2)))) |>
  graph_from_edgelist(directed = FALSE) %>%
  as_adjacency_matrix()

4 x 4 sparse Matrix of class "dgCMatrix"
  b c d a
b . 2 1 1
c 2 . 1 2
d 1 1 . 2
a 1 2 2 .

或者没有基础 R 中的 pip 运算符:

tmp <- apply(my_data[-1], 1, function(x) x[x != 0])
tmp <- do.call(rbind, lapply(tmp, function(x) t(combn(x, m = 2))))

my_graph <- graph_from_edgelist(tmp, directed = FALSE)
adj_mat <- as_adjacency_matrix(my_graph)
adj_mat
于 2022-01-13T01:55:57.117 回答
3

另一种尝试,减去计算所有组合的需要combn

sel <- my_data[-1] != 0
dat <- data.frame(row=row(my_data[-1])[sel], value = my_data[-1][sel])
out <- crossprod(table(dat))
diag(out) <- 0
out

#     value
#value a b c d
#    a 0 1 2 2
#    b 1 0 2 1
#    c 2 2 0 1
#    d 2 1 1 0

匹配来自@AnoushiravanR 的结果:

adj_mat[c("a","b","c","d"), c("a","b","c","d")]
#4 x 4 sparse Matrix of class "dgCMatrix"
#  a b c d
#a . 1 2 2
#b 1 . 2 1
#c 2 2 . 1
#d 2 1 1 .
于 2022-01-13T03:18:13.720 回答
2

另一种igraph选择

do.call(
  rbind,
  combn(df, 2, setNames, nm = c("from", "to"), simplify = FALSE)
) %>%
  filter(from > 0 & to > 0) %>%
  arrange(from) %>%
  graph_from_data_frame(directed = FALSE) %>%
  get.adjacency(sparse = FALSE)

  a b c d
a 0 1 2 2
b 1 0 2 1
c 2 2 0 1
d 2 1 1 0
于 2022-01-13T09:26:30.927 回答