如何从DataFrame中选择Var1与Var2的唯一组合（含权重规则）

问题背景 #

给定如下R DataFrame（VarA代表年龄，Var2代表学校，Var3代表对应年龄段的学校入学人数）：

TheDF <- data.frame(VarA=rep(c(7, 8, 11, 14), 4), Var2=c(1,1,1,0, 0,2,2,0, 0,0,3,0, 0,0,4,4), 
                Var3=c(50, 50, 50, 50, 100, 100, 100, 100, 150, 150, 150, 150, 200, 200, 200, 200))
TheDF <- TheDF %>%
    filter(Var2>0)

需要完成以下任务：

• 选择行组合，确保每个VarA和Var2的值仅被选中一次
• 规则：
  1. 唯一解直接返回
  2. 多解时优先选Var3总和最大的组合；总和相同则随机选
  3. 无法全匹配时返回能匹配的部分组合
• 额外要求：生成VarA与Var2的所有合法组合，将VarA作为列名，Var2为单元格值，新增Duplicates列统计行内重复Var2数、Weight列统计Var3总和

解决方案 #

使用tidyverse和gtools工具包实现，步骤如下：

1. 生成所有合法全匹配组合 #

首先生成所有可能的学校分配排列，筛选出原数据中存在的年龄-学校配对，同时计算每个组合的权重和重复情况：

library(tidyverse)
library(gtools)

# 提取唯一的年龄和学校值
unique_ages <- unique(TheDF$VarA)
unique_schools <- unique(TheDF$Var2)

# 生成所有可能的学校分配排列（每个年龄对应一个学校）
all_perms <- permutations(n = length(unique_schools), r = length(unique_ages), v = unique_schools) %>%
  as.data.frame() %>%
  set_names(unique_ages) %>%
  mutate(comb_id = row_number())

# 筛选合法组合：仅保留原数据中存在的年龄-学校配对，且覆盖所有年龄、无重复学校
valid_combs <- all_perms %>%
  pivot_longer(-comb_id, names_to = "VarA", values_to = "Var2") %>%
  mutate(VarA = as.numeric(VarA)) %>%
  inner_join(TheDF, by = c("VarA", "Var2")) %>%
  group_by(comb_id) %>%
  filter(n_distinct(VarA) == length(unique_ages)) %>%
  summarise(
    weight = sum(Var3),
    duplicates = n_distinct(Var2) != n(),
    .groups = "drop"
  ) %>%
  inner_join(all_perms, by = "comb_id") %>%
  filter(!duplicates)

2. 筛选最优组合 #

按规则选择最优组合，若无全匹配则用贪心算法生成部分匹配：

# 按权重降序排序，权重相同则随机打乱
ranked_combs <- valid_combs %>%
  arrange(desc(weight), sample(n()))

# 获取最优全匹配组合
best_comb <- ranked_combs %>%
  slice(1) %>%
  select(-comb_id, -weight, -duplicates)

# 若无合法全匹配，生成贪心部分匹配
if(nrow(valid_combs) == 0) {
  partial_match <- TheDF %>%
    arrange(desc(Var3)) %>%
    mutate(
      selected = FALSE,
      across(c(VarA, Var2), ~FALSE, .names = "{.col}_used")
    ) %>%
    rowwise() %>%
    mutate(
      selected = !VarA_used[VarA == current_row()$VarA] & !Var2_used[Var2 == current_row()$Var2],
      VarA_used = ifelse(selected, TRUE, VarA_used),
      Var2_used = ifelse(selected, TRUE, Var2_used)
    ) %>%
    filter(selected) %>%
    ungroup()
  
  # 转换为要求的格式
  best_comb <- partial_match %>%
    pivot_wider(names_from = VarA, values_from = Var2) %>%
    mutate(
      Duplicates = sum(duplicated(na.omit(c_across(where(is.numeric))))),
      Weight = sum(Var3)
    )
}

# 输出结果
print(best_comb)

结果解释 #

• 示例数据中，唯一合法的全匹配组合是：7→1, 8→2, 11→3, 14→4，对应权重总和为50+100+150+200=500，会直接返回该组合。
• 若存在多个合法组合，代码会优先选择权重最高的；权重相同时随机选择一个。
• 当无法实现全匹配时，贪心算法会优先选择入学人数多的配对，确保每个年龄和学校仅被使用一次，生成最优部分匹配。

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