从 R 中的函数中调用 nls，传递具有任意数量参数的用户指定函数

Question

我有一个函数在内部使用stats::nls() 来获取非线性模型的参数估计值。但是，我需要函数估计的参数数量是可变的，由用户确定。我怎样才能做到这一点？此函数位于 R 包中，因此尽可能灵活很重要。

例如，这里有一些虚拟数据和用户可能使用的两个可能的函数。

## dummy data
set.seed(654)
df <- data.frame(d = runif(50))
df$y <- exp(-df$d/.1)
df$x <- df$y + abs(rnorm(50, sd = .2))
## functions with different numbers of arguments
exp_fun <- function(d, r){
  return(exp(-d/r))
}
exppow_fun <- function(d, r, a){
  return(exp(-(d/r)^a))
}

我们的目标是拥有一个名为fit_nls() 的函数，它至少需要三个参数，x、d 和FUN。 FUN 是一个以d 作为第一个参数的函数，但可以有任意数量的附加参数，并输出d 的一些转换：

# run with any FUN
fit_nls(d = df$d, x = df$x, FUN = "exp_fun", ...)
fit_nls(d = df$d, x = df$x, FUN = "exppow_fun", ...)
fit_nls(d = df$d, x = df$x, FUN = function(d, a, b, c, e){...}), ...)
fit_nls(d = df$d, x = df$x, FUN = function(d){...}, ...)

我可以使函数对固定数量的参数起作用：

fit_nls <- function(d, x, FUN, start){
  fit.fun <- match.fun(FUN)
  nls(x ~ fit.fun(d, r = r), start = start)
}

fit_nls(df$d, df$x,  "exp_fun", start = list(r = .1))
fit_nls(df$d, df$x,  function(d, r){d^r}, start = list(r = .1))

但无法弄清楚如何使用可变数量的参数。我尝试过的一件事是使用do.call() 传递参数列表，但这不起作用：

fit_nls.multiarg <- function(d, x, FUN, start){
  fit.fun <- match.fun(FUN)
  args = append(list(d = d), start)
  nls(x ~ do.call(fit.fun, args), start = start)
}
fit_nls.multiarg(df$d, df$x, "exp_fun", list(r = .01)) # error

这并不奇怪，因为它相当于在函数中设置值：

nls(df$x ~ exp_fun(df$d, r = .1), start = list(r = .01) # equivalent error

所以，我尝试传递一个符号作为替代，但没有成功：

fit_nls.symbol <- function(d, x, FUN, start){
  fit.fun <- match.fun(FUN)
  nam = names(start)
  args = append(list(d = d), as.symbol(nam))
  nls(x ~ do.call(fit.fun, args), start = start)
}

fit_nls.symbol(df$d, df$x, "exp_fun", list(r = .01)) # error

我愿意接受任何类型的解决方案。如果有人能给我任何建议或指出正确的方向，我将不胜感激。

Answer 1

如果传递的是字符串或函数名，则将函数名作为字符串设置 FUN；否则，请使用“fit.fun”。然后将公式参数创建为字符串，将其转换为实际的 R 公式，然后运行 ​​nls。

fit_nls <- function(d, x, FUN, start) {
  FUN <- if (length(match.call()[[4]]) > 1) {
    fit.fun <- match.fun(FUN)
    "fit.fun"
  } else deparse(substitute(FUN)) 
  fo <- as.formula(sprintf("x ~ %s(d, %s)", FUN, toString(names(start))))
  nls(fo, start = start)
}

测试

with(df, fit_nls(d, x, "exp_fun", list(r = .01)))
## Nonlinear regression model
##   model: x ~ exp_fun(d, r)
##    data: parent.frame()
##      r 
## 0.1968 
##  residual sum-of-squares: 1.319
##
## Number of iterations to convergence: 11 
## Achieved convergence tolerance: 6.254e-06

with(df, fit_nls(d, x,  function(d, r){d^r}, start = list(r = .1)))
## Nonlinear regression model
##   model: x ~ fit.fun(d, r)
##    data: parent.frame()
##     r 
## 96.73 
##  residual sum-of-squares: 4.226
##
## Number of iterations to convergence: 22 
## Achieved convergence tolerance: 7.429e-06

with(df, fit_nls(d, x, exp_fun, list(r = .01)))
## Nonlinear regression model
##   model: x ~ exp_fun(d, r)
##    data: parent.frame()
##      r 
## 0.1968 
##  residual sum-of-squares: 1.319
##
## Number of iterations to convergence: 11 
## Achieved convergence tolerance: 6.254e-06