在R中使用NLS拟合渐近曲线遇适配问题求助

问题背景 #

我需要在R中为两组趋势相似的数据集拟合渐近模型（核心目标是获取收敛值），遇到以下问题：

• 第一组数据集包含x=0，使用模型y~a*x^(b)时触发报错：

Error in numericDeriv(form[[3L]], names(ind), env, central = nDcentral) : 
  Missing value or an infinity produced when evaluating the model

尝试y~a*x^(b)+c模型也无法成功拟合；

• 第二组数据集不含x=0，使用y~a*x^(b)+c模型可成功拟合。

现寻求能同时适配两组数据集的模型，或NLS的替代方法。

两组数据集结构如下：

第一组数据 #

data <- structure(list(x = c(0, 0.01, 0.02, ..., 1), y = c(0, 0.485920598224734, ..., 1)), row.names = c(NA, -101L), class = c("tbl_df", "tbl", "data.frame"))

第二组数据 #

data <- structure(list(x = c(0.01, 0.02, ..., 1), y = c(0.387696586431811, ..., 1)), row.names = c(NA, -100L), class = c("tbl_df", "tbl", "data.frame"))

解决方案 #

1. 换用无奇点的渐近模型 #

原幂函数模型在x=0时易出现数值奇点，推荐使用天然无奇点且具备渐近特性的模型：

• 逻辑增长模型：y ~ c / (1 + exp(-a*(x - b)))，x=0时有明确取值，收敛值为c，完全匹配核心需求
• 双曲线渐近模型：y ~ c - a/(x + b)，避免x=0时的无穷值问题，收敛值同样为c

2. 改进NLS拟合策略 #

若坚持使用幂函数类模型，可尝试以下优化：

• 给x=0的点添加微小扰动：

data$x_adj <- ifelse(data$x == 0, 1e-6, data$x)
fit <- nls(y ~ a*x_adj^(b) + c, data = data, start = list(a=1, b=0.5, c=1))

• 用minpack.lm包的nlsLM替代基础nls，该函数采用Levenberg-Marquardt算法，对初始值要求更低，鲁棒性更强：

library(minpack.lm)
start_vals <- list(a = 1, b = 0.5, c = 1)
fit <- nlsLM(y ~ a*x^(b) + c, data = data, start = start_vals)

3. 非参数/稳健拟合备选 #

如果参数模型始终难以适配，可考虑：

• 用loess做非参数平滑，通过平滑曲线的末端趋势估算收敛值
• 使用robustbase包的nlrob进行稳健非线性拟合，抵抗数值奇点带来的拟合波动

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