如何通过对节点进行分组来降低邻接矩阵的分辨率

How to reduce resolution of adjacency matrix by grouping nodes

我有一个邻接矩阵,表示物种之间的进食联系(列吃行)

mat1<-matrix(data=c(0,0,0,1,0,0,1,0,0,1,0,0,0,0,0,0), 
                nrow=4, 
                ncol=4, 
                byrow = TRUE,
                dimnames = list(c("a","b","c","d"), 
                                c("a","b","c","d")))

我想使用显示每个物种所属科的数据框将此矩阵的分辨率降低到科级别,

df <- data.frame(Species = c("a","b","c","d"), Family = c("E","E","F","F"))

这样得到的矩阵就会给出家庭之间的喂养联系数量

mat2<-matrix(data=c(0,2,1,0), 
            nrow=2, 
            ncol=2, 
            byrow = TRUE,
            dimnames = list(c("E","F"), 
                            c("E","F")))

感谢您的宝贵时间

因为这是我知道的唯一方法,所以这是使用 tidyverse 的解决方案。
它将矩阵变成 long-form tibble,按族聚合,然后再次变宽。

library(tidyverse)

# create a tibble that looks like the desired end-result matrix
df2 <- mat1 %>% 
  as_tibble(rownames = "Species_from") %>% # make a tibble
  pivot_longer(cols = -Species_from,
               names_to = "Species_to") %>% # turn into long form
  left_join(df, by = c("Species_from" = "Species")) %>% # add Family_from and Family_to
  left_join(df, by = c("Species_to" = "Species"), suffix = c("_from", "_to")) %>% 
  group_by(Family_from, Family_to) %>% # aggregate Family_from and Family_to
  summarise(value = sum(value)) %>% # ... by taking their sum
  pivot_wider(names_from = Family_to,
              values_from = value) # turn back into wide form

# turn into a matrix
mat2 <- as.matrix(df2[, c("E", "F")])
rownames(mat2) <- df2$Family_from

mat2

#   E F
# E 0 2
# F 1 0

我敢肯定有更优雅的方法,但这里有一种 data.table 的方法。如果您的邻接矩阵非常大,这可能比 tidyr.

的枢轴方法更快

首先,我们将两个对象转换为 data.tables。然后我们将 Family 连接到邻接矩阵上。然后我们按 Family 组对每一列求和。最后,我们转置并再次做同样的事情。

library(data.table)
setDT(df)
dt <- as.data.table(cbind(Species = rownames(mat1),as.data.frame(mat1)))
a <- df[dt,on = "Species"][,-"Species"][,lapply(.SD, sum), by = Family]
b <- data.table::transpose(a, keep.names = "Family", make.names = 1)
setnames(b,"Family","Species")
c <- df[b,on = "Species"][,-"Species"][,lapply(.SD,sum), by = Family]
data.table::transpose(c, keep.names = "Family", make.names = 1)
   Family E F
1:      E 0 2
2:      F 1 0