R - 使用嵌套数据框 运行 具有不同参数集的函数
R - Using nested dataframe to run function with different sets of parameters
我想为 Levenberg-Marquardt 非线性最小二乘函数 nls.lm（minpack.lm 库）创建一个类似于 nls2（nls2 库）的包装器用于评估模型与观测数据的拟合度的力法。
我们的想法是创建一系列起始值组合，并且：
- 将这些传递给一个函数，然后将函数输出与观察到的数据进行比较，为每个起始值组合创建一个 R^2 值，运行 nls.lm 拟合最佳其中之一。
或
- 运行 nls.lm 所有组合和 select 最佳返回拟合。
我想在不循环的情况下执行此操作，在受到 here 的启发后，我尝试使用嵌套数据框，一列用于参数输入列表，一列用于我的函数返回的值，一列用于 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
我现在在尝试将数据中的参数传递给函数 foo() 时卡住了。我试过使用 do.call()，即使使用常量参数也会出现以下错误：
mutate(df,y=do.call(foo,list(x,1,2)))
# Error: wrong result size (5), expected 2 or 1
有没有办法在不使用 nest() 的情况下直接创建包含列表的数据框列？
另外，在尝试使用数据框列创建要传递给 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]>
运行 nls2 使用 algorithm = "random-search" 和 all = TRUE 并且指定的 maxiter 将在 maxiter 随机点评估 foo和 return starting_fits 这些点的拟合。它由一组 "nls" class 个对象组成，这些对象在每个随机选择的起始值处进行评估。它不会对每个起始值进行优化，而只是 returns 每个 "nls" 对象。也就是说，nls 是 而不是 运行。现在，对于每个起始拟合 运行 nlsLM 给出 fits，一个 nlsLM 拟合的列表，并从中总结它们 data （一个数据框，每行一行运行) 显示最少。
如果我们只想选择最好的起始值，并且只是 运行 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)
给予：
RSS a b start.a start.b
2 706.3956 1.396616 7.226525 1.681819 2.768374
R 平方用于线性回归。它对非线性回归无效。上面显示的是残差平方和 (RSS)。
或者，如果您只想选择最佳起始值和 运行 nlsLM，则只需从 nls2 调用中省略 all=TRUE 参数并执行此操作。如果您以后的代码需要系数和 RSS，请尝试 coef(fit) 和 deviance(fit) .
starting_fit <- nls2(fo, algorithm = "random-search",
start = start_range, control = nls.control(maxiter = reps))
fit <- nlsLM(fo, start = coef(starting_fit))
注意 1： 如果您收到来自 nlsLM 的错误，请尝试将 nlsLM(...) 替换为 try(nlsLM(...))。这将发出错误消息（如果您不需要它们，请使用 try(..., silent = TRUE)）但不会停止处理。
注2：我假设问题中显示的foo只是一个例子，真正的功能更复杂。显示的 foo 在系数中是线性的，因此可以使用 lm。不需要非线性优化。
我想为 Levenberg-Marquardt 非线性最小二乘函数 nls.lm（minpack.lm 库）创建一个类似于 nls2（nls2 库）的包装器用于评估模型与观测数据的拟合度的力法。
我们的想法是创建一系列起始值组合，并且：
- 将这些传递给一个函数，然后将函数输出与观察到的数据进行比较，为每个起始值组合创建一个 R^2 值，运行 nls.lm 拟合最佳其中之一。
或
- 运行 nls.lm 所有组合和 select 最佳返回拟合。
我想在不循环的情况下执行此操作，在受到 here 的启发后，我尝试使用嵌套数据框，一列用于参数输入列表，一列用于我的函数返回的值，一列用于 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
我现在在尝试将数据中的参数传递给函数 foo() 时卡住了。我试过使用 do.call()，即使使用常量参数也会出现以下错误：
mutate(df,y=do.call(foo,list(x,1,2)))
# Error: wrong result size (5), expected 2 or 1
有没有办法在不使用 nest() 的情况下直接创建包含列表的数据框列？
另外，在尝试使用数据框列创建要传递给 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]>
运行 nls2 使用 algorithm = "random-search" 和 all = TRUE 并且指定的 maxiter 将在 maxiter 随机点评估 foo和 return starting_fits 这些点的拟合。它由一组 "nls" class 个对象组成，这些对象在每个随机选择的起始值处进行评估。它不会对每个起始值进行优化，而只是 returns 每个 "nls" 对象。也就是说，nls 是 而不是 运行。现在，对于每个起始拟合 运行 nlsLM 给出 fits，一个 nlsLM 拟合的列表，并从中总结它们 data （一个数据框，每行一行运行) 显示最少。
如果我们只想选择最好的起始值，并且只是 运行 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)
给予：
RSS a b start.a start.b
2 706.3956 1.396616 7.226525 1.681819 2.768374
R 平方用于线性回归。它对非线性回归无效。上面显示的是残差平方和 (RSS)。
或者，如果您只想选择最佳起始值和 运行 nlsLM，则只需从 nls2 调用中省略 all=TRUE 参数并执行此操作。如果您以后的代码需要系数和 RSS，请尝试 coef(fit) 和 deviance(fit) .
starting_fit <- nls2(fo, algorithm = "random-search",
start = start_range, control = nls.control(maxiter = reps))
fit <- nlsLM(fo, start = coef(starting_fit))
注意 1： 如果您收到来自 nlsLM 的错误，请尝试将 nlsLM(...) 替换为 try(nlsLM(...))。这将发出错误消息（如果您不需要它们，请使用 try(..., silent = TRUE)）但不会停止处理。
注2：我假设问题中显示的foo只是一个例子，真正的功能更复杂。显示的 foo 在系数中是线性的，因此可以使用 lm。不需要非线性优化。