使用R为18支球队生成符合特定条件的随机赛程

核心逻辑 #

18支球队每队需对阵4个不同对手，其中2场主场、2场客场，总场次固定为36场（18×4÷2）。核心是确保同一对手仅交手一次，且主客场关系匹配（A主B客则B必须以A为客场对手）。以下代码采用随机抽样+回溯调整的方式，解决随机生成时的冲突问题。

完整代码 #

# 1. 定义基础参数与球队列表
teams <- paste0("Team", 1:18)
n_teams <- length(teams)
matches_per_team <- 4
home_games <- 2
away_games <- 2

# 2. 初始化赛程存储与对阵记录矩阵
schedule <- data.frame(Home = character(), Away = character(), stringsAsFactors = FALSE)
# used_matches[i,j]为TRUE表示Team i与Team j已完成对阵（无论主客场）
used_matches <- matrix(FALSE, nrow = n_teams, ncol = n_teams)
diag(used_matches) <- TRUE  # 球队不能与自己对阵

# 3. 循环生成赛程
for (i in 1:n_teams) {
  current_team <- teams[i]
  
  # 跳过已完成所有场次的球队
  current_home_done <- sum(schedule$Home == current_team)
  current_away_done <- sum(schedule$Away == current_team)
  if (current_home_done >= home_games && current_away_done >= away_games) next
  
  # 筛选可用对手：未对阵过、且对手场次未达上限
  available_opponents <- which(
    !used_matches[i, ] &
    rowSums(used_matches) < matches_per_team &
    colSums(used_matches) < matches_per_team
  )
  
  # 计算当前球队还需的主客场场次
  need_home <- home_games - current_home_done
  need_away <- away_games - current_away_done
  need_total <- need_home + need_away
  
  if (length(available_opponents) >= need_total) {
    # 随机抽取对手并分配主客场
    selected_opps <- sample(available_opponents, need_total)
    home_opps <- sample(selected_opps, need_home)
    away_opps <- setdiff(selected_opps, home_opps)
    
    # 添加主场比赛
    for (opp in home_opps) {
      schedule <- rbind(schedule, data.frame(Home = current_team, Away = teams[opp]))
      used_matches[i, opp] <- TRUE
      used_matches[opp, i] <- TRUE
    }
    
    # 添加客场比赛
    for (opp in away_opps) {
      schedule <- rbind(schedule, data.frame(Home = teams[opp], Away = current_team))
      used_matches[i, opp] <- TRUE
      used_matches[opp, i] <- TRUE
    }
  } else {
    # 可用对手不足时，回溯移除当前球队的一场已有比赛，重新分配
    current_team_matches <- which(schedule$Home == current_team | schedule$Away == current_team)
    if (length(current_team_matches) > 0) {
      remove_idx <- sample(current_team_matches, 1)
      removed_match <- schedule[remove_idx, ]
      schedule <- schedule[-remove_idx, ]
      
      # 重置对阵记录
      home_idx <- which(teams == removed_match$Home)
      away_idx <- which(teams == removed_match$Away)
      used_matches[home_idx, away_idx] <- FALSE
      used_matches[away_idx, home_idx] <- FALSE
      
      # 重新处理当前球队
      i <- i - 1
    }
  }
}

# 4. 验证赛程合规性
# 检查每队主客场场次是否符合要求
home_counts <- table(schedule$Home)
away_counts <- table(schedule$Away)
cat("主客场场次验证结果：", all(home_counts == home_games) & all(away_counts == away_games), "\n")

# 检查每队对手是否无重复
for (team in teams) {
  all_opponents <- c(schedule$Away[schedule$Home == team], schedule$Home[schedule$Away == team])
  if (length(unique(all_opponents)) != matches_per_team) {
    cat("警告：", team, "存在重复对手\n")
  }
}

# 输出最终赛程
print(schedule)

代码说明 #

• used_matches矩阵避免同一对手重复交手，确保每队的4个对手完全不同
• 回溯逻辑解决随机抽样时的对手不足问题，自动调整已生成的比赛，保证最终满足所有条件
• 验证步骤可确认赛程是否符合要求，若出现警告可重新运行代码（随机生成存在小概率冲突，重试即可）

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