R脚本优化：避免重复奖品及无匹配时就近匹配实现

在一场竞赛中，每位获奖者和奖品都会被分配一个[1,9]范围内的随机整数作为ticket（票号），以及一个[1111,9999]范围内的唯一ID（标识号）。每位获奖者需基于自身票号±1的规则，从有限的奖品库存中获得唯一奖品。

问题1：避免重复奖品 #

如何修改下方R脚本以避免返回重复奖品？此前使用过duplicate()函数，但不确定在此场景下如何实现。

问题2：无匹配奖品时的处理 #

如何在脚本中实现以下规则：当无法找到未重复的匹配奖品时，从未领取的库存中返回最接近匹配的奖品。

原脚本 #

# 生成含随机参数的数据框函数
generate <- function(n) {
  ID <- as.factor(sample(1111:9999, n))
  ticket <- sample(1:9, n, replace = TRUE)
  lower.bound <- ticket - 1
  upper.bound <- ticket + 1
  winners.df <- cbind.data.frame(ID, ticket, lower.bound, upper.bound)
  return(winners.df)
}

# 生成总数据框
master <- generate(20)

# 将总数据框拆分为“奖品”和“获奖者”
prizes  <- master[1:16, ]
winners   <- master[17:20, ]

# 移除奖品数据框中不需要的上下界列
prizes <- prizes[, -c(3, 4)]

# 创建空列表用于存储选中的奖品
picks <- list(NULL)

for (x in 1:length(winners$ID)) {
  pool <- subset(prizes, ticket >= winners$lower.bound[x] & ticket <= winners$upper.bound[x])
  picks[[x]] <- pool[sample(nrow(pool), 1), ]
}

picks <- do.call(rbind.data.frame, picks)

# 生成获奖者与对应奖品的汇总表
winners.prizes <- data.frame(winnerID = winners$ID,
                             winnerTicket = winners$ticket,
                             prizeID = picks$ID,
                             prizeTicket = picks$ticket)

优化后的脚本 #

# 生成含随机参数的数据框函数
generate <- function(n) {
  ID <- as.factor(sample(1111:9999, n))
  ticket <- sample(1:9, n, replace = TRUE)
  lower.bound <- ticket - 1
  upper.bound <- ticket + 1
  winners.df <- cbind.data.frame(ID, ticket, lower.bound, upper.bound)
  return(winners.df)
}

# 生成总数据框
master <- generate(20)

# 拆分奖品和获奖者数据（直接移除奖品不需要的列）
prizes  <- master[1:16, -c(3,4)]
winners   <- master[17:20, ]

# 创建空列表存储结果
picks <- list()
# 初始化动态奖品库存，后续逐步移除已领取的奖品
available_prizes <- prizes

for (x in seq_along(winners$ID)) {
  current_winner <- winners[x, ]
  # 1. 筛选符合票号±1规则的可用奖品
  match_pool <- subset(available_prizes, 
                       ticket >= current_winner$lower.bound & 
                       ticket <= current_winner$upper.bound)
  
  if (nrow(match_pool) > 0) {
    # 有符合条件的奖品，随机选一个
    selected <- match_pool[sample(nrow(match_pool), 1), ]
  } else {
    # 2. 无符合条件的奖品，筛选票号最接近的奖品
    available_prizes$diff <- abs(available_prizes$ticket - current_winner$ticket)
    min_diff <- min(available_prizes$diff)
    closest_pool <- subset(available_prizes, diff == min_diff)
    selected <- closest_pool[sample(nrow(closest_pool), 1), ]
    # 移除临时计算的差值列
    available_prizes <- available_prizes[, !names(available_prizes) %in% "diff"]
  }
  
  # 记录选中的奖品，并从库存中移除（避免重复分配）
  picks[[x]] <- selected
  available_prizes <- available_prizes[available_prizes$ID != selected$ID, ]
}

# 合并结果为数据框
picks <- do.call(rbind.data.frame, picks)

# 生成获奖者与奖品的汇总表
winners.prizes <- data.frame(winnerID = winners$ID,
                             winnerTicket = winners$ticket,
                             prizeID = picks$ID,
                             prizeTicket = picks$ticket)

关键优化说明 #

• 解决重复奖品问题：

  • 新增available_prizes作为动态更新的奖品库存，每次分配后通过ID过滤移除已选中的奖品，确保后续获奖者只能从剩余库存中选择，从根源避免重复。
  • 全程基于动态库存筛选奖品，无需额外调用duplicate()函数。

• 解决无匹配奖品的情况：

  • 当没有符合±1规则的奖品时，计算所有可用奖品与获奖者票号的差值绝对值，筛选出差值最小的奖品集合。
  • 若存在多个票号距离相同的奖品，随机选择其中一个分配，保证公平性。

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