Как уменьшить разрешение матрицы смежности путем группировки узлов

Question

У меня есть матрица смежности, которая выражает кормовые связи между видами (столбец ест строку)

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")))

Я хочу уменьшить разрешение этой матрицы до уровня семейства, используя фреймворк, который показывает, к какому семейству принадлежит каждый вид to,

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")))

Спасибо за ваше время

Answer 1

Я уверен, что есть более элегантный способ, но вот подход с data.table. Если ваша матрица смежности очень велика, это может быть быстрее, чем подход поворота из tidyr.

Сначала мы преобразуем два объекта в data.table s. Затем мы присоединяем 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

Answer 2

Поскольку это единственный способ, который я знаю, вот решение, использующее тидиверс.
Оно превращает матрицу в длинный тиббл, агрегирует по семействам, а затем снова расширяет его.

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