逆向构建满足约束条件的正态分布（钟形曲线）

模拟受限正态分布数据 #

我模拟了以50为中心的正态分布数据，并将数值限制在0到100之间：

mean <- 50
sd <- 15
n <- 100000

set.seed(123)  
numbers <- rnorm(n, mean, sd)

numbers <- pmax(0, pmin(numbers, 100))

结果呈现预期的钟形曲线：

随后统计每个单位区间内数值的占比：

min_interval <- seq(0, 99, by = 1)
max_interval <- seq(1, 100, by = 1)

count <- sapply(min_interval, function(x) {
    sum(numbers >= x & numbers < (x + 1))
})
percentage <- count / length(numbers) * 100

df <- data.frame(min_interval = min_interval,
                 max_interval = max_interval,
                 count = count,
                 percentage = percentage)

结果示例：

library(dplyr)
df %>% arrange(desc(percentage))

    min_interval max_interval count percentage
1             50           51  2714      2.714
2             48           49  2632      2.632
3             49           50  2628      2.628
4             52           53  2626      2.626
5             47           48  2615      2.615

#> sum(df$percentage)
#[1] 99.957

技术需求 #

需对结果表df进行调整，满足以下条件：

• (min_interval = 50, max_interval = 51)的占比为5%
• (min_interval = 49, max_interval = 50)的占比为5%
• percentage列总和为1（即100%）
• 曲线仍保持近似钟形

解决方案 #

1. 针对当前需求的快速调整 #

核心思路：先固定目标区间的占比，将剩余比例按照原正态分布的相对权重分配给其他区间，最后归一化确保总和为1。

代码实现：

# 设定固定占比的区间与对应值
fixed_intervals <- data.frame(
  min_interval = c(49, 50),
  fixed_percent = c(0.05, 0.05)
)

# 分离固定区间与非固定区间
df_fixed <- df %>% filter(min_interval %in% fixed_intervals$min_interval)
df_remaining <- df %>% filter(!min_interval %in% fixed_intervals$min_interval)

# 将原占比转换为0-1范围，计算剩余区间的占比总和
remaining_sum <- sum(df_remaining$percentage / 100)

# 按原分布相对权重分配剩余比例
remaining_percent <- (df_remaining$percentage / 100) / remaining_sum * (1 - sum(fixed_intervals$fixed_percent))

# 合并并整理结果
df_adjusted <- df_remaining %>%
  mutate(percentage = remaining_percent * 100) %>%
  bind_rows(df_fixed %>% 
              left_join(fixed_intervals, by = "min_interval") %>%
              mutate(percentage = fixed_percent * 100) %>%
              select(-fixed_percent)) %>%
  arrange(min_interval)

# 验证总和（应等于1）
sum(df_adjusted$percentage / 100)

2. 通用约束优化函数 #

若需支持任意数量的区间约束，同时严格保留钟形曲线形态，可使用非线性优化方法：以原正态分布的概率密度为基准，最小化调整后分布与原分布的差异，同时满足所有约束条件。

使用nloptr包实现：

install.packages("nloptr")
library(nloptr)

adjust_normal_dist <- function(df, fixed_constraints, mean = 50, sd = 15) {
  # fixed_constraints：数据框，包含min_interval和target_percent（0-1范围）
  n <- nrow(df)
  # 计算原正态分布在每个区间的概率密度（作为基准权重）
  base_probs <- diff(pnorm(df$max_interval, mean, sd))
  
  # 目标函数：最小化调整后概率与基准概率的平方误差，保证钟形形态
  objective <- function(x) {
    sum((x - base_probs)^2)
  }
  
  # 等式约束：总和为1，固定区间等于目标值
  eq_constraints <- function(x) {
    constraints <- c(
      sum(x) - 1,
      x[df$min_interval %in% fixed_constraints$min_interval] - fixed_constraints$target_percent
    )
    return(constraints)
  }
  
  # 初始值设为原基准概率
  init_x <- base_probs
  
  # 优化参数设置
  opts <- list(
    algorithm = "NLOPT_LD_SLSQP",
    xtol_rel = 1e-8,
    maxeval = 1000
  )
  
  # 执行优化
  result <- nloptr(
    x0 = init_x,
    eval_f = objective,
    eval_g_eq = eq_constraints,
    lb = rep(0, n), # 所有概率非负
    ub = rep(1, n),
    opts = opts
  )
  
  # 更新df的占比列
  df$percentage <- result$solution * 100
  return(df)
}

# 函数使用示例
fixed_constraints <- data.frame(
  min_interval = c(49, 50),
  target_percent = c(0.05, 0.05)
)

df_optimized <- adjust_normal_dist(df, fixed_constraints)

# 验证约束条件
df_optimized %>% filter(min_interval %in% c(49,50)) %>% select(percentage)
sum(df_optimized$percentage / 100) # 结果应为1

相关问题翻译 #

计算100面加权骰子的概率

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