R中optim()无法收敛至目标R-squared值的技术问询

为什么你的代码无法精准收敛？ #

• 随机噪声干扰优化过程：每次调用lm_r2都会生成新的随机X变量和噪声，导致目标函数输出不稳定，optim面对波动的目标值无法找到稳定的最优解，尤其是目标R²较小时，噪声对R²的影响被放大，偏差更明显。
• 绕远路的计算方式：你通过模拟数据再拟合模型计算R²，完全可以直接用理论公式推导R²的期望值，避免随机波动。

修正方案：用理论公式构建目标函数 #

对于你的线性模型（X1、X2为独立标准正态分布，噪声标准差为noise_sd），R²的理论期望值可以直接计算：
$$R^2 = \frac{\beta_1^2 + \beta_2^2}{\beta_12 + \beta_2^2 + noise_sd^2}$$
这个公式没有随机成分，用来做优化目标会非常稳定。

完整修正代码 #

# 生成数据函数保留（用于后续验证）
generate_data <- function(n_obs = 100, beta_params = c(2, 3), noise_sd = 1) {
  beta1 <- beta_params[1]
  beta2 <- beta_params[2]
  X1 <- rnorm(n_obs)
  X2 <- rnorm(n_obs)
  Y <- beta1 * X1 + beta2 * X2 + rnorm(n_obs, mean = 0, sd = noise_sd)
  return(data.frame(X1 = X1, X2 = X2, Y = Y))
}

# 基于理论公式的目标函数
lm_r2_theoretical <- function(beta_params, target_r2, noise_sd = 1) {
  beta_sum_sq <- sum(beta_params^2)
  theoretical_r2 <- beta_sum_sq / (beta_sum_sq + noise_sd^2)
  (theoretical_r2 - target_r2)^2
}

# 设置目标参数
target_r2 <- 0.1
noise_sd <- 1

# 执行优化
result <- optim(
  par = c(1, 1),
  fn = function(beta) lm_r2_theoretical(beta, target_r2, noise_sd),
  method = "L-BFGS-B",
  lower = c(0, 0)  # beta正负不影响R²，限制非负简化解
)

# 提取结果并验证
optimized_betas <- result$par
theoretical_r2 <- sum(optimized_betas^2) / (sum(optimized_betas^2) + noise_sd^2)

cat("优化后beta1:", optimized_betas[1], "\n")
cat("优化后beta2:", optimized_betas[2], "\n")
cat("理论R²值:", theoretical_r2, "\n")

# 模拟数据验证（R²会围绕理论值小幅波动）
set.seed(123)
data <- generate_data(beta_params = optimized_betas, noise_sd = noise_sd)
model <- lm(Y ~ X1 + X2, data = data)
cat("模拟数据计算的R²:", summary(model)$r.squared, "\n")

可选：保留模拟流程的稳定化方法 #

如果一定要通过模拟数据计算R²来学习optim，可以在目标函数中固定随机种子，消除每次调用的随机波动：

lm_r2_stable <- function(beta_params, target_r2, n_obs = 100, noise_sd = 1) {
  set.seed(456)  # 固定种子保证每次生成相同数据
  data <- generate_data(n_obs, beta_params, noise_sd)
  model <- lm(Y ~ X1 + X2, data = data)
  actual_r2 <- summary(model)$r.squared
  (actual_r2 - target_r2)^2
}

但这种方法效率和准确性都不如直接用理论公式。

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