R擬合競爭模型嵌套在dplyr/tidyr/broom框架內的數據

Question

我試圖將模型子集合適嵌套的數據框架。儘管我已經看到很多將相同模型擬合到不同數據組的例子，但我還沒有遇到一個適用於組織爲嵌套數據框的數據集的不同模型的例子。

作爲一個例子，我從R的數據科學「許多模型」部分採取代碼。在這裏，目標是將相同的模型適用於不同的國家（組）。我希望做的是擴大這個範圍，並將不同的競爭模型適用於不同的國家（團體）。理想情況下，每個競爭模型將作爲嵌套數據框中的新列存儲。

在此先感謝您的幫助！

# 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) 
) 

Answer 1

這是一個使用更新中提到的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