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