R脚本Hub分组Set生成异常及Ratio计算错误修正求助

我有如下数据集，希望生成包含Set（序列号）、Hubname、Ratio的表格：

• Set：将存在邮编交互的Hub归为同一组（即若Hub A与B有交互、B与C有交互，则A、B、C同属一个Set）
• Ratio：每组内该Hub的总需求占组总需求的比例

现有R脚本无法正确分组，导致Ratio计算错误，具体信息如下：

输入数据 #

期望输出 #

当前R脚本 #

data<-Input
filtered_data <- subset(data, Original_Hubname != Active_Hubname)
unique_hubs <- unique(filtered_data[, c("Original_Hubname", "Active_Hubname")])
result <- data.frame(Set = integer(), Hubname = character(), Ratio = numeric(), stringsAsFactors = FALSE)
set_counter <- 1
for (i in 1:nrow(unique_hubs)) {
  original_hub <- unique_hubs$Original_Hubname[i]
  active_hub <- unique_hubs$Active_Hubname[i]
  original_demand <- data$pc_demand[data$Original_Hubname == original_hub]
  active_demand <- data$pc_demand[data$Active_Hubname == active_hub]
  total_demand <- sum(original_demand) + sum(active_demand)
  if (total_demand > 0) {
    ratio_original <- sum(original_demand) / total_demand
    ratio_active <- sum(active_demand) / total_demand
    if (!(original_hub %in% result$Hubname)) {
      result <- rbind(result, data.frame(Set = set_counter, Hubname = original_hub, Ratio = ratio_original))
    }
    if (!(active_hub %in% result$Hubname)) {
      result <- rbind(result, data.frame(Set = set_counter, Hubname = active_hub, Ratio = ratio_active))
    }
    set_counter <- set_counter + 1
  }
}
result <- na.omit(result)

脚本输出 #

错误原因分析 #

1. 分组逻辑错误：原脚本将每一对Original_Hubname != Active_Hubname的记录单独设为一个Set，未识别Hub之间的连通关系（比如Yishun和Woodlands交互、Yishun和PasirRis交互，三者应同属一个Set）。
2. 需求计算错误：原脚本混淆了Original_Hubname和Active_Hubname的需求统计，正确的Hub总需求应为该Hub作为Original_Hubname时所有Pincode_demand的总和，Ratio是单个Hub总需求除以所在Set的总需求之和。
3. 遗漏孤立Hub：原脚本未处理无交互的Hub（比如Lorong没有作为Original且Active是自身的记录，但需要纳入分组）。

修正后的R脚本 #

# 加载必要包（若未安装需先安装：install.packages("igraph")）
library(igraph)

# 假设Input是你的输入数据集
data <- Input

# 步骤1：计算每个Hub的总需求（以Original_Hubname为准统计所有需求）
hub_total_demand <- aggregate(Pincode_demand ~ Original_Hubname, data = data, sum)
colnames(hub_total_demand) <- c("Hubname", "Total_Demand")

# 步骤2：构建Hub之间的交互图（仅考虑Original != Active的记录）
edges <- subset(data, Original_Hubname != Active_Hubname)[, c("Original_Hubname", "Active_Hubname")]
# 创建无向图，因为交互是双向的
g <- graph_from_data_frame(edges, directed = FALSE, vertices = unique(c(edges$Original_Hubname, edges$Active_Hubname)))

# 步骤3：识别连通分量（即Set分组）
components <- components(g)
hub_set <- data.frame(Hubname = names(components$membership), Set = components$membership, stringsAsFactors = FALSE)

# 步骤4：处理没有任何交互的Hub（即未出现在edges中的Hub）
all_hubs <- unique(c(data$Original_Hubname, data$Active_Hubname))
missing_hubs <- setdiff(all_hubs, hub_set$Hubname)
if(length(missing_hubs) > 0){
  next_set <- max(hub_set$Set) + 1
  missing_df <- data.frame(Hubname = missing_hubs, Set = next_set:(next_set + length(missing_hubs)-1), stringsAsFactors = FALSE)
  hub_set <- rbind(hub_set, missing_df)
}

# 步骤5：合并需求数据并计算Ratio
result <- merge(hub_set, hub_total_demand, by = "Hubname")
# 计算每组的总需求
group_total <- aggregate(Total_Demand ~ Set, data = result, sum)
colnames(group_total) <- c("Set", "Group_Total")
result <- merge(result, group_total, by = "Set")
# 计算Ratio并保留两位小数
result$Ratio <- round(result$Total_Demand / result$Group_Total, 2)

# 步骤6：整理输出格式，匹配期望输出
result <- result[, c("Set", "Hubname", "Ratio")]
# 按Set排序，Hubname可按需排序
result <- result[order(result$Set, result$Hubname), ]
rownames(result) <- NULL

# 查看结果
print(result)

修正后脚本说明 #

1. 连通分量识别：使用igraph包构建无向图，通过components()函数识别所有连通的Hub组，确保有交互的Hub归为同一Set。
2. 正确统计需求：以Original_Hubname为维度统计每个Hub的总需求，符合业务逻辑（每个邮编的需求归属Original Hub）。
3. 处理孤立Hub：自动识别未参与交互的Hub，单独分配Set（如果有多个孤立Hub会依次分配Set）。
4. Ratio计算：基于组内总需求计算单个Hub的占比，并保留两位小数，与期望输出一致。

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