Блог

Главная - Вопросы по программированию - Извлеките наклон и r в квадрате из сгруппированных линейных моделей с помощью метлы

Извлеките наклон и r в квадрате из сгруппированных линейных моделей с помощью метлы

#r #tidyverse #broom

Вопрос:

У меня есть фрейм данных, на котором я хочу запускать линейные модели по группам, а затем использовать пакет broom для извлечения наклона и r в квадрате для каждой модели. До сих пор я пытаюсь это сделать:

 library(tidyverse)
library(broom)

#read in the dataset
data(mtcars) 

#add a group variable
mtcars <- mtcars %>% as_tibble() %>% mutate(LC = 1)

#create a second group
mtcars2 <- mtcars 
mtcars2 <- mtcars2 %>% mutate(LC = 2)

#bind together
mtcars <- rbind(mtcars, mtcars2)

#groupby and run regressions
all_regress <-  mtcars %>% group_by(LC) %>%
  do(mod1 = lm(mpg ~ disp, data = .),
     mod2 = lm(mpg ~ wt, data = .))

#use broom the extract the slope and rsq per group
glance <-all_regress %>% mutate(tidy = map(mod1, broom::tidy),
                                   glance = map(mod1, broom::glance),
                                   augment = map(mod1, broom::augment),
                                   rsq = glance %>% map_dbl('r.squared'),
                                   slope = tidy %>% map_dbl(function(x) x$estimate[2]))

но это не удается с:

 Error: Problem with `mutate()` input `tidy`.
x No tidy method for objects of class qr
ℹ Input `tidy` is `map(mod1, broom::tidy)`.
ℹ The error occurred in row 1.

Если я сделаю это без таких групп, как:

     #read in the dataset
    data(mtcars) 
    
    mtcars <- mtcars %>% as_tibble()
   
    #run regressions
    all_regress <-  mtcars %>%
      do(mod1 = lm(mpg ~ disp, data = .),
         mod2 = lm(mpg ~ wt, data = .))
    
    #use broom the extract the slope and rsq per group
    glance <- all_regress %>% mutate(tidy = map(mod1, broom::tidy),
                                       glance = map(mod1, broom::glance),
                                       augment = map(mod1, broom::augment),
                                       rsq = glance %>% map_dbl('r.squared'),
                                       slope = tidy %>% map_dbl(function(x) x$estimate[2]))

здесь нет никакой ошибки.

Комментарии:

1. Я понимаю , почему вам нужно, чтобы он был сгруппирован при определении add_regress , но кажется излишним, чтобы он был сгруппирован при определении glance . Поскольку каждая строка в all_regress уже представляет другую группу, чего достигает группировка glance ?

2. Вы, вероятно, правы, и я довольно новичок в метле/использовании списков в качестве значений строк. Возможно, есть лучший способ достичь того, к чему я стремлюсь? Я ни в коем случае не ограничиваюсь подходом, который я здесь показываю

Ответ №1:

Я думаю, что простое добавление ungroup() достигает того, что вам нужно:

 all_regress <-  mtcars %>% group_by(LC) %>%
  do(mod1 = lm(mpg ~ disp, data = .),
     mod2 = lm(mpg ~ wt, data = .)) %>% ungroup()

#use broom the extract the slope and rsq per group
glance <-all_regress %>% mutate(tidy = map(mod1, broom::tidy),
                                   glance = map(mod1, broom::glance),
                                   augment = map(mod1, broom::augment),
                                   rsq = glance %>% map_dbl('r.squared'),
                                   slope = tidy %>% map_dbl(function(x) x$estimate[2]))

Ответ №2:

Я использовал этот подход, он длиннее, но я думаю, что в отдельных шагах больше контроля. Наконец, я создал tibble со списками столбцов, содержащих каждую модель.

 library(tidyverse)
library(broom)

#read in the dataset
data(mtcars) 

#add a group variable
mtcars <- mtcars %>% as_tibble() %>% dplyr::select(-c(vs, am, gear, carb, cyl)) %>% mutate(LC = 1)

#create a second group
mtcars2 <- mtcars 
mtcars2 <- mtcars2 %>% mutate(LC = 2)

#bind together
mtcars <- bind_rows(mtcars2, mtcars)

#group_split and run regressions
all_regress <-  mtcars %>% group_split(LC) %>% 

    
       map(~ list(mod1 = lm(mpg ~ disp, data = .),
       mod2 = lm(mpg ~ wt, data = .)))


# example <- all_regress[[2]][[1]] %>% glance()
#the list has 2 levels with 2 models each
data <- all_regress %>% 
    map(~
            map(.x, function(model){
                #column lists are needed because each function output different objects
                tibble(mod = list(model),
                       tidy = list(broom::tidy(model)),
                       glance = list(broom::glance(model)),
                       augment = list(broom::augment(model))) %>%
                    mutate(
                        rsq = list(glance[[1]]$r.squared),
                        slope = list(tidy[[1]]$estimate[2]))

                       
            } ))

data_final <- 
data %>% map2(unique(mtcars$LC), ~
                 map2(.x, .y, function(each_model, lc){
                     mutate(each_model, LC = lc)
                 }))

final_format <- #because of the list structure i need to bind the two datasets in each level and then bind them again.
map(data_final, ~reduce(.x, rbind)) %>% reduce(rbind)


#acces the data
final_format[1, 1][[1]]
Метки: