如何用uniroot求解双营收约束下的setup_price优化问题？

问题背景 #

现有数据集：

product = data.frame(length = c(100, 200, 300, 400), qty = c(1, 2, 1, 3)) 

旧价格通过公式 (product[["length"]] * old_const * 2) + setup_price 计算，其中 old_const=0.0158，setup_price=20.8，代码实现：

product[["old_price"]] = (product[["length"]] * old_const * 2) + setup_price

需要调整setup_price满足两个约束：

1. 新价格下总营收与旧总营收完全相等
2. 新价格下数据表前半部分（前2行）营收与后半部分（后2行）营收完全相等

此前尝试遍历const序列寻找ev=0的位置，但精度不足，希望用uniroot函数解决该双约束问题。

核心思路 #

把两个约束转化为单变量方程：以调整后的new_setup为变量，构造一个函数，当函数值为0时，两个约束同时满足。随后用uniroot找到函数的根，即为所求的new_setup。

代码实现 #

1. 计算旧营收基准值 #

先算出旧总营收，作为约束1的基准：

old_const <- 0.0158
setup_price <- 20.8

product <- data.frame(length = c(100, 200, 300, 400), qty = c(1, 2, 1, 3)) 
product$old_price <- (product$length * old_const * 2) + setup_price
old_total_revenue <- sum(product$old_price * product$qty)

2. 构造目标函数 #

将两个约束的差值合并为一个函数，当函数值为0时，两个约束同时成立：

# 输入new_setup，输出约束差值的平方和（平方和为0时满足所有约束）
target_fun <- function(new_setup) {
  new_price <- (product$length * old_const * 2) + new_setup
  # 约束1的差值：新总营收 - 旧总营收
  diff_total <- sum(new_price * product$qty) - old_total_revenue
  # 约束2的差值：前半部分营收 - 后半部分营收
  diff_half <- sum(new_price[1:2] * product$qty[1:2]) - sum(new_price[3:4] * product$qty[3:4])
  # 返回平方和，值越小越接近约束要求
  diff_total^2 + diff_half^2
}

如果你的ev是已经推导好的线性组合式，直接封装成函数即可：

# 替换y1/y2/y3/y4为你实际计算好的变量
target_ev <- function(x) {
  (y1 - y2 * x) + (y3 * x - y4)
}

3. 用uniroot求解 #

首先确认函数在某个区间两端的符号相反（uniroot要求区间端点函数值异号）：

# 测试区间端点的函数值，比如[-100, 100]
target_ev(-100)
target_ev(100)

如果符号相反，直接用uniroot找根：

root_result <- uniroot(target_ev, interval = c(-100, 100))
# 输出满足ev=0的const值（即所需的setup_price调整量或新值）
root_result$root

补充：无解时的近似解 #

如果两个约束线性无关、不存在严格满足的解，用optimize找使约束差值最小的近似值：

opt_result <- optimize(target_fun, interval = c(-100, 100))
# 最优的setup_price
opt_result$minimum
# 最小的约束差值平方和
opt_result$objective

关键说明 #

• 双约束转单变量的核心是将多个约束的满足条件合并为一个函数的零点（或最小值点）。
• uniroot适合求解有严格零点的单变量方程，若约束无严格解，用optimize找近似最优解更合适。

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