我正在尝试使模型子集适合嵌套数据框。虽然我看到了许多使同一模型适合不同数据组的示例,但我还没有遇到一个使不同模型适合于作为嵌套数据框组织的数据集的示例。

作为示例,我从R For Data Science“许多模型”部分中获取了代码。在这里,目标是使同一模型适合不同的国家(组)。我希望做的是扩大这一范围,并将多个不同的竞争模型适应不同的国家(组)。理想情况下,每个竞争模型都将作为新列存储在嵌套数据框中。

在此先感谢您的帮助!

# Example code
library(dplyr)
library(ggplot2)
library(modelr)
library(purrr)
library(tidyr)
library(gapminder)

# Create nested data
by_country <- gapminder %>%
  group_by(country, continent) %>%
  nest()

# Model 1
country_model <- function(df) {
  lm(lifeExp ~ year, data = df)
}

# Map model 1 to the data
by_country <- by_country %>%
  mutate(model = map(data, country_model))

# Model 2
country_model2 <- function(df) {
  lm(lifeExp ~ year + gdpPercap, data = df)
}

# Map Model 2 to the data
by_country <- by_country %>%
  mutate(model2 = map(data, country_model2))


更新
为了澄清我的问题,我知道我可以通过调用每个模型的变异来手动执行此操作。我认为我所追求的是更灵活的东西,几乎类似于下面的代码。但是,这些函数将代替对模型“ runif”,“ rnorm”和“ rpois”的调用。例如“ country_model”和“ country_model2”。希望这会有所帮助。

# Example code
 sim <- dplyr::frame_data(
  ~f,      ~params,
  "runif", list(min = -1, max = -1),
  "rnorm", list(sd = 5),
  "rpois", list(lambda = 10)
 )
sim %>% dplyr::mutate(
  samples = invoke_map(f, params, n = 10)
)

最佳答案

这是一种使用更新中提到的invoke_map函数的方法。

它涉及创建三个功能。这些功能:
1.创建一个用于指定模型的数据框
2.使用invoke_map函数将这些模型应用于您的数据
3.重塑结果,以便可以将它们作为列添加到原始的by_country数据框中




# Example code
library(dplyr)
library(ggplot2)
library(modelr)
library(purrr)
library(tidyr)
library(gapminder)

# Create nested data
by_country <- gapminder %>%
  group_by(country, continent) %>%
  nest()

# Function that creates dataframe suitable for invoke_map function
create_model_df  <-
  function(x){
    dplyr::frame_data(
      ~model_name,    ~f,     ~params,
      "country_model", "lm", list(formula =as.formula("lifeExp ~ year + gdpPercap"), data = x ),
      "country_model2","lm", list(formula =as.formula("lifeExp ~ year"),data = x )
    )
  }

# Function that applies invoke_map function
apply_models  <-
  function(x){
    x %>%
      mutate( model_fit = invoke_map(f, params))
  }

# Function that the results from invoke map
reshape_results  <-
  function(x){
    x %>%
      select(model_name,model_fit) %>% spread(model_name,model_fit)
  }

# Apply these functions
by_country %>%
  mutate(model_df = data %>%
           map(create_model_df) %>%
           map(apply_models) %>%
           map(reshape_results)) %>%
  unnest(model_df)
#> # A tibble: 142 x 5
#>        country continent              data country_model country_model2
#>         <fctr>    <fctr>            <list>        <list>         <list>
#>  1 Afghanistan      Asia <tibble [12 x 4]>      <S3: lm>       <S3: lm>
#>  2     Albania    Europe <tibble [12 x 4]>      <S3: lm>       <S3: lm>
#>  3     Algeria    Africa <tibble [12 x 4]>      <S3: lm>       <S3: lm>
#>  4      Angola    Africa <tibble [12 x 4]>      <S3: lm>       <S3: lm>
#>  5   Argentina  Americas <tibble [12 x 4]>      <S3: lm>       <S3: lm>
#>  6   Australia   Oceania <tibble [12 x 4]>      <S3: lm>       <S3: lm>
#>  7     Austria    Europe <tibble [12 x 4]>      <S3: lm>       <S3: lm>
#>  8     Bahrain      Asia <tibble [12 x 4]>      <S3: lm>       <S3: lm>
#>  9  Bangladesh      Asia <tibble [12 x 4]>      <S3: lm>       <S3: lm>
#> 10     Belgium    Europe <tibble [12 x 4]>      <S3: lm>       <S3: lm>
#> # ... with 132 more rows

07-24 09:52
查看更多