bipartite_projection() может собирать только структурные веса ребер , то есть Питер и Джек оба связаны с Train и Bar. Обрабатывать атрибуты edge сложнее.
Если вы хотите сохранить только атрибуты node , как вы пишете выше, bipartite_projection() уже сделает это за вас , Просто перепроектируйте и найдите, что ваши атрибуты сохранены следующим образом:
V(unipartite_graph)$your_attributee
Если вам нужно сохранить атрибуты edge при перепроецировании, однако, есть несколько вопросов, которые нужно задать ранее.
- Как следует обрабатывать несколько путей, если у Франца-Трэйна-Джека также есть Franz-Bar_Jack?
- Какую роль играет направленность в расчете
Несколько лет назад мне нужно было то же самое, и я решил это, написав собственную расширенную функцию повторного проецирования. Возможно, это не самый короткий путь, но он вычисляет суммы заданного реберного атрибута по кратчайшему пути между каждой парой unipartite-vertex в двудольного графа и возвращает граф с one атрибут ребра сохранен (и суммирован).
Обратите внимание, что функция не вычисляет односторонний Лаур ie -Петр. Вы можете манипулировать функцией по своему вкусу.
Воспроизводит данные вашего примера и применяет мою функцию
# Reproduce your data
df <- data.frame(Person = c("Peter","Jack","Franz","Franz","Laurie","Jack"),
EventLocation = c("Bar","Bar","Train","Bar","Train","Train"),
DurationEvent = c(90,90,20,90,20,20), stringsAsFactors = F)
## Make bipartite graph from example data
g <- graph_from_data_frame(df, directed=FALSE)
# Set vertex type using bipartite.mapping() (OBS type should be boolean for bipartite_projection())
V(g)$type <- bipartite.mapping(g)$type
## Plot Bipartite graph
E(g)$label <- E(g)$DurationEvent
V(g)$color <- ifelse(V(g)$type, "red", "yellow")
V(g)$size <- ifelse(V(g)$type, 40, 20)
plot(g, edge.label.color="gray", vertex.label.color="black")
# Function to reproject a bipartite graph to unipartite projection while
# calculating an attribute-value sum between reprojected vertecies.
unipartite_projection_attr <- function(graph_bi, attribute, projection=FALSE){
## Make initial unipartite projection
graph_uni <- bipartite_projection(graph_bi, which=FALSE)
## List paths in bipartite-graph along which to summarise selected attribute
el <- as_edgelist(graph_uni)
el <- matrix(sapply(el, function(x) as.numeric(which(x == V(graph_bi)$name))), ncol=2)
## Function to summarise given atribute-value
summarise_graph_attribute_along_path <- function(source, target, attribute){
attr_value <- edge_attr(g, attribute)
path <- get.shortest.paths(g, source, target, output="epath")$epath[[1]]
sum(E(g)$DurationEvent[path])
}
attr_uni <- mapply(summarise_graph_attribute_along_path, el[,1], el[,2], attribute)
graph_uni <- set_edge_attr(graph_uni, attribute, value=attr_uni)
(graph_uni)
}
# Use function to make unipartite projection
gg <- unipartite_projection_attr(g, "DurationEvent", FALSE)
# Visualise
V(gg)$color <- "yellow"
E(gg)$label <- E(gg)$DurationEvent
plot(gg, edge.label.color="gray", vertex.label.color="black")
Удачи