Получение сводки из нескольких простых линейных регрессий в R

Question

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

  fit_basic <- rs2_anova %>% #Run multiple simple linear regressions
    group_by(quant_method) %>% 
    nest() %>% 
    mutate(model = map(data, ~lm(recoveries ~ treatment, data = .))) 

fit_basic_A <- fit_basic[[1,"model"]] #Remove the model from fit_basic
fit_basic_B <- fit_basic[[1,"model"]] #Remove the model from fit_basic

fit_basic_table_A <- get_regression_table(fit_basic_A) %>%
  select("term", "estimate") %>%
  pivot_wider(names_from = "term", values_from = "estimate") %>%
  mutate(quant_method = "A")

fit_basic_table_B <- get_regression_table(fit_basic_A) %>%
  select("term", "estimate") %>%
  pivot_wider(names_from = "term", values_from = "estimate") %>%
  mutate(quant_method = "B")

fit_basic_table <- rbind(fit_basic_table_A, fit_basic_table_B)

Чтобы сохранить себе несколько строк кода (потому что у меня гораздо больше групп, чем представлено здесь), я подумал, что могу использовать функцию карты, но я продолжаю зацикливаться на отображении сводной таблицы, которая выдает ошибку:

fit_basic <- rs2_anova %>% 
  group_by(quant_method) %>% 
  nest() %>% 
  mutate(model = map(data, ~lm(recoveries ~ treatment, data = .))) %>%
  mutate(summaries = map(data, get_regression_table(.$model)))

Error in input_checks(model, digits, print) : 
  Only simple linear regression models are supported. Try again using only `lm()` models as appropriate.

Я также пробовал что-то в этом духе:

fit_basic_table <- map(fit_basic$model, 
                           function(x) {
                             p <- get_regression_table(x)
                             cbind(par=rownames(p), p)
                           }) 

Но я получаю список фреймов данных, которые могу не разбит на один фрейм данных, и я потерял обозначения группы. Я пытался:

fit_basic_table <- map(fit_basic$model, 
                           function(x) {
                             p <- get_regression_table(x)
                             cbind(par=rownames(p), p)
                           }) %>% 
  map_df(as_tibble, .id = "id") 

и

fit_basic_table <- map(fit_basic$model, 
                           function(x) {
                             p <- get_regression_table(x)
                             cbind(par=rownames(p), p)
                           }) %>% 
  unnest(cols = "id")

Есть какие-нибудь мысли о том, как автоматизировать это?

* Случайный тестовый фрейм данных:

quant_method <- c("A", "A","A","A","A","A","A","A","A","A","B","B","B","B","B","B","B","B","B","B")
treatment <- c("x","x","x","x","x","y","y","y","y","y","x","x","x","x","x","y","y","y","y","y")
recoveries <-c("88","86","87","82","85","76","65","55","72","71","98","96","97","92","99","66",
               "55","55","62","61")
rs2_anova <- data.frame(quant_method, treatment, recoveries)

Answer 1

Я нашел ответ здесь: развернуть столбец списка после моделирования после group_by в r

и изменил его на:

fit_cec <- rs2_anova %>% 
  group_by(quant_method) %>%
  nest %>% 
  mutate(data = map(data, ~ .x %>%
                      summarise(model = list(broom::tidy(lm(recoveries ~ treatment)))))) %>% 
  unnest(data) %>% 
  unnest(model)

или чтобы получить все оценки , прогнозы и резюме (https://drsimonj.svbtle.com/running-a-model-on-separate-groups). Это также хорошо работает:

fit_cec <- rs2_anova %>% 
  group_by(quant_method) %>%
  nest %>% 
  mutate(fit = map(data, ~ lm(loss_abs_BC_2 ~ cec, data = .)),
         parameters = map(fit, tidy), #provides estimate table for slope and y-intercept with std.error and estimate p-values
         summary = map(fit, broom::glance), #provides R2, adj.R2, sigma, and model p-value
         predictions = map(fit, augment)) %>% #provides fitted values with residuals and errors
  unnest(parameters) %>%
  pivot_wider(names_from = term, values_from = c(estimate, std.error, statistic, p.value)) %>%
  unnest(summary) %>%
  unnest(predictions)

Answer 2

Вот одно решение с использованием пакетов tidyverse и broom. Он немного отличается от purrr метода, который вы пытались, но я думаю, что результат показывает условия, которые вы были заинтересованы в извлечении из объекта lm ( т.е. , термин и оценка).

library(tidyverse)
library(broom)

#Added the stringsAsFactors argument = F to avoid an error in the lm model
rs2_anova <- data.frame(quant_method, 
                        treatment, 
                        recoveries,
                        stringsAsFactors = F)

fit_basic <- rs2_anova %>% 
  #Group by quant_method column
  group_by(quant_method) %>%
  #do the linear models by grouping var
  do(model = lm(recoveries ~ treatment, data = .)) %>%
  #tidy lm object and order it as tibble
  tidy(model)