在嵌套 tibble 上应用多参数模型（invoke_map tidyverse R）

Question

一方面，我在 R 中有一些 嵌套数据。 另一方面，我想在这些数据中测试几个 nls 函数。

我要求一个整洁的工作流程，允许我针对嵌套数据的每个类别跨越所有 nls 公式，并具有多个参数的许多起点。

函数可以共享参数，也可以不共享参数。

据我所知，我已经成功地概括了公式，并带有

possibly

，但问题是我无法触及每个 nls 函数的参数。 （起点）

我举了一个包含 Iris 数据和 2 个函数的示例。有 6 种组合，但我必须坚持我正在寻找泛化。

#Iris Nested data-----
iris_nested <- iris %>% 
  group_by(Species) %>%  
  nest() %>%  
  ungroup()

#NLS functions  -----
## Weird function 1 -----
weird_test_1 <- function(Species_data, Petal.Length_0 = 0 ){
  nls(
    Petal.Length ~ Petal.Length_0 * (1 - exp( -Petal.Width/(Sepal.Length+Sepal.Width) )),
    start = list(
      Petal.Length_0 = Petal.Length_0),
    data = Species_data
  )
}
## Weird function 2 -----
weird_test_2 <- function(Species_data, Sepal.Length_0 = 0 ){
  nls(
    Petal.Length ~ Sepal.Length_0 * (1 - exp( -(Sepal.Length+Sepal.Width)/Petal.Width )),
    start = list(
      Sepal.Length_0 = Sepal.Length_0),
    data = Species_data
  )
}

#Iteration over the model with a map_df -----
# I create a function that given a function name and a Species data allows to iterate 

fn_model <- function(.model, df){
  # safer to avoid non-standard evaluation
  # df %>% mutate(model = map(data, .model)) 
  df %>% 
    mutate('model'= map(data, possibly(.model, NULL)))
}


# here is where I stop, due to I cannot find a way to implemnet invoke_map and manipulate starting arguments:

list(
  'weird_test_1' = weird_test_1,
  'weird_test_2' = weird_test_2) %>%
  map_df(fn_model, iris_nested, .id = "id_model")

我尝试了使用

crossing

 或 tribbles 的解决方案，但由于函数参数不兼容，似乎无法一起工作

Answer 1

试试这个：

library(tidyverse)

iris_nested <- iris %>% 
  group_by(Species) %>%  
  nest() %>%  
  ungroup()

weird_test_1 <- function(Species_data, Petal.Length_0 = 0 ){
  nls(
    Petal.Length ~ Petal.Length_0 * (1 - exp( -Petal.Width/(Sepal.Length+Sepal.Width) )),
    start = list(
      Petal.Length_0 = Petal.Length_0),
    data = Species_data
  )
}

weird_test_2 <- function(Species_data, Sepal.Length_0 = 0 ){
  nls(
    Petal.Length ~ Sepal.Length_0 * (1 - exp( -(Sepal.Length+Sepal.Width)/Petal.Width )),
    start = list(
      Sepal.Length_0 = Sepal.Length_0),
    data = Species_data
  )
}

fn_model <- function(.model, df){
  df %>% 
    mutate('model'= map(data, possibly(.model, NULL)))
}

lst <- list(
  'weird_test_1' = weird_test_1,
  'weird_test_2' = weird_test_2)

map(lst, \(x) {
  fn_model(x, iris_nested)
  }) |> 
  list_rbind(names_to = "id")
#> # A tibble: 6 × 4
#>   id           Species    data              model 
#>   <chr>        <fct>      <list>            <list>
#> 1 weird_test_1 setosa     <tibble [50 × 4]> <nls> 
#> 2 weird_test_1 versicolor <tibble [50 × 4]> <nls> 
#> 3 weird_test_1 virginica  <tibble [50 × 4]> <nls> 
#> 4 weird_test_2 setosa     <tibble [50 × 4]> <nls> 
#> 5 weird_test_2 versicolor <tibble [50 × 4]> <nls> 
#> 6 weird_test_2 virginica  <tibble [50 × 4]> <nls>

创建于 2024-03-13，使用 ^{reprex v2.1.0}