Call nls from within a function in R, passing a user-specified function with any number of arguments

Question

I have a function that uses stats::nls() internally to get parameter estimates for a non-linear model. However, the number of parameters I need the function to estimate is variable and determined by the users. How can I do this? This function is going in an R package, so it is important that it is as flexible as possible.

For example, here is some dummy data and two possible functions that users might use.

## 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))
}

The goal is to have a function called fit_nls(), which takes at least 3 arguments, x, d, and FUN. FUN is a function that takes d as its first argument, but can have any number of additional parameters, and outputs some transformation of 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){...}, ...)

I can make the function work for a fixed number of arguments:

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))

but haven't been able to figure out how to use a variable number of parameters. One thing I've tried is passing a list of arguments using do.call(), but this doesn't work:

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

which isn't really surprising, since it is equivalent to setting the values within the function:

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

So, I tried passing a symbol as a stand-in, without success:

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

I'm open to any kind of solution. If anyone can give me any advice or point me in the right direction, I'd greatly appreciate it.

The usual way to do this is to write your functions with a single list argument and then pull indexed items from that list. — IRTFM, Jan 21 '22 at 22:50

G. Grothendieck · Accepted Answer · 2022-01-22T15:39:07.623

If a character string or function name is passed set FUN to the name of the function as a character string; otherwise, use "fit.fun". Then create the formula argument as a character string, convert it to an actual R formula and then run 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)
}

Tests

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

This works for cases where the number of parameters in `FUN` is greater than 0 (p > 0). You only show the p = 1 case in your comment, but I also tested p = 2: `with(df, fit_nls(d, x, "exppow_fun", list(r = .1, a = .2)))`, and it works as well. I'm not sure if the p = 0 case would actually be useful for users anyway. Thank you. — morrowcj, Jan 24 '22 at 17:44

Call nls from within a function in R, passing a user-specified function with any number of arguments

1 Answers1