基于R语言实现咖啡聚会组无重复月度随机配对需求

核心逻辑 #

1. 每次生成配对前读取历史记录，排除所有已出现过的配对组合（无序，A-B和B-A视为同一配对）
2. 从剩余合法配对中，用随机贪心算法生成无重叠的配对，确保每人仅配对一次
3. 将当月配对写入历史记录，供后续月份使用

代码实现 #

1. 初始化历史记录（首次运行） #

如果是第一次使用，先创建并保存空的历史配对文件：

# 创建空的历史配对数据框
history_pairs <- data.frame(
  person1 = character(),
  person2 = character(),
  month = character(),
  stringsAsFactors = FALSE
)
# 保存到本地文件（路径可自定义）
saveRDS(history_pairs, "coffee_pairs_history.rds")

2. 配对生成函数 #

generate_new_pairs <- function(names_vec, history_path = "coffee_pairs_history.rds") {
  # 加载历史配对记录
  if (file.exists(history_path)) {
    history <- readRDS(history_path)
    # 将历史配对转为统一格式（排序后拼接，消除A-B和B-A的差异）
    history_pairs_set <- apply(history[, c("person1", "person2")], 1, function(x) {
      paste(sort(x), collapse = "-")
    })
  } else {
    history_pairs_set <- character(0)
  }
  
  # 生成当前名单所有可能的无序配对
  all_possible_pairs <- combn(names_vec, 2, simplify = FALSE)
  # 转换为统一格式的字符串集合
  all_pairs_set <- sapply(all_possible_pairs, function(x) paste(sort(x), collapse = "-"))
  
  # 过滤掉已在历史中出现过的配对
  valid_pairs <- all_possible_pairs[!all_pairs_set %in% history_pairs_set]
  
  # 检查是否有足够的合法配对生成完整组合
  required_pairs <- length(names_vec) %/% 2
  if (length(valid_pairs) < required_pairs) {
    stop("无法生成无重复配对：已用尽所有可能的两两组合")
  }
  
  # 随机打乱合法配对顺序，提升随机性
  valid_pairs_shuffled <- sample(valid_pairs)
  
  # 贪心选择无重叠的配对
  used_people <- character(0)
  selected_pairs <- list()
  
  for (pair in valid_pairs_shuffled) {
    if (!any(pair %in% used_people)) {
      selected_pairs <- c(selected_pairs, list(pair))
      used_people <- c(used_people, pair)
      # 所有人完成配对则提前退出
      if (length(used_people) == length(names_vec)) break
    }
  }
  
  # 转换为数据框并添加月份标记
  selected_pairs_df <- do.call(rbind, selected_pairs)
  colnames(selected_pairs_df) <- c("person1", "person2")
  selected_pairs_df <- as.data.frame(selected_pairs_df, stringsAsFactors = FALSE)
  selected_pairs_df$month <- format(Sys.Date(), "%Y-%m") # 用当前年月作为标识
  
  # 更新并保存历史记录
  if (file.exists(history_path)) {
    updated_history <- rbind(history, selected_pairs_df)
  } else {
    updated_history <- selected_pairs_df
  }
  saveRDS(updated_history, history_path)
  
  return(selected_pairs_df)
}

3. 使用示例 #

# 本月名单
current_names <- c("John", "Fiona", "Abdul", "Mishra", "Sven", "Bianka")
# 生成本月配对
monthly_pairs <- generate_new_pairs(current_names)
print(monthly_pairs)

# 下月新增成员后的名单
next_month_names <- c(current_names, "Lila", "Raj")
# 生成下月配对（自动避开历史所有配对）
next_month_pairs <- generate_new_pairs(next_month_names)
print(next_month_pairs)

关键说明 #

• 配对去重逻辑：通过排序配对双方姓名后拼接字符串，确保A-B和B-A被视为同一个配对，避免重复计数
• 动态名单支持：新增成员后，函数会自动将新成员纳入配对池，且仅排除已发生过的配对组合
• 历史记录维护：用RDS格式保存历史数据，读写效率高且能保留数据结构
• 异常处理：当所有可能的配对都已使用过，函数会抛出错误提示

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