如何转换二分网络并使用一级的节点属性作为 igraph (R) 中第二级的边权重
How to transform a bipartite Network and use node attributes from one level as edge weights in the second level in igraph (R)
我现在正在尝试将二分双模图转换为其单模表示。问题是我想将双模图的节点属性保存到单模表示。例如，数据框由以下方式给出：
Person EventLocation DurationEvent
Peter Bar 90
Jack Bar 90
Franz Train 20
Franz Bar 90
Laurie Train 20
Jack Train 20
...
现在我想在 Person 和 EventLocation 列上使用 igraph 函数 bipartite_projection() 来获取 persons 网络，但我看不到如何预先保护可能转移到边缘权重的附加节点属性（持续时间）人与人之间，例如体重 90 的彼得-杰克或体重 20 的弗朗兹-劳瑞。
编辑：为了更准确，我添加了最后一行。边 "Jack-Franz" 现在对应于 90+20 = 110。但基本上我的问题只与如何实现 bipartite_projection 有关，它将二分 igraph 网络的节点属性传输到相应的边属性单模 igraph 网络。
编辑 2：我刚刚添加了另一个示例。首先，我在人与人之间创建了一个网络，然后我想将预算信息添加到人的边缘，这意味着两者吸引了多少项目预算（仅来自不同独特项目的预算总和作为权重）。然后我想做一些进一步的加权中心性计算：
person_id <- c("X","Y","Z","Q","W","E","R","X","Y")
project <- c("a","b","c","a","a","b","c","b","a")
budget <- c(100,200,300,100,100,200,300,200,100)
employ.data <- data.frame(person_id, project, budget)
View(employ.data)
sna.complete.list <- employ.data
sna.list.complete.igraph.calc <- graph.data.frame(sna.complete.list)
V(sna.list.complete.igraph.calc)$type <- V(sna.list.complete.igraph.calc)$name%in%sna.complete.list$person_id
sna.list.complete.igraph.calc.one <- try(bipartite.projection(sna.list.complete.igraph.calc, type=V(sna.list.complete.igraph.calc)$type))
sna.statistics.persons <- sna.list.complete.igraph.calc.one[[2]]
plot.igraph(sna.statistics.persons)
EDIT3：我尝试重新表达我的担忧：
总体目标：
得到一个加权图（节点之间的边值用一些值加权）
Outline/Data:
参与预算规模不同的不同项目的人员的数据
将二分连接图（People-Project）转换为单模-People-People-graph
使用预算大小作为人与人之间边缘的权重。
但是对于两个人来说，这个值应该只占参与独特项目的总和。因此，如果 A 和 B 仅由预算大小为 100 的项目 x 连接，则边权重应为 100。如果他们还参与另一个值为 20 的项目，则结果应为 120 等
我在使用 bipartite.projection 期间尝试传输此信息，但后来失败或无法实现此信息。
bipartite_projection()只能收集边的结构权重，也就是说Peter和Jack都隶属于Train和Bar。处理 edge 属性比较棘手。
如果您只想保留 节点 属性，正如您在上面所写的那样 bipartite_projection() 绝对已经为您做到了。只需重新投影并找到像这样保留的属性：
V(unipartite_graph)$your_attributee
如果在重投影的时候需要保留edge的属性，但是之前有几个问题要问
- 当Franz-Train-Jack也有Franz-Bar_Jack时，应该如何处理多条路径？
- 方向性在计算中有什么作用
几年前我需要完全相同的东西，并通过编写我自己的扩展重投影函数解决了它。这可能不是解决这个问题的最短方法，而是通过每个单顶点对 in 二分图和 returns 之间的最短路径计算给定边属性的总和保留（并汇总）一个边属性的图。
请注意，该函数不计算单分 Laurie-Peter。您可以根据自己的喜好操作该功能。
这将重现您的示例数据并应用我的函数
# 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")
祝你好运
大量借鉴@nGL 的回答，我稍微更改了代码以考虑 2 个人之间的所有最短路径，并将他们的累积事件持续时间作为他们在投影图中的边权重。
结果图如下所示（例如 Jack 和 Franz 之间的边权重 = 110）：
请注意：这假设原始权重在人之间平均分配（即杰克和弗兰兹在酒吧会面 90 分钟）。在其他情况下，Jack 和 Franz 可能会访问同一个酒吧，但 Jack 的 Duation 是 70，而 Franz 是 110。
然后需要考虑取平均值是否合适或其他衡量标准（例如，最小值或最大值）。
# 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=projection)
## 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(graph_bi, attribute)
path <- lapply(get.all.shortest.paths(graph_bi, source, target)$res, function(x) E(g, path=x))
sum(unlist(lapply(path, function (x) mean(attr_value[x]))))
}
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(graph_bi = g, attribute = "DurationEvent", projection = FALSE)
# Visualise
V(gg)$color <- "yellow"
E(gg)$label <- E(gg)$DurationEvent
plot(gg, edge.label.color="gray", vertex.label.color="black")
仅供参考：我还更改了几行代码以确保它在使用其他属性时完全可重现（例如，将 E(g)$DurationEvent 替换为 attr_value）
额外的警告：如果你的图表已经有一个权重参数，你需要在 get.all.shortest.paths(graph_bi, from = source, to = target, weights = NA)
中设置 weights = NA
我现在正在尝试将二分双模图转换为其单模表示。问题是我想将双模图的节点属性保存到单模表示。例如，数据框由以下方式给出：
Person EventLocation DurationEvent
Peter Bar 90
Jack Bar 90
Franz Train 20
Franz Bar 90
Laurie Train 20
Jack Train 20
...
现在我想在 Person 和 EventLocation 列上使用 igraph 函数 bipartite_projection() 来获取 persons 网络，但我看不到如何预先保护可能转移到边缘权重的附加节点属性（持续时间）人与人之间，例如体重 90 的彼得-杰克或体重 20 的弗朗兹-劳瑞。
编辑：为了更准确，我添加了最后一行。边 "Jack-Franz" 现在对应于 90+20 = 110。但基本上我的问题只与如何实现 bipartite_projection 有关，它将二分 igraph 网络的节点属性传输到相应的边属性单模 igraph 网络。
编辑 2：我刚刚添加了另一个示例。首先，我在人与人之间创建了一个网络，然后我想将预算信息添加到人的边缘，这意味着两者吸引了多少项目预算（仅来自不同独特项目的预算总和作为权重）。然后我想做一些进一步的加权中心性计算：
person_id <- c("X","Y","Z","Q","W","E","R","X","Y")
project <- c("a","b","c","a","a","b","c","b","a")
budget <- c(100,200,300,100,100,200,300,200,100)
employ.data <- data.frame(person_id, project, budget)
View(employ.data)
sna.complete.list <- employ.data
sna.list.complete.igraph.calc <- graph.data.frame(sna.complete.list)
V(sna.list.complete.igraph.calc)$type <- V(sna.list.complete.igraph.calc)$name%in%sna.complete.list$person_id
sna.list.complete.igraph.calc.one <- try(bipartite.projection(sna.list.complete.igraph.calc, type=V(sna.list.complete.igraph.calc)$type))
sna.statistics.persons <- sna.list.complete.igraph.calc.one[[2]]
plot.igraph(sna.statistics.persons)
EDIT3：我尝试重新表达我的担忧：
总体目标： 得到一个加权图（节点之间的边值用一些值加权）
Outline/Data:
参与预算规模不同的不同项目的人员的数据
将二分连接图（People-Project）转换为单模-People-People-graph
使用预算大小作为人与人之间边缘的权重。
但是对于两个人来说，这个值应该只占参与独特项目的总和。因此，如果 A 和 B 仅由预算大小为 100 的项目 x 连接，则边权重应为 100。如果他们还参与另一个值为 20 的项目，则结果应为 120 等
我在使用 bipartite.projection 期间尝试传输此信息，但后来失败或无法实现此信息。
bipartite_projection()只能收集边的结构权重，也就是说Peter和Jack都隶属于Train和Bar。处理 edge 属性比较棘手。
如果您只想保留 节点 属性，正如您在上面所写的那样 bipartite_projection() 绝对已经为您做到了。只需重新投影并找到像这样保留的属性：
V(unipartite_graph)$your_attributee
如果在重投影的时候需要保留edge的属性，但是之前有几个问题要问
- 当Franz-Train-Jack也有Franz-Bar_Jack时，应该如何处理多条路径？
- 方向性在计算中有什么作用
几年前我需要完全相同的东西，并通过编写我自己的扩展重投影函数解决了它。这可能不是解决这个问题的最短方法，而是通过每个单顶点对 in 二分图和 returns 之间的最短路径计算给定边属性的总和保留（并汇总）一个边属性的图。
请注意，该函数不计算单分 Laurie-Peter。您可以根据自己的喜好操作该功能。
这将重现您的示例数据并应用我的函数
# 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")
祝你好运
大量借鉴@nGL 的回答，我稍微更改了代码以考虑 2 个人之间的所有最短路径，并将他们的累积事件持续时间作为他们在投影图中的边权重。
结果图如下所示（例如 Jack 和 Franz 之间的边权重 = 110）：
请注意：这假设原始权重在人之间平均分配（即杰克和弗兰兹在酒吧会面 90 分钟）。在其他情况下，Jack 和 Franz 可能会访问同一个酒吧，但 Jack 的 Duation 是 70，而 Franz 是 110。 然后需要考虑取平均值是否合适或其他衡量标准（例如，最小值或最大值）。
# 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=projection)
## 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(graph_bi, attribute)
path <- lapply(get.all.shortest.paths(graph_bi, source, target)$res, function(x) E(g, path=x))
sum(unlist(lapply(path, function (x) mean(attr_value[x]))))
}
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(graph_bi = g, attribute = "DurationEvent", projection = FALSE)
# Visualise
V(gg)$color <- "yellow"
E(gg)$label <- E(gg)$DurationEvent
plot(gg, edge.label.color="gray", vertex.label.color="black")
仅供参考：我还更改了几行代码以确保它在使用其他属性时完全可重现（例如，将 E(g)$DurationEvent 替换为 attr_value）
额外的警告：如果你的图表已经有一个权重参数，你需要在 get.all.shortest.paths(graph_bi, from = source, to = target, weights = NA)