R语言求解带求和与根号的特殊二次方程的方法求助

你遇到的uniroot无结果通常是两个原因导致的：

• 没有提前明确4个根号前的±符号组合：4个根号每个有正负两种选择，总共有16种不同的符号组合，需要先确定你要求解的是哪一种组合下的根
• 没有限定x的可行域：根号内的表达式必须非负，x必须满足所有根号内的判别式≥0的要求，超出范围的x会让函数返回NaN，导致uniroot无法计算

第一步：先计算固定参数 #

先运行代码计算已知参数的固定值：

a_i <- c(9,27,37,47)
b_i <- c(70,35,24,6)
a <- sum(a_i) # 计算得a=120
b <- sum(b_i) # 计算得b=135
d_i <- c(1,-1,-1,1)

第二步：定义目标函数 #

我们先自定义函数，支持传入根号前的符号组合参数，方便后续测试不同符号组合的解：

# 输入x和符号向量s（长度为4，每个元素取1或-1对应根号前的±）
target_fun <- function(x, s) {
  sqrt_term <- sapply(1:4, function(i) {
    inner <- (a*b_i[i] - d_i[i]*b*x)^2 - 4*d_i[i]*a_i[i]*a*b*x
    # 根号内为负时返回一个很大的数，避免NaN导致求解中断
    if (inner < 0) return(1e10)
    s[i] * sqrt(inner)
  })
  a*b + sum(sqrt_term)
}

第三步：用uniroot求解指定符号组合下的根 #

这里举个例子，我们测试符号组合为s = c(1,-1,1,-1)的情况，先验证区间两端函数值异号，再调用uniroot：

# 指定符号组合
s_used <- c(1,-1,1,-1)
# 先测试区间内的函数值，确保两端异号
target_fun(0, s_used)
target_fun(20, s_used)
# 调用uniroot求解，调整精度和迭代次数避免求解失败
result <- uniroot(target_fun, interval = c(0,20), s = s_used, tol = 1e-8, maxiter = 1000)
# 输出解
print(result$root)
# 验证结果代入函数是否接近0
print(target_fun(result$root, s_used))

拓展：遍历所有16种符号组合找有效解 #

如果你不确定用哪种符号组合，可以遍历所有16种可能，筛选出存在有效根的组合：

# 生成所有16种符号组合
all_sign <- expand.grid(replicate(4, c(1,-1), simplify = FALSE))
valid_results <- list()
for (i in 1:nrow(all_sign)) {
  s <- as.numeric(all_sign[i,])
  # 尝试在常用区间求解，捕获错误避免运行中断
  tryCatch({
    res <- uniroot(target_fun, interval = c(-100, 100), s = s, tol = 1e-6, maxiter = 1000)
    if (abs(target_fun(res$root, s)) < 1e-4) {
      valid_results[[length(valid_results)+1]] <- list(
        sign_comb = s,
        root = res$root
      )
    }
  }, error = function(e) {})
}
# 输出所有有效解
print(valid_results)

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