У меня есть проблема, которую я не смог оптимизировать, и я уверен, что либо igraph, либо tidy graphs уже должны содержать эту функцию, или должен быть лучший способ сделать это. Для этого я использую R и igraph, но, возможно, tidygraphs тоже подойдет.
Проблема: Как определить сети как список из более чем двух миллионов ребер (узел 1 - связанный с - узел 2) в их собственные отдельные сети, а затем определить сеть как ее наивысшую взвешенную категорию узлов.
Данные:
Края:
Это создает 3 сети N.B. в реальном примере у нас есть циклы и несколько ребер к узлам и от них (именно поэтому я использовал igraph, так как он легко справляется с этим).
Данные: Категории узлов:
Финальная таблица: В итоговой таблице каждый узел классифицируется по категориям, а каждая сеть помечается максимальной категорией узлов.
Текущее итеративное решение и код: Если нет лучшего решения для этого, то, может быть, мы можем ускорить эту итерацию?
library(tidyverse)
library(igraph)
library(purrr) #might be an answer
library(tidyverse)
library(tidygraph) #might be an answer
from <- c(1,3,5,7,8)
to <- c(2,4,6,6,6)
edges <- data.frame(from,to)
id <- c(1,2,3,4,5,6,7,8)
cat <- c("traffic accident","abuse","abuse","speeding","murder","abuse","speeding","abuse")
weight <- c(10,50,50,5,100,50,5,50)
details <- data.frame(id,cat,weight)
g <- graph_from_data_frame(edges)# we can add the vertex details here as well g <-
graph_from_data_frame(edges,vertices=details) but we join these in later
plot(g)
dg <- decompose(g)# decomposing the network defines the separate networks
networks <- data.frame(id=as.integer(),
network_id=as.integer())
for (i in 1:length(dg)) { # this is likely too many to do at once. As the networks are already defined we can split this into chunks. There is a case here for parellisation
n <- dg[[i]][1] %>% # using the decomposed list of lists from i graph. There is an issue here as the list comes back with the node as an index. I can't find an easier way to get this out
as.data.frame() %>% # I can't work a way to bring out the data without changing to df and then using row names
row.names() %>% # and this returns a vector
as.data.frame() %>%
rename(id=1) %>%
mutate(network_id = i,
id=as.integer(id))
networks <-bind_rows(n,networks)
}
networks <- networks %>%
inner_join(details) # one way to bring in details
n_weight <- networks %>%
group_by(network_id) %>%
summarise(network_weight=max(weight))
networks <- networks %>%
inner_join(n_weight)
networks # final answer
filtered_n <- networks %>%
filter(network_weight==100) %>%
select(network_id) %>%
distinct()#this brings out just the network ID's of whatever we happen to want
filtered_n <- networks %>%
filter(network_id %in% filtered_n_id$network_id)
edges %>%
filter(from %in% filtered_n$id | to %in% filtered_n$id ) %>%
graph_from_data_frame() %>%
plot() # returns only the network/s that we want to view
Вот решение, использующее только igraph и base R.
networkid <- components(g)$membership
Table <- aggregate(id, list(networkid), function(x) { max(weight[x]) })
networkcat <- Table$x[networkid]
Final <- data.frame(id, idcat=cat, networkid, networkcat)
Final
id idcat networkid networkcat
1 1 traffic accident 1 50
2 2 abuse 1 50
3 3 abuse 2 50
4 4 speeding 2 50
5 5 murder 3 100
6 6 abuse 3 100
7 7 speeding 3 100
8 8 abuse 3 100
Я рад сэкономить вам время.
Большое спасибо. Ключевым моментом здесь для меня является функция component(). Вы превратили процесс, который мог бы занять 4 часа, в процесс, который занимает секунды!