Кодирование нескольких моделей в функции в R Tidyverse

Question

Я пытаюсь дополнить пару моделей машинного обучения несколькими формулами и сохранить их в виде таблицы в виде объектов list_column.

Я попытался изменить код, указанный в книге «R для Datascience» (Глава 25: Многие Модели), но это только дает мне последний результат.Пожалуйста, обратитесь к приведенному ниже коду для более подробной информации.В качестве примера мы используем набор данных gapminder из пакетов gapminder.

lab_formula <- as.formula("pop ~ lifeExp ")

temp_formula <- as.formula("gdppercap ~ year")

formula_list <- list(lab_formula,temp_formula)
library(gapminder)

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

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

by_country <- by_country %>% 
  mutate(model = map(data, country_model))

by_country
# A tibble: 142 x 4
   country     continent data              model    
   <fct>       <fct>     <list>            <list>   
 1 Afghanistan Asia      <tibble [12 x 4]> <S3: gbm>
 2 Albania     Europe    <tibble [12 x 4]> <S3: gbm>
 3 Algeria     Africa    <tibble [12 x 4]> <S3: gbm>
 4 Angola      Africa    <tibble [12 x 4]> <S3: gbm>
 5 Argentina   Americas  <tibble [12 x 4]> <S3: gbm>
 6 Australia   Oceania   <tibble [12 x 4]> <S3: gbm>
 7 Austria     Europe    <tibble [12 x 4]> <S3: gbm>
 8 Bahrain     Asia      <tibble [12 x 4]> <S3: gbm>
 9 Bangladesh  Asia      <tibble [12 x 4]> <S3: gbm>
10 Belgium     Europe    <tibble [12 x 4]> <S3: gbm>
# ... with 132 more rows

There is no error code but it does not achieve my objective of training the 3 machine learning models (LM, RF, GBM) with the different variables.

Answer 1

Вам нужно подумать о том, как вы хотите сохранить свои результаты. Вот один из способов сделать это. Сначала создайте список формул, которые вы хотите применить

library(randomForest)
library(gbm)
library(tidyverse)

lab_formula <- as.formula("pop ~ lifeExp ")
temp_formula <- as.formula("gdpPercap ~ year")
formula_list <- list(lab_formula,temp_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))
}

и теперь примените его к каждому data, передающему formula_list и номер формулы из списка, который вы хотите применить к своим данным,

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

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

Теперь у каждой строки в model1 есть список из трех моделей, которые использовали формулу formula_list[[1]], и аналогично для model2 у вас есть модели, которые использовали формулу formula_list[[2]].

---

Чтобы использовать эти модели для прогнозирования, нам может потребоваться по-разному относиться к модели randomForest, поскольку для нее требуется параметр n.trees, и когда мы возвращаем эти модели из нашей функции, мы знаем, что это третья модель в списке, которую мы можем различить на основе индекс.

df1 %>%
   mutate(pred= 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]])))))