如何在R中提取加权网络骨干并保留原始边权重？

一、给现有backbone包disparity结果补回原始权重 #

你遇到的问题可以通过「先筛选显著边，再从原网络提取权重」的方式直接解决，不用换方法：

1. 先运行disparity得到骨干网络（此时权重被平化为1，但边是筛选后的显著边）
2. 提取骨干网络的边列表，再从原网络中找到这些边的原始权重，替换回去

代码示例：

# 生成骨干网络（权重暂为1）
backbone_graph <- disparity(g, alpha = alpha)
# 提取骨干网络的边对（节点名称）
backbone_edge_pairs <- as_edgelist(backbone_graph, names = TRUE)
# 从原网络g中获取这些边的原始权重
original_weights <- E(g)[get.edge.ids(g, backbone_edge_pairs)]$weight
# 把原始权重赋值给骨干网络的边
E(backbone_graph)$weight <- original_weights

处理完后，backbone_graph就是带原始权重的显著骨干网络，直接用来计算加权中心性或做社区检测都没问题。

二、替代方案：手动实现disparity逻辑保留权重 #

如果不想依赖backbone包的输出，也可以自己实现disparity过滤器的核心统计逻辑，直接从原网络筛选显著边并保留权重：

# 计算每个节点的强度（所有关联边的权重和）
node_strength <- strength(g)
# 遍历每个节点，计算其关联边的相对权重
rel_weight_list <- lapply(V(g), function(v) {
  incident_edges <- incident(g, v, mode = "all")
  data.frame(
    edge_id = incident_edges,
    rel_weight = E(g)[incident_edges]$weight / node_strength[v]
  )
})
rel_weights <- do.call(rbind, rel_weight_list)

# 计算每条边的p值（基于disparity的beta分布假设）
rel_weights$p_val <- pbeta(
  rel_weights$rel_weight,
  shape1 = 1,
  shape2 = degree(g)[V(g)[rel_weights$edge_id[, 1]]],
  lower.tail = FALSE
)

# 用FDR校正多重检验，筛选显著边
sig_edges <- rel_weights$edge_id[p.adjust(rel_weights$p_val, method = "fdr") < alpha]

# 从原网络提取显著边，得到带原始权重的骨干网络
weighted_backbone <- subgraph.edges(g, eids = sig_edges, delete.vertices = FALSE)

三、其他骨干提取方法 #

如果不局限于disparity过滤器，还有这些方法可以直接保留原始权重：

• 基于bootstrap的权重显著性检验：对每条边的权重进行bootstrap抽样，和null模型（比如随机重排权重）对比，筛选显著高于随机的边
• igraph的核心度+权重过滤：先计算节点核心度，再结合边权重筛选核心节点间的高权重边
• network包的骨干提取函数：部分参数支持保留原始权重，可根据文档调整参数实现需求

内容的提问来源于stack exchange，提问作者LennyAngola