如何在R中按组调整概率至固定和值并满足上限约束？

需求说明 #

现有模型可生成某赛事中特定参赛者的结果预估概率，每个赛事中该结果必定恰好发生3次，因此需调整每个赛事的概率总和为3，同时需满足单个概率不超过0.99的约束：

• 若赛事原始概率总和为1（如赛事1001），直接将每个概率乘以3即可；
• 若赛事原始概率总和为1.5（如赛事1003），直接乘以2会导致部分概率超过0.99，需特殊处理；
• 部分赛事原始概率总和超过3，需缩减概率同时保证不违反上限约束。

示例数据 #

data <- data.frame(
  event_id = c(1001, 1001, 1001, 1001, 1001, 1001, 1003, 1003, 1003, 1003, 1003, 1003, 1003),
  outcome_probability = c(0.001, 0.102, 0.3, 0.288, 0.3, 0.007, 0.002, 0.002, 0.004, 0.6, 0.3, 0.35, 0.244)
)

实现方案 #

我们使用dplyr进行分组处理，通过自定义函数实现概率的迭代调整，确保满足总和为3且单个概率≤0.99的要求：

library(dplyr)

# 定义单组概率调整函数
adjust_probabilities <- function(probs, target_sum = 3, max_prob = 0.99) {
  sum_p <- sum(probs)
  # 初步缩放
  scaled <- probs * (target_sum / sum_p)
  
  # 检查是否有超过上限的情况
  over_limit <- scaled > max_prob
  if (!any(over_limit)) {
    return(scaled)
  }
  
  # 先将超过上限的设为max_prob，计算剩余待分配量
  scaled[over_limit] <- max_prob
  remaining <- target_sum - sum(scaled)
  
  # 对未达上限的概率，按原始比例分配剩余量
  under_limit <- !over_limit
  while (remaining > 1e-8 && any(under_limit)) {
    # 计算未达上限组的原始比例
    ratio <- probs[under_limit] / sum(probs[under_limit])
    # 分配剩余量，同时确保不超过上限
    add_amount <- pmin(ratio * remaining, max_prob - scaled[under_limit])
    scaled[under_limit] <- scaled[under_limit] + add_amount
    remaining <- remaining - sum(add_amount)
    # 更新未达上限的标记
    under_limit <- scaled < max_prob - 1e-8
  }
  
  return(scaled)
}

# 分组应用调整函数
adjusted_data <- data %>%
  group_by(event_id) %>%
  mutate(adjusted_prob = adjust_probabilities(outcome_probability)) %>%
  ungroup()

# 验证结果（可选）
adjusted_data %>%
  group_by(event_id) %>%
  summarise(total_adjusted = sum(adjusted_prob), max_adjusted = max(adjusted_prob))

代码逻辑说明 #

1. 初步缩放：先按目标总和与原始总和的比例缩放所有概率；
2. 上限检查：若缩放后无概率超过0.99，直接返回结果；
3. 上限截断与剩余分配：将超过0.99的概率设为上限值，计算剩余需要分配的总量，再按原始概率比例将剩余量分配给未达上限的参赛者，迭代此过程直到剩余量为0或所有概率都达到上限；
4. 分组处理：通过group_by和mutate对每个赛事独立应用调整逻辑。

内容的提问来源于stack exchange，提问作者user1205901 - Слава</think_never_used_51bce0c785ca2f68081bfa7d91973934>