R - Эффективный по времени способ выбора идентичных строк, присутствующих в списке матриц, через определенный порог

Question

У меня есть список с 68 матрицами. Каждая матрица в основном представляет собой список ребер, состоящий из трех столбцов и тысяч строк. Первые два столбца с именами Node1 и Node2 соответственно содержат имена генов. Каждая строка представляет ребро на графике, взаимодействие между генами. Третий столбец содержит веса для каждого ребра.

Цель состоит в том, чтобы получить окончательную таблицу, в которой ребра, присутствующие в 75% или более матриц и имеющие разные веса, объединены в одну строку. Вес каждого конечного ребра будет соответствовать среднему значению весов одинаковых ребер.

Я хотел бы знать более эффективный по времени код для сравнения больших матриц с миллионами строк.

Пример

1. Матрица

   edgelist1<-matrix(data = c("ABCD1","EFGH1","DFEC","JEKC4",0.1314,1.1231),nrow = 2,ncol = 3,dimnames = list(c(),c("Node1","Node2","Weight")))
   edgelist1
   
   edgelist2<-matrix(data = c("ABCD1","DEIR3","CGESL","DFEC","KMN3","PME2",1.7564,0.6573,0.5478),nrow = 3,ncol = 3,dimnames = list(c(),c("Node1","Node2","Weight")))
   edgelist2
   
   edgelist3<-matrix(data = c("ACCD1","DEIR3","GUESL","DFEC","KMN3","PMKE2",1.264,0.8573,0.7458),nrow = 3,ncol = 3,dimnames = list(c(),c("Node1","Node2","Weight")))
   edgelist3
   
   edgelist4<-matrix(data = c("KPF2","NDM1","GUESL","ABCD1","KMN3","PMKE2","LTRC5","DFEC",1.142,0.9273,0.1358,0.3456),nrow = 4,ncol = 3,dimnames = list(c(),c("Node1","Node2","Weight")))
   edgelist4
   

2. Список

   list<-list(edgelist1,edgelist2,edgelist3,edgelist4)
   

3. Желаемый выход

   finaledgelist<-matrix(c("ABCD1","DFEC","0.7445"),nrow=1,ncol = 3,dimnames = list(c(),c("Node1","Node2","Weight")))
   finaledgelist
   

Мой код

#Combining all edgelists into one
alledges<-do.call(rbind,list)

#Merging column 1 and column 2
alledges<-data.frame(list(Edges=paste(alledges[,1],alledges[,2]),Weights=alledges[,3]))

#Table to see the frequencies of appearance of each edge
as.data.frame(table(alledges$Edge))->frequencies

# Selection of the edges present in 75% or more of the original edgelists
frequencies[frequencies$Freq>=3,]->selection

#Selection of each edge that appears three or more times
alledges[alledges$Edge %in% selection$Var1,]->repeated

#Collapse by edge name and compute mean of the weights
finaledgelist<-repeated %>%
  group_by(Edges) %>%
  dplyr::summarize(Weights=mean(as.numeric(as.character(Weights)), na.rm = TRUE))

#Final edge list as data frame
finaledgelist<-as.data.frame(cbind(Node1=unlist(strsplit(as.vector(finaledgelist$Edges),split=" "))[2*(1:nrow(finaledgelist))-1],Node2=unlist(strsplit(as.vector(finaledgelist$Edges),split=" "))[2*(1:nrow(finaledgelist))],Weights=finaledgelist$Weights))
finaledgelist$Weights<-as.numeric(as.character(finaledgelist$Weights))

Answer 1

Тот же подход, что и в случае неправильного использования, но, поскольку вы спрашивали конкретно об эффективности, вот data.table версия

list1 <- list(edgelist1, edgelist2, edgelist3, edgelist4) %>% lapply(as.data.frame, stringsAsFactors = F)
dt <- rbindlist(list1)

dt[dt[, pct := .N/length(list1), by = .(Node1, Node2)]$pct >= 0.75
   , .(Weight = mean(as.numeric(Weight)))
   , by = .(Node1, Node2)]

#    Node1 Node2    Weight
# 1: ABCD1  DFEC 0.7444667

Benchmark

f1 <- function(){
list1 <- list(edgelist1, edgelist2, edgelist3, edgelist4) %>% lapply(as.data.frame, stringsAsFactors = F)
dt <- rbindlist(list1)

dt[dt[, pct := .N/length(list1), by = .(Node1, Node2)]$pct >= 0.75
   , .(Weight = mean(as.numeric(Weight)))
   , by = .(Node1, Node2)]
}

f2 <- function(){
  do.call(rbind, list1) %>% #bind all metrics together
  as.data.frame %>% #convert to data frame
  group_by(Node1, Node2) %>% #group by nodes
  mutate(n1 = n()) %>% #count members of each group
  filter(n1 >= (0.75 * length(list1))) %>% #filter those that are present in less than 75% of list elements
  summarise(weight = mean(as.numeric(as.character(Weight)))) #get mean weight for those that are left
}

library(microbenchmark)

microbenchmark(f1(), f2())

# Unit: milliseconds
# expr      min       lq      mean    median        uq       max neval
# f1() 1.817024 2.207588  3.715193  2.718768  3.631382  33.88879   100
# f2() 7.789532 9.990557 16.287901 12.058657 15.876705 347.46884   100

Answer 2

вот подход с использованием Tidyverse

library(tidyverse)

do.call(rbind, list1) %>% #bind all matrices together
  as.data.frame %>% #convert to data frame
  group_by(Node1, Node2) %>% #group by nodes
  mutate(n1 = n()) %>% #count members of each group
  filter(n1 >= (0.75 * length(list1))) %>% #filter those that are present in less than 75% of list elements
  summarise(weight = mean(as.numeric(as.character(Weight)))) #get mean weight for those that are left

#output#
A tibble: 1 x 3
# Groups: Node1 [?]
  Node1 Node2 weight
  <fct> <fct>  <dbl>
1 ABCD1 DFEC   0.744