Применение функций из столбца списка к столбцу в R

Question

Я ищу самый элегантный подход для этой операции.В настоящее время у меня есть таблица, содержащая несколько списков-столбцов моделей и столбец, содержащий мой тестовый набор данных для прогнозирования.

Я могу вручную вычислить прогнозы для каждой модели, используя dplyr :: mutate, но мне было интересно, есть ли некоторыеили цикл, который может ускорить процесс.

lab_formula <- as.formula("pop ~ lifeExp ")
temp_formula <- as.formula("gdpPercap ~ year")
last_formula <- as.formula("year ~ gdpPercap")
formula_list <- list(lab_formula,temp_formula,last_formula)


country_model <- function(df, formula_list, index) {
  list(lm(formula = formula_list[[index]] , data = df), 
       randomForest(formula=formula_list[[index]], data = df),
       gbm(formula=formula_list[[index]], data = df, n.minobsinnode = 2))
}

by_country <- gapminder %>% 
  dplyr :: group_by(country, continent) %>% 
  nest()

df1 <- by_country %>% 
  mutate(model1 = map(data, ~country_model(., formula_list, 1)), 
         model2 = map(data, ~country_model(., formula_list, 2)),
         model3 = map(data, ~country_model(., formula_list, 3))
         )

pred_1 <- df1 %>%
  mutate(pred_1= map2(data,model1, function(x, y) 
    map(seq_along(y), function(i) 
      if (i == 3) predict(y[[i]], n.trees = y[[i]]$n.trees)
      else as.numeric(predict(y[[i]])))))

Is there an elegant code to apply model1, model2, model3 on the data column? And to subsequently extract the predictions from each list of models embedded within the list column? (something to do with ```unnest```)

   country      data              model1     model2     model3     pred_1    
   <fct>       <list>            <list>     <list>     <list>     <list>    
 1 Afghanistan <tibble [12 x 4]> <list [3]> <list [3]> <list [3]> <list [3]>
 2 Albania     <tibble [12 x 4]> <list [3]> <list [3]> <list [3]> <list [3]>
 3 Algeria     <tibble [12 x 4]> <list [3]> <list [3]> <list [3]> <list [3]>
 4 Angola     <tibble [12 x 4]> <list [3]> <list [3]> <list [3]> <list [3]>
 5 Argentina  <tibble [12 x 4]> <list [3]> <list [3]> <list [3]> <list [3]>


Desired Outcome:
 country   data   model1     model2     model3   pred_1 pred_2 pred_3

Answer 1

Мы могли бы создать функции с помощью switch для распознавания правильной модели, а затем использовать map для циклического создания созданных столбцов

library(randomForest)
library(gbm)
library(purrr)
library(dplyr)
library(stringr)

-функций

country_model <- function(df, formula,  model_name) {
         switch(model_name, 

         "model1" = lm(formula = formula , data = df),
         "model2" = randomForest(formula= formula, data = df),
         "model3" = gbm(formula=formula, data = df, n.minobsinnode = 2)

      )


} 

country_pred <- function(model, model_name) {

 switch(model_name,

    "model1" =  as.numeric(predict(model)),
    "model2" = as.numeric(predict(model)),
    "model3" = predict(model, n.trees = model[["n.trees"]]) 

 )


}

Установитьимена списка формул с именами моделей

fmlst <- set_names(formula_list, str_c("model", seq_along(formula_list)))

Создайте столбцы модели отдельно с помощью imap

df1 <- imap_dfc(fmlst, ~ by_country %>%
                              transmute(!! .y := map(data, 
            country_model, formula = .x, model_name = .y ))) %>%
                                      bind_cols(by_country, .)


str1 <- names(df1)[startsWith(names(df1), "model")]
str2 <- str_c("pred_", 1:3)

Создайте также столбцы прогноза

df2 <- map_dfc(str1, ~ {

 nm1 <- .x
  df1 %>% 
      select(.x) %>%   
        pull(1) %>%
        map(., country_pred, model_name = nm1) %>%
        list



 }
 ) %>%
  rename_all(~ str2) %>%
  bind_cols(df1, .)

df2
# A tibble: 142 x 9
#   country     continent data              model1 model2     model3 pred_1     pred_2     pred_3    
#   <fct>       <fct>     <list>            <list> <list>     <list> <list>     <list>     <list>    
# 1 Afghanistan Asia      <tibble [12 × 4]> <lm>   <rndmFrs.> <gbm>  <dbl [12]> <dbl [12]> <dbl [12]>
# 2 Albania     Europe    <tibble [12 × 4]> <lm>   <rndmFrs.> <gbm>  <dbl [12]> <dbl [12]> <dbl [12]>
# 3 Algeria     Africa    <tibble [12 × 4]> <lm>   <rndmFrs.> <gbm>  <dbl [12]> <dbl [12]> <dbl [12]>
# 4 Angola      Africa    <tibble [12 × 4]> <lm>   <rndmFrs.> <gbm>  <dbl [12]> <dbl [12]> <dbl [12]>
# 5 Argentina   Americas  <tibble [12 × 4]> <lm>   <rndmFrs.> <gbm>  <dbl [12]> <dbl [12]> <dbl [12]>
# 6 Australia   Oceania   <tibble [12 × 4]> <lm>   <rndmFrs.> <gbm>  <dbl [12]> <dbl [12]> <dbl [12]>
# 7 Austria     Europe    <tibble [12 × 4]> <lm>   <rndmFrs.> <gbm>  <dbl [12]> <dbl [12]> <dbl [12]>
# 8 Bahrain     Asia      <tibble [12 × 4]> <lm>   <rndmFrs.> <gbm>  <dbl [12]> <dbl [12]> <dbl [12]>
# 9 Bangladesh  Asia      <tibble [12 × 4]> <lm>   <rndmFrs.> <gbm>  <dbl [12]> <dbl [12]> <dbl [12]>
#10 Belgium     Europe    <tibble [12 × 4]> <lm>   <rndmFrs.> <gbm>  <dbl [12]> <dbl [12]> <dbl [12]>
# … with 132 more rows

Answer 2

По сути, я пытаюсь использовать цикл for для циклического перебора всех имен моих сохраненных переменных, применять к ним модели 1/2/3 и впоследствии использовать эти имена для создания новых столбцов переменных в моем существующем фрейме данных df1.

pred_names <- c('labour_pred','temp_pred', 'last_pred') 


for (c in seq_along(pred_names)) { 
model_pred <- df1 %>% 
mutate(pred_names[c] = map2(data_2018,model_list[c], function(x, y) 
map(seq_along(y), function(i) 
if (i == 3) predict(y[[i]], n.trees = y[[i]]$n.trees) 
else as.numeric(predict(y[[i]]))))) 
}

However, I get these errors instead:
Error: unexpected '=' in: 
" model_pred <- model_fit %>% 
mutate(pred_names[c] =" 

Error: unexpected ')' in: 
" if (i == 3) predict(y[[i]], n.trees = y[[i]]$n.trees) 
else as.numeric(predict(y[[i]]))))" 
> } 
Error: unexpected '}' in "}"