如何用R语言生成17队特殊赛制的联赛赛程表？

这个赛制的核心约束是构建对称的双循环配对和无冲突的单循环配对，确保每队的主客场场次、对手数量完全符合要求。以下是基于tidyverse的实现步骤：

1. 基础准备 #

首先加载依赖并定义队伍列表：

library(tidyverse)

# 定义17支队伍
teams <- paste("Team", LETTERS[1:17])
n_teams <- length(teams)

2. 生成双循环比赛（主客场各交手一次） #

双循环要求每队和8个对手各打两场（主、客各一场），这部分需要构建对称的无向配对（A和B双循环，则B和A也必须双循环）：

# 初始化双循环配对记录和对手计数
double_pairs <- list()
opponent_count <- rep(0, n_teams)
names(opponent_count) <- teams

# 循环构建对称配对，直到每队都有8个双循环对手
while(any(opponent_count < 8)) {
  # 选取第一个未达8个对手的队伍
  team1 <- names(opponent_count)[opponent_count < 8][1]
  # 筛选符合条件的对手：未达8个对手、不是自己、未与当前队配对过
  possible_opponents <- names(opponent_count)[
    opponent_count < 8 & 
    names(opponent_count) != team1 &
    !paste(team1, names(opponent_count), sep = "-") %in% unlist(double_pairs) &
    !paste(names(opponent_count), team1, sep = "-") %in% unlist(double_pairs)
  ]
  # 随机选一个对手完成配对
  team2 <- sample(possible_opponents, 1)
  double_pairs <- c(double_pairs, paste(team1, team2, sep = "-"))
  # 更新对手计数
  opponent_count[team1] <- opponent_count[team1] + 1
  opponent_count[team2] <- opponent_count[team2] + 1
}

# 将配对转换为主客场两场比赛的格式
double_matches <- map_df(double_pairs, function(pair) {
  teams_split <- str_split(pair, "-")[[1]]
  tibble(
    home = c(teams_split[1], teams_split[2]),
    away = c(teams_split[2], teams_split[1])
  )
})

3. 生成单循环比赛仅交手一次，4主4客 #

单循环部分需要从每队剩余的8个对手中，选4个主场、4个客场，且保证A主B客时，B只能是客A主，不会重复配对：

# 整理每队的双循环对手列表
team_double_opponents <- double_matches %>%
  group_by(home) %>%
  summarise(double_opponents = list(away)) %>%
  rename(team = home)

# 得到每队的单循环候选对手（排除自己和双循环对手）
team_single_candidates <- team_double_opponents %>%
  mutate(
    single_candidates = map(team, function(t) {
      setdiff(teams, c(t, double_opponents[[which(team == t)]]))
    })
  )

# 初始化单循环比赛记录
single_matches <- tibble(home = character(), away = character())

# 遍历每队完成单循环主场配对
for(t in teams) {
  # 计算当前队还需要的主场单循环场次
  current_home <- single_matches %>% filter(home == t) %>% nrow()
  needed_home <- 4 - current_home
  
  if(needed_home <= 0) next
  
  # 筛选候选对手：未与当前队形成任何比赛、且对手仍需客场场次
  candidate_opps <- team_single_candidates %>%
    filter(team == t) %>%
    pull(single_candidates) %>%
    pluck(1) %>%
    setdiff(c(single_matches$away[single_matches$home == t], single_matches$home[single_matches$away == t])) %>%
    keep(function(opp) {
      current_away <- single_matches %>% filter(away == opp) %>% nrow()
      (4 - current_away) > 0
    })
  
  # 随机选择所需数量的对手
  selected_opps <- sample(candidate_opps, needed_home)
  # 添加新比赛记录
  single_matches <- bind_rows(single_matches, tibble(home = rep(t, needed_home), away = selected_opps))
}

4. 合并赛程并验证约束 #

将双循环和单循环比赛合并，得到完整赛程，同时验证所有约束是否满足：

# 合并完整赛程
full_schedule <- bind_rows(double_matches, single_matches)

# 验证每队总场次是否为24
full_schedule %>%
  pivot_longer(cols = c(home, away), names_to = "type", values_to = "team") %>%
  count(team) %>%
  pull(n) %>%
  unique()

# 验证每队主场场次是否为12
full_schedule %>% count(home) %>% pull(n) %>% unique()

# 验证每队客场场次是否为12
full_schedule %>% count(away) %>% pull(n) %>% unique()

# 验证每队双循环对手数是否为8
full_schedule %>%
  filter(paste(home, away, sep = "-") %in% unlist(double_pairs) | paste(away, home, sep = "-") %in% unlist(double_pairs)) %>%
  group_by(home) %>%
  summarise(double_opp_count = n_distinct(away)) %>%
  pull(double_opp_count) %>%
  unique()

注意事项 #

• 随机采样可能偶尔出现候选对手不足的情况，此时可以设置固定随机种子（如set.seed(123)）重复尝试，或调整配对逻辑（比如用轮转法替代随机采样）。
• 最终赛程可以根据需要添加轮次、日期等字段，只需在现有数据框基础上扩展即可。

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