R-使用嵌套数据帧运行具有不同参数集的函数

我想为Levenberg-Marquardt非线性最小二乘函数nls.lm minpack.lm库创建一个包装器，类似于nls2 nls2库，以提供一种蛮力方法来评估模型与观测数据的拟合度

其想法是创建一系列起始值组合，并且：

将这些值传递给函数，然后将函数输出与观测数据进行比较，为每个起始值组合创建一个R^2值，并使用其中的最佳组合运行nls.lm拟合。 或

在所有组合上运行nls.lm，并选择返回的最佳拟合。 我想在不循环的情况下做到这一点，在我尝试使用嵌套数据帧的启发下，一列用于参数输入列表，一列用于函数返回的值，一列用于R^2值，另一列用于最佳拟合模型，类似于：

df
#   start_val fun_out       R^2   
# 1 {a=2,b=2} {22,24,26...} 0.8   
# 2 {a=3,b=5} {35,38,41...} 0.6   

这是我目前掌握的代码：

require(dplyr);require(tidyr)

foo <- function(x,a,b) a*x^2+b # function I am fitting
x <- 1:10 # independent variable
y_obs <- foo(x,1.5,2.5) + rnorm(length(x),0,10) # observed data (dependent variable)

start_range <- data.frame(a=c(1,2),b=c(2,3)) # range of allowed starting points for fitting
reps <- 2 # number of starting points to generate

# Create a data frame of starting points
df<-as.data.frame(sapply(start_range, function(x) runif(reps,min=x[[1]],max=x[[2]]))) %>%
  mutate(id=seq_len(reps)) %>% # fudge to make nest behave as I want
  nest(1:ncol(start_range)) %>%
  mutate(data=as.list(data)) %>%
  as.data.frame()

df
#   id               data
# 1  1 1.316356, 2.662923
# 2  2 1.059356, 2.723081

有没有一种方法可以在不使用嵌套的情况下直接创建包含列表的数据帧列

另外，当尝试使用dataframe列创建要传递给do.call的列表时，如何创建一个列表，其中第一个元素是向量x，第二个是参数a，第三个是参数b？以下内容将列表沿列向下拆分：

mutate(df,my_list=list(x,data))
#   id               data                                my_list
# 1  1 1.316356, 2.662923          1, 2, 3, 4, 5, 6, 7, 8, 9, 10
# 2  2 1.059356, 2.723081 1.316356, 2.662923, 1.059356, 2.723081

---

也许是这样的方法

library(dplyr)
library(purrr)

foo2 <- function(x,data) data$a*x^2+data$b
r2 <- function(e, o) 1 - sum((e - 0)^2) / sum((e - mean(e)^2))

df <- as.data.frame(sapply(start_range, function(x) runif(reps,min=x[[1]],max=x[[2]]))) %>%
  mutate(id=seq_len(reps)) %>% # fudge to make nest behave as I want
  nest(1:ncol(start_range))

df %>% 
  mutate(fun_out = map(data, foo2, x = x),
         R2 = map(fun_out, o = y_obs, r2))

结果:

# A tibble: 3 x 4
     id             data    fun_out        R2
  <int>           <list>     <list>    <list>
1     1 <tibble [1 x 2]> <dbl [10]> <dbl [1]>
2     2 <tibble [1 x 2]> <dbl [10]> <dbl [1]>
3     3 <tibble [1 x 2]> <dbl [10]> <dbl [1]>

使用algorithm=random search和all=TRUE运行nls2，指定的maxiter将在maxiter随机点处计算foo，并返回起始拟合，这些拟合是这些点处的拟合。它由一组nls类对象组成，这些对象在每个随机选择的起始值处进行评估。它不会从这些起始值中的每一个进行优化，而是在每个起始值返回nls对象。也就是说，nls不运行。现在，对于每一次开始的适合跑步nlsLM给予适合，一个nlsLM适合的列表，并从中总结出一个数据框，每个跑步一行，并显示最少的适合

如果我们只想选择最佳的起始值，然后从中运行nlsLM一次，那么在接近结束时使用备用代码

library(nls2)

fo <- y_obs ~ foo(x, a, b)
starting_fits <- nls2(fo, algorithm = "random-search", 
 start = start_range, control = nls.control(maxiter = reps), all = TRUE)

fits <- lapply(starting_fits, function(fit) nlsLM(fo, start = coef(fit)))

data <- data.frame(RSS = sapply(fits, deviance), t(sapply(fits, coef)),
   start = t(sapply(starting_fits, coef)))
# data$fits <- fits   # optional to store each row's fitted object in that row
subset(data, RSS == min(RSS))   # minimum(s)

R平方用于线性回归。这对于非线性回归是无效的。剩余平方和RSS显示在上面

或者，如果您只想选择最佳起始值并在其上运行nlsLM，那么只需从nls2调用中省略all=TRUE参数并执行此操作。如果以后的代码需要系数和RSS，请尝试使用coeffit和deviancefit

注1：如果您从nlsLM获得错误，请尝试替换nlsLM。。。用trynlsLM。。。。这将发出错误消息，如果您不需要，请使用try…，silent=TRUE，但不会停止处理

---

注2：我假设问题中显示的foo只是一个示例，实际函数更复杂。所示的foo在系数中是线性的，因此可以使用lm。不需要非线性优化。

您需要捕获函数中nls.lm的错误。我建议修改nls2的源代码，当然不使用dplyr。谢谢@Roland，这种方法奏效了。

library(nls2)

fo <- y_obs ~ foo(x, a, b)
starting_fits <- nls2(fo, algorithm = "random-search", 
 start = start_range, control = nls.control(maxiter = reps), all = TRUE)

fits <- lapply(starting_fits, function(fit) nlsLM(fo, start = coef(fit)))

data <- data.frame(RSS = sapply(fits, deviance), t(sapply(fits, coef)),
   start = t(sapply(starting_fits, coef)))
# data$fits <- fits   # optional to store each row's fitted object in that row
subset(data, RSS == min(RSS))   # minimum(s)

       RSS        a        b  start.a  start.b
2 706.3956 1.396616 7.226525 1.681819 2.768374

starting_fit <- nls2(fo, algorithm = "random-search", 
 start = start_range, control = nls.control(maxiter = reps))

fit <- nlsLM(fo, start = coef(starting_fit))